{-# LANGUAGE OverloadedStrings #-}
module Darcs.UI.Commands.Convert.Export
( convertExport
, cleanPatchAuthor
, cleanPatchAuthorTestCases
) where
import Darcs.Prelude hiding ( readFile, lex )
import Control.Exception (finally)
import Control.Monad (forM_, unless, void, when)
import Control.Monad.State.Strict (gets)
import Control.Monad.Trans (liftIO)
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.ByteString.Lazy.UTF8 as BLU
import Data.Char (isSpace)
import Data.IORef (modifyIORef, newIORef, readIORef)
import Data.Maybe (fromJust)
import System.Time (toClockTime)
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, info )
import Darcs.Patch ( RepoPatch, apply, effect, listTouchedFiles )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Effect ( Effect )
import Darcs.Patch.Witnesses.Ordered
( FL(..)
, nullFL
)
import Darcs.Patch.Witnesses.Sealed
( FlippedSeal(..)
, flipSeal
, unsealFlipped
)
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )
import Darcs.Patch.Info
( PatchInfo
, isTag
, piAuthor
, piDate
, piLog
, piName
)
import Darcs.Patch.Set ( patchSet2FL, inOrderTags )
import Darcs.Repository
( RepoJob(..)
, Repository
, readPatches
, repoCache
, withRepository
)
import Darcs.Repository.Pristine ( readHashedPristineRoot )
import Darcs.Repository.Traverse ( cleanPristineDir )
import Darcs.UI.Commands
( DarcsCommand(..)
, amInRepository
, nodefaults
, withStdOpts
)
import Darcs.UI.Commands.Convert.Util
( Marks
, addMark
, emptyMarks
, getMark
, lastMark
, readMarks
, writeMarks
, patchHash
)
import Darcs.UI.Completion (noArgs)
import Darcs.UI.Flags ( DarcsFlag , useCache )
import Darcs.UI.Options ( parseFlags, (?), (^) )
import qualified Darcs.UI.Options.All as O
import Darcs.Util.DateTime ( formatDateTime, fromClockTime )
import Darcs.Util.Path
( AbsolutePath
, AnchoredPath(..)
, anchorPath
, appendPath
, toFilePath
)
import Darcs.Util.Printer ( Doc, text )
import Darcs.Util.Tree
( Tree
, emptyTree
, findTree
, listImmediate
)
import Darcs.Util.Tree.Hashed ( hashedTreeIO )
import Darcs.Util.Tree.Monad ( TreeIO )
import qualified Darcs.Util.Tree.Monad as T
( directoryExists
, fileExists
, readFile
, tree
)
convertExportHelp :: Doc
convertExportHelp :: Doc
convertExportHelp = [Char] -> Doc
text ([Char] -> Doc) -> [Char] -> Doc
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unlines
[ [Char]
"This command enables you to export darcs repositories into git."
, [Char]
""
, [Char]
"For a one-time export you can use the recipe:"
, [Char]
""
, [Char]
" $ cd repo"
, [Char]
" $ git init ../mirror"
, [Char]
" $ darcs convert export | (cd ../mirror && git fast-import)"
, [Char]
""
, [Char]
"For incremental export using marksfiles:"
, [Char]
""
, [Char]
" $ cd repo"
, [Char]
" $ git init ../mirror"
, [Char]
" $ touch ../mirror/git.marks"
, [Char]
" $ darcs convert export --read-marks darcs.marks --write-marks darcs.marks"
, [Char]
" | (cd ../mirror && git fast-import --import-marks=git.marks --export-marks=git.marks)"
, [Char]
""
, [Char]
"In the case of incremental export, be careful to never amend, delete or"
, [Char]
"reorder patches in the source darcs repository."
, [Char]
""
, [Char]
"Also, be aware that exporting a darcs repo to git will not be exactly"
, [Char]
"faithful in terms of history if the darcs repository contains conflicts."
, [Char]
""
, [Char]
"Limitations:"
, [Char]
""
, [Char]
" * Empty directories are not supported by the fast-export protocol."
, [Char]
" * Unicode filenames are currently not correctly handled."
, [Char]
" See http://bugs.darcs.net/issue2359 ."
]
convertExport :: DarcsCommand
convertExport :: DarcsCommand
convertExport = DarcsCommand
{ commandProgramName :: [Char]
commandProgramName = [Char]
"darcs"
, commandName :: [Char]
commandName = [Char]
"export"
, commandHelp :: Doc
commandHelp = Doc
convertExportHelp
, commandDescription :: [Char]
commandDescription = [Char]
"Export a darcs repository to a git-fast-import stream"
, commandExtraArgs :: Int
commandExtraArgs = Int
0
, commandExtraArgHelp :: [[Char]]
commandExtraArgHelp = []
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
fastExport
, commandPrereq :: [DarcsFlag] -> IO (Either [Char] ())
commandPrereq = [DarcsFlag] -> IO (Either [Char] ())
amInRepository
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [[Char]] -> IO [[Char]]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [[Char]] -> IO [[Char]]
noArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
nodefaults
, commandOptions :: CommandOptions
commandOptions = CommandOptions
convertExportOpts
}
where
convertExportBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe [Char] -> Maybe AbsolutePath -> Maybe AbsolutePath -> a)
convertExportBasicOpts = PrimOptSpec
DarcsOptDescr
DarcsFlag
(Maybe AbsolutePath -> Maybe AbsolutePath -> a)
(Maybe [Char])
PrimDarcsOption (Maybe [Char])
O.repoDir PrimOptSpec
DarcsOptDescr
DarcsFlag
(Maybe AbsolutePath -> Maybe AbsolutePath -> a)
(Maybe [Char])
-> OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe AbsolutePath -> Maybe AbsolutePath -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe [Char] -> Maybe AbsolutePath -> Maybe AbsolutePath -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe AbsolutePath -> Maybe AbsolutePath -> a)
forall a.
DarcsOption a (Maybe AbsolutePath -> Maybe AbsolutePath -> a)
O.marks
convertExportAdvancedOpts :: PrimOptSpec DarcsOptDescr DarcsFlag a RemoteDarcs
convertExportAdvancedOpts = PrimOptSpec DarcsOptDescr DarcsFlag a RemoteDarcs
PrimDarcsOption RemoteDarcs
O.remoteDarcs
convertExportOpts :: CommandOptions
convertExportOpts = OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Verbosity
-> RemoteDarcs
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
(Maybe [Char]
-> Maybe AbsolutePath
-> Maybe AbsolutePath
-> Maybe StdCmdAction
-> Verbosity
-> RemoteDarcs
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe [Char] -> Maybe AbsolutePath -> Maybe AbsolutePath -> a)
convertExportBasicOpts OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Verbosity
-> RemoteDarcs
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
(Maybe [Char]
-> Maybe AbsolutePath
-> Maybe AbsolutePath
-> Maybe StdCmdAction
-> Verbosity
-> RemoteDarcs
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
-> DarcsOption
(UseCache
-> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
(RemoteDarcs
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
-> CommandOptions
forall b c.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache
-> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
b
-> CommandOptions
`withStdOpts` DarcsOption
(UseCache
-> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
(RemoteDarcs
-> UseCache
-> UseIndex
-> HooksConfig
-> Bool
-> Bool
-> [DarcsFlag])
PrimDarcsOption RemoteDarcs
convertExportAdvancedOpts
fastExport :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
fastExport :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
fastExport (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [[Char]]
_ = do
Marks
marks <- case (forall a.
PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe AbsolutePath))
-> [DarcsFlag] -> Maybe AbsolutePath
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe AbsolutePath)
forall a.
PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe AbsolutePath)
O.readMarks [DarcsFlag]
opts of
Maybe AbsolutePath
Nothing -> Marks -> IO Marks
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Marks
emptyMarks
Just AbsolutePath
f -> [Char] -> IO Marks
readMarks (AbsolutePath -> [Char]
forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
f)
Marks
newMarks <-
UseCache -> RepoJob 'RO Marks -> IO Marks
forall a. UseCache -> RepoJob 'RO a -> IO a
withRepository (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (RepoJob 'RO Marks -> IO Marks) -> RepoJob 'RO Marks -> IO Marks
forall a b. (a -> b) -> a -> b
$ TreePatchJob 'RO Marks -> RepoJob 'RO Marks
forall (rt :: AccessType) a. TreePatchJob rt a -> RepoJob rt a
RepoJob (TreePatchJob 'RO Marks -> RepoJob 'RO Marks)
-> TreePatchJob 'RO Marks -> RepoJob 'RO Marks
forall a b. (a -> b) -> a -> b
$ \Repository 'RO p wU wR
repo -> Repository 'RO p wU wR -> Marks -> IO Marks
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> Marks -> IO Marks
fastExport' Repository 'RO p wU wR
repo Marks
marks
case (forall a.
PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe AbsolutePath))
-> [DarcsFlag] -> Maybe AbsolutePath
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe AbsolutePath)
forall a.
PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe AbsolutePath)
O.writeMarks [DarcsFlag]
opts of
Maybe AbsolutePath
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just AbsolutePath
f -> [Char] -> Marks -> IO ()
writeMarks (AbsolutePath -> [Char]
forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
f) Marks
newMarks
fastExport' :: (RepoPatch p, ApplyState p ~ Tree)
=> Repository rt p wU wR -> Marks -> IO Marks
fastExport' :: forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
(RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wU wR -> Marks -> IO Marks
fastExport' Repository rt p wU wR
repo Marks
marks = do
[Char] -> IO ()
putStrLn [Char]
"progress (reading repository)"
PatchSet p Origin wR
patchset <- Repository rt p wU wR -> IO (PatchSet p Origin wR)
forall (p :: * -> * -> *) (rt :: AccessType) wU wR.
RepoPatch p =>
Repository rt p wU wR -> IO (PatchSet p Origin wR)
readPatches Repository rt p wU wR
repo
IORef Marks
marksref <- Marks -> IO (IORef Marks)
forall a. a -> IO (IORef a)
newIORef Marks
marks
let patches :: FL (PatchInfoAnd p) Origin wR
patches = PatchSet p Origin wR -> FL (PatchInfoAnd p) Origin wR
forall (p :: * -> * -> *) wStart wX.
PatchSet p wStart wX -> FL (PatchInfoAnd p) wStart wX
patchSet2FL PatchSet p Origin wR
patchset
tags :: [PatchInfo]
tags = PatchSet p Origin wR -> [PatchInfo]
forall (p :: * -> * -> *) wS wX. PatchSet p wS wX -> [PatchInfo]
inOrderTags PatchSet p Origin wR
patchset
mark :: (PatchInfoAnd p) x y -> Int -> TreeIO ()
mark :: forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ()
mark PatchInfoAnd p x y
p Int
n = IO () -> TreeIO ()
forall a. IO a -> RWST (DumpItem IO) () (TreeState IO) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> TreeIO ()) -> IO () -> TreeIO ()
forall a b. (a -> b) -> a -> b
$ do [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"mark :" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n
IORef Marks -> (Marks -> Marks) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef Marks
marksref ((Marks -> Marks) -> IO ()) -> (Marks -> Marks) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Marks
m -> Marks -> Int -> ByteString -> Marks
addMark Marks
m Int
n (PatchInfoAnd p x y -> ByteString
forall (p :: * -> * -> *) cX cY. PatchInfoAnd p cX cY -> ByteString
patchHash PatchInfoAnd p x y
p)
checkOne :: (RepoPatch p, ApplyState p ~ Tree)
=> Int -> (PatchInfoAnd p) x y -> TreeIO ()
checkOne :: forall (p :: * -> * -> *) x y.
(RepoPatch p, ApplyState p ~ Tree) =>
Int -> PatchInfoAnd p x y -> TreeIO ()
checkOne Int
n PatchInfoAnd p x y
p = do PatchInfoAnd p x y -> TreeIO ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (PatchInfoAndG (Named p))) m =>
PatchInfoAndG (Named p) wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply PatchInfoAnd p x y
p
Bool -> TreeIO () -> TreeIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([PatchInfo] -> PatchInfoAnd p x y -> Bool
forall (p :: * -> * -> *) wX wZ.
Effect p =>
[PatchInfo] -> PatchInfoAnd p wX wZ -> Bool
inOrderTag [PatchInfo]
tags PatchInfoAnd p x y
p Bool -> Bool -> Bool
||
(Marks -> Int -> Maybe ByteString
getMark Marks
marks Int
n Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (PatchInfoAnd p x y -> ByteString
forall (p :: * -> * -> *) cX cY. PatchInfoAnd p cX cY -> ByteString
patchHash PatchInfoAnd p x y
p))) (TreeIO () -> TreeIO ()) -> TreeIO () -> TreeIO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> TreeIO ()
forall a. [Char] -> RWST (DumpItem IO) () (TreeState IO) IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> TreeIO ()) -> [Char] -> TreeIO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"FATAL: Marks do not correspond: expected " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
Maybe ByteString -> [Char]
forall a. Show a => a -> [Char]
show (Marks -> Int -> Maybe ByteString
getMark Marks
marks Int
n) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", got " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
BC.unpack (PatchInfoAnd p x y -> ByteString
forall (p :: * -> * -> *) cX cY. PatchInfoAnd p cX cY -> ByteString
patchHash PatchInfoAnd p x y
p)
check :: (RepoPatch p, ApplyState p ~ Tree)
=> Int -> FL (PatchInfoAnd p) x y -> TreeIO (Int, FlippedSeal( FL (PatchInfoAnd p)) y)
check :: forall (p :: * -> * -> *) x y.
(RepoPatch p, ApplyState p ~ Tree) =>
Int
-> FL (PatchInfoAnd p) x y
-> TreeIO (Int, FlippedSeal (FL (PatchInfoAnd p)) y)
check Int
_ FL (PatchInfoAnd p) x y
NilFL = (Int, FlippedSeal (FL (PatchInfoAnd p)) y)
-> RWST
(DumpItem IO)
()
(TreeState IO)
IO
(Int, FlippedSeal (FL (PatchInfoAnd p)) y)
forall a. a -> RWST (DumpItem IO) () (TreeState IO) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
1, FL (PatchInfoAnd p) y y -> FlippedSeal (FL (PatchInfoAnd p)) y
forall (a :: * -> * -> *) wX wY. a wX wY -> FlippedSeal a wY
flipSeal FL (PatchInfoAnd p) y y
forall (a :: * -> * -> *) wX. FL a wX wX
NilFL)
check Int
n allps :: FL (PatchInfoAnd p) x y
allps@(PatchInfoAnd p x wY
p:>:FL (PatchInfoAnd p) wY y
ps)
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Marks -> Int
lastMark Marks
marks = Int -> PatchInfoAnd p x wY -> TreeIO ()
forall (p :: * -> * -> *) x y.
(RepoPatch p, ApplyState p ~ Tree) =>
Int -> PatchInfoAnd p x y -> TreeIO ()
checkOne Int
n PatchInfoAnd p x wY
p TreeIO ()
-> RWST
(DumpItem IO)
()
(TreeState IO)
IO
(Int, FlippedSeal (FL (PatchInfoAnd p)) y)
-> RWST
(DumpItem IO)
()
(TreeState IO)
IO
(Int, FlippedSeal (FL (PatchInfoAnd p)) y)
forall a b.
RWST (DumpItem IO) () (TreeState IO) IO a
-> RWST (DumpItem IO) () (TreeState IO) IO b
-> RWST (DumpItem IO) () (TreeState IO) IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Int
-> FL (PatchInfoAnd p) wY y
-> RWST
(DumpItem IO)
()
(TreeState IO)
IO
(Int, FlippedSeal (FL (PatchInfoAnd p)) y)
forall (p :: * -> * -> *) x y.
(RepoPatch p, ApplyState p ~ Tree) =>
Int
-> FL (PatchInfoAnd p) x y
-> TreeIO (Int, FlippedSeal (FL (PatchInfoAnd p)) y)
check ([PatchInfo] -> Int -> PatchInfoAnd p x wY -> Int
forall (p :: * -> * -> *) x y.
Effect p =>
[PatchInfo] -> Int -> PatchInfoAnd p x y -> Int
next [PatchInfo]
tags Int
n PatchInfoAnd p x wY
p) FL (PatchInfoAnd p) wY y
ps
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Marks -> Int
lastMark Marks
marks = (Int, FlippedSeal (FL (PatchInfoAnd p)) y)
-> RWST
(DumpItem IO)
()
(TreeState IO)
IO
(Int, FlippedSeal (FL (PatchInfoAnd p)) y)
forall a. a -> RWST (DumpItem IO) () (TreeState IO) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
n, FL (PatchInfoAnd p) x y -> FlippedSeal (FL (PatchInfoAnd p)) y
forall (a :: * -> * -> *) wX wY. a wX wY -> FlippedSeal a wY
flipSeal FL (PatchInfoAnd p) x y
allps)
| Marks -> Int
lastMark Marks
marks Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = (Int, FlippedSeal (FL (PatchInfoAnd p)) y)
-> RWST
(DumpItem IO)
()
(TreeState IO)
IO
(Int, FlippedSeal (FL (PatchInfoAnd p)) y)
forall a. a -> RWST (DumpItem IO) () (TreeState IO) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
1, FL (PatchInfoAnd p) x y -> FlippedSeal (FL (PatchInfoAnd p)) y
forall (a :: * -> * -> *) wX wY. a wX wY -> FlippedSeal a wY
flipSeal FL (PatchInfoAnd p) x y
allps)
| Bool
otherwise = RWST
(DumpItem IO)
()
(TreeState IO)
IO
(Int, FlippedSeal (FL (PatchInfoAnd p)) y)
forall a. HasCallStack => a
undefined
((Int
n, FlippedSeal (FL (PatchInfoAnd p)) wR
patches'), Tree IO
tree') <- TreeIO (Int, FlippedSeal (FL (PatchInfoAnd p)) wR)
-> Tree IO
-> Cache
-> IO ((Int, FlippedSeal (FL (PatchInfoAnd p)) wR), Tree IO)
forall a. TreeIO a -> Tree IO -> Cache -> IO (a, Tree IO)
hashedTreeIO (Int
-> FL (PatchInfoAnd p) Origin wR
-> TreeIO (Int, FlippedSeal (FL (PatchInfoAnd p)) wR)
forall (p :: * -> * -> *) x y.
(RepoPatch p, ApplyState p ~ Tree) =>
Int
-> FL (PatchInfoAnd p) x y
-> TreeIO (Int, FlippedSeal (FL (PatchInfoAnd p)) y)
check Int
1 FL (PatchInfoAnd p) Origin wR
patches) Tree IO
forall (m :: * -> *). Tree m
emptyTree (Repository rt p wU wR -> Cache
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> Cache
repoCache Repository rt p wU wR
repo)
let patches'' :: FL (PatchInfoAnd p) wB wC
patches'' = (forall wX wY.
FL (PatchInfoAnd p) wX wY -> FL (PatchInfoAnd p) wB wC)
-> FlippedSeal (FL (PatchInfoAnd p)) wR
-> FL (PatchInfoAnd p) wB wC
forall (a :: * -> * -> *) b wZ.
(forall wX wY. a wX wY -> b) -> FlippedSeal a wZ -> b
unsealFlipped FL (PatchInfoAnd p) wX wY -> FL (PatchInfoAnd p) wB wC
forall wX wY.
FL (PatchInfoAnd p) wX wY -> FL (PatchInfoAnd p) wB wC
forall (a :: * -> * -> *) wX wY wB wC. a wX wY -> a wB wC
unsafeCoerceP FlippedSeal (FL (PatchInfoAnd p)) wR
patches'
IO ((), Tree IO) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ((), Tree IO) -> IO ()) -> IO ((), Tree IO) -> IO ()
forall a b. (a -> b) -> a -> b
$ TreeIO () -> Tree IO -> Cache -> IO ((), Tree IO)
forall a. TreeIO a -> Tree IO -> Cache -> IO (a, Tree IO)
hashedTreeIO ([PatchInfo]
-> (forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ())
-> Int
-> FL (PatchInfoAnd p) Any Any
-> TreeIO ()
forall (p :: * -> * -> *) x y.
(RepoPatch p, ApplyState p ~ Tree) =>
[PatchInfo]
-> (forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ())
-> Int
-> FL (PatchInfoAnd p) x y
-> TreeIO ()
dumpPatches [PatchInfo]
tags PatchInfoAnd p0 x0 y0 -> Int -> TreeIO ()
forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ()
mark Int
n FL (PatchInfoAnd p) Any Any
forall {wB} {wC}. FL (PatchInfoAnd p) wB wC
patches'') Tree IO
tree' (Repository rt p wU wR -> Cache
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> Cache
repoCache Repository rt p wU wR
repo)
IORef Marks -> IO Marks
forall a. IORef a -> IO a
readIORef IORef Marks
marksref
IO Marks -> IO () -> IO Marks
forall a b. IO a -> IO b -> IO a
`finally` do
[Char] -> IO ()
putStrLn [Char]
"progress (cleaning up)"
PristineHash
current <- Repository rt p wU wR -> IO PristineHash
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> IO PristineHash
readHashedPristineRoot Repository rt p wU wR
repo
Cache -> [PristineHash] -> IO ()
cleanPristineDir (Repository rt p wU wR -> Cache
forall (rt :: AccessType) (p :: * -> * -> *) wU wR.
Repository rt p wU wR -> Cache
repoCache Repository rt p wU wR
repo) [PristineHash
current]
[Char] -> IO ()
putStrLn [Char]
"progress done"
dumpPatches :: (RepoPatch p, ApplyState p ~ Tree)
=> [PatchInfo]
-> (forall p0 x0 y0 . (PatchInfoAnd p0) x0 y0 -> Int -> TreeIO ())
-> Int -> FL (PatchInfoAnd p) x y -> TreeIO ()
dumpPatches :: forall (p :: * -> * -> *) x y.
(RepoPatch p, ApplyState p ~ Tree) =>
[PatchInfo]
-> (forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ())
-> Int
-> FL (PatchInfoAnd p) x y
-> TreeIO ()
dumpPatches [PatchInfo]
_ forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ()
_ Int
_ FL (PatchInfoAnd p) x y
NilFL = IO () -> TreeIO ()
forall a. IO a -> RWST (DumpItem IO) () (TreeState IO) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> TreeIO ()) -> IO () -> TreeIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"progress (patches converted)"
dumpPatches [PatchInfo]
tags forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ()
mark Int
n (PatchInfoAnd p x wY
p:>:FL (PatchInfoAnd p) wY y
ps) = do
PatchInfoAnd p x wY -> TreeIO ()
forall (m :: * -> *) wX wY.
ApplyMonad (ApplyState (PatchInfoAnd p)) m =>
PatchInfoAndG (Named p) wX wY -> m ()
forall (p :: * -> * -> *) (m :: * -> *) wX wY.
(Apply p, ApplyMonad (ApplyState p) m) =>
p wX wY -> m ()
apply PatchInfoAnd p x wY
p
if [PatchInfo] -> PatchInfoAnd p x wY -> Bool
forall (p :: * -> * -> *) wX wZ.
Effect p =>
[PatchInfo] -> PatchInfoAnd p wX wZ -> Bool
inOrderTag [PatchInfo]
tags PatchInfoAnd p x wY
p Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then PatchInfoAnd p x wY -> Int -> TreeIO ()
forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ()
dumpTag PatchInfoAnd p x wY
p Int
n
else do (forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ())
-> PatchInfoAnd p x wY -> Int -> TreeIO ()
forall (p :: * -> * -> *) x y.
(forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ())
-> PatchInfoAnd p x y -> Int -> TreeIO ()
dumpPatch PatchInfoAnd p0 x0 y0 -> Int -> TreeIO ()
forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ()
mark PatchInfoAnd p x wY
p Int
n
[AnchoredPath] -> TreeIO ()
dumpFiles ([AnchoredPath] -> TreeIO ()) -> [AnchoredPath] -> TreeIO ()
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd p x wY -> [AnchoredPath]
forall wX wY. PatchInfoAndG (Named p) wX wY -> [AnchoredPath]
forall (p :: * -> * -> *) wX wY.
PatchInspect p =>
p wX wY -> [AnchoredPath]
listTouchedFiles PatchInfoAnd p x wY
p
[PatchInfo]
-> (forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ())
-> Int
-> FL (PatchInfoAnd p) wY y
-> TreeIO ()
forall (p :: * -> * -> *) x y.
(RepoPatch p, ApplyState p ~ Tree) =>
[PatchInfo]
-> (forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ())
-> Int
-> FL (PatchInfoAnd p) x y
-> TreeIO ()
dumpPatches [PatchInfo]
tags PatchInfoAnd p0 x0 y0 -> Int -> TreeIO ()
forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ()
mark ([PatchInfo] -> Int -> PatchInfoAnd p x wY -> Int
forall (p :: * -> * -> *) x y.
Effect p =>
[PatchInfo] -> Int -> PatchInfoAnd p x y -> Int
next [PatchInfo]
tags Int
n PatchInfoAnd p x wY
p) FL (PatchInfoAnd p) wY y
ps
dumpTag :: (PatchInfoAnd p) x y -> Int -> TreeIO ()
dumpTag :: forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ()
dumpTag PatchInfoAnd p x y
p Int
n =
[ByteString] -> TreeIO ()
dumpBits [ [Char] -> ByteString
BLU.fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"progress TAG " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PatchInfoAnd p x y -> [Char]
forall {p :: * -> * -> *} {wA} {wB}.
PatchInfoAndG p wA wB -> [Char]
cleanTagName PatchInfoAnd p x y
p
, [Char] -> ByteString
BLU.fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"tag " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PatchInfoAnd p x y -> [Char]
forall {p :: * -> * -> *} {wA} {wB}.
PatchInfoAndG p wA wB -> [Char]
cleanTagName PatchInfoAnd p x y
p
, [Char] -> ByteString
BLU.fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"from :" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
, [Char] -> ByteString
BLU.fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
unwords [[Char]
"tagger", PatchInfoAnd p x y -> [Char]
forall (p :: * -> * -> *) x y. PatchInfoAnd p x y -> [Char]
patchAuthor PatchInfoAnd p x y
p, PatchInfoAnd p x y -> [Char]
forall (p :: * -> * -> *) x y. PatchInfoAnd p x y -> [Char]
patchDate PatchInfoAnd p x y
p]
, [Char] -> ByteString
BLU.fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"data "
[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int64 -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int64
BL.length (PatchInfoAnd p x y -> ByteString
forall (p :: * -> * -> *) x y. PatchInfoAnd p x y -> ByteString
patchMessage PatchInfoAnd p x y
p) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
3)
, Int64 -> ByteString -> ByteString
BL.drop Int64
4 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd p x y -> ByteString
forall (p :: * -> * -> *) x y. PatchInfoAnd p x y -> ByteString
patchMessage PatchInfoAnd p x y
p ]
where
cleanTagName :: PatchInfoAndG p wA wB -> [Char]
cleanTagName = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
cleanup ([Char] -> [Char])
-> (PatchInfoAndG p wA wB -> [Char])
-> PatchInfoAndG p wA wB
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char] -> [Char]
forall a. Int -> [a] -> [a]
drop Int
4 ([Char] -> [Char])
-> (PatchInfoAndG p wA wB -> [Char])
-> PatchInfoAndG p wA wB
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> [Char]
piName (PatchInfo -> [Char])
-> (PatchInfoAndG p wA wB -> PatchInfo)
-> PatchInfoAndG p wA wB
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAndG p wA wB -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info
where cleanup :: Char -> Char
cleanup Char
x | Char
x Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
bad = Char
'_'
| Bool
otherwise = Char
x
bad :: String
bad :: [Char]
bad = [Char]
" ~^:"
dumpFiles :: [AnchoredPath] -> TreeIO ()
dumpFiles :: [AnchoredPath] -> TreeIO ()
dumpFiles [AnchoredPath]
files = [AnchoredPath] -> (AnchoredPath -> TreeIO ()) -> TreeIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [AnchoredPath]
files ((AnchoredPath -> TreeIO ()) -> TreeIO ())
-> (AnchoredPath -> TreeIO ()) -> TreeIO ()
forall a b. (a -> b) -> a -> b
$ \AnchoredPath
file -> do
let quotedPath :: [Char]
quotedPath = [Char] -> [Char]
quotePath ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> AnchoredPath -> [Char]
anchorPath [Char]
"" AnchoredPath
file
Bool
isfile <- AnchoredPath -> TreeMonad IO Bool
forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m Bool
T.fileExists AnchoredPath
file
Bool
isdir <- AnchoredPath -> TreeMonad IO Bool
forall (m :: * -> *). Monad m => AnchoredPath -> TreeMonad m Bool
T.directoryExists AnchoredPath
file
Bool -> TreeIO () -> TreeIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isfile (TreeIO () -> TreeIO ()) -> TreeIO () -> TreeIO ()
forall a b. (a -> b) -> a -> b
$ do ByteString
bits <- AnchoredPath -> TreeMonad IO ByteString
forall (m :: * -> *).
MonadThrow m =>
AnchoredPath -> TreeMonad m ByteString
T.readFile AnchoredPath
file
[ByteString] -> TreeIO ()
dumpBits [ [Char] -> ByteString
BLU.fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"M 100644 inline " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
quotedPath
, [Char] -> ByteString
BLU.fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"data " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int64 -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int64
BL.length ByteString
bits)
, ByteString
bits ]
Bool -> TreeIO () -> TreeIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isdir (TreeIO () -> TreeIO ()) -> TreeIO () -> TreeIO ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> TreeIO ()
forall a. IO a -> RWST (DumpItem IO) () (TreeState IO) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> TreeIO ()) -> IO () -> TreeIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"D " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
quotedPath
Tree IO
tt <- (TreeState IO -> Tree IO)
-> RWST (DumpItem IO) () (TreeState IO) IO (Tree IO)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets TreeState IO -> Tree IO
forall (m :: * -> *). TreeState m -> Tree m
T.tree
let subs :: [AnchoredPath]
subs = [ AnchoredPath
file AnchoredPath -> Name -> AnchoredPath
`appendPath` Name
n | (Name
n, TreeItem IO
_) <-
Tree IO -> [(Name, TreeItem IO)]
forall (m :: * -> *). Tree m -> [(Name, TreeItem m)]
listImmediate (Tree IO -> [(Name, TreeItem IO)])
-> Tree IO -> [(Name, TreeItem IO)]
forall a b. (a -> b) -> a -> b
$ Maybe (Tree IO) -> Tree IO
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Tree IO) -> Tree IO) -> Maybe (Tree IO) -> Tree IO
forall a b. (a -> b) -> a -> b
$ Tree IO -> AnchoredPath -> Maybe (Tree IO)
forall (m :: * -> *). Tree m -> AnchoredPath -> Maybe (Tree m)
findTree Tree IO
tt AnchoredPath
file ]
[AnchoredPath] -> TreeIO ()
dumpFiles [AnchoredPath]
subs
Bool -> TreeIO () -> TreeIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isfile Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isdir) (TreeIO () -> TreeIO ()) -> TreeIO () -> TreeIO ()
forall a b. (a -> b) -> a -> b
$ IO () -> TreeIO ()
forall a. IO a -> RWST (DumpItem IO) () (TreeState IO) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> TreeIO ()) -> IO () -> TreeIO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"D " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
quotedPath
where
quotePath :: FilePath -> String
quotePath :: [Char] -> [Char]
quotePath [Char]
path = case (Char -> ([Char], Bool) -> ([Char], Bool))
-> ([Char], Bool) -> [Char] -> ([Char], Bool)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ([Char], Bool) -> ([Char], Bool)
escapeChars ([Char]
"", Bool
False) [Char]
path of
([Char]
_, Bool
False) -> [Char]
path
([Char]
path', Bool
True) -> [Char] -> [Char]
quote [Char]
path'
quote :: [Char] -> [Char]
quote [Char]
str = [Char]
"\"" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
str [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\""
escapeChars :: Char -> ([Char], Bool) -> ([Char], Bool)
escapeChars Char
c ([Char]
processed, Bool
haveEscaped) = case Char -> ([Char], Bool)
escapeChar Char
c of
([Char]
escaped, Bool
didEscape) ->
([Char]
escaped [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
processed, Bool
didEscape Bool -> Bool -> Bool
|| Bool
haveEscaped)
escapeChar :: Char -> ([Char], Bool)
escapeChar Char
c = case Char
c of
Char
'\n' -> ([Char]
"\\n", Bool
True)
Char
'\r' -> ([Char]
"\\r", Bool
True)
Char
'"' -> ([Char]
"\\\"", Bool
True)
Char
'\\' -> ([Char]
"\\\\", Bool
True)
Char
_ -> ([Char
c], Bool
False)
dumpPatch :: (forall p0 x0 y0 . (PatchInfoAnd p0) x0 y0 -> Int -> TreeIO ())
-> (PatchInfoAnd p) x y -> Int
-> TreeIO ()
dumpPatch :: forall (p :: * -> * -> *) x y.
(forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ())
-> PatchInfoAnd p x y -> Int -> TreeIO ()
dumpPatch forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ()
mark PatchInfoAnd p x y
p Int
n =
do [ByteString] -> TreeIO ()
dumpBits [ [Char] -> ByteString
BLU.fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"progress " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
": " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PatchInfo -> [Char]
piName (PatchInfoAnd p x y -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p x y
p)
, ByteString
"commit refs/heads/master" ]
PatchInfoAnd p x y -> Int -> TreeIO ()
forall (p :: * -> * -> *) x y.
PatchInfoAnd p x y -> Int -> TreeIO ()
mark PatchInfoAnd p x y
p Int
n
[ByteString] -> TreeIO ()
dumpBits [ [Char] -> ByteString
BLU.fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"committer " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PatchInfoAnd p x y -> [Char]
forall (p :: * -> * -> *) x y. PatchInfoAnd p x y -> [Char]
patchAuthor PatchInfoAnd p x y
p [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ PatchInfoAnd p x y -> [Char]
forall (p :: * -> * -> *) x y. PatchInfoAnd p x y -> [Char]
patchDate PatchInfoAnd p x y
p
, [Char] -> ByteString
BLU.fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"data " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int64 -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int64
BL.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd p x y -> ByteString
forall (p :: * -> * -> *) x y. PatchInfoAnd p x y -> ByteString
patchMessage PatchInfoAnd p x y
p)
, PatchInfoAnd p x y -> ByteString
forall (p :: * -> * -> *) x y. PatchInfoAnd p x y -> ByteString
patchMessage PatchInfoAnd p x y
p ]
Bool -> TreeIO () -> TreeIO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (TreeIO () -> TreeIO ()) -> TreeIO () -> TreeIO ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> TreeIO ()
dumpBits [ [Char] -> ByteString
BLU.fromString ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"from :" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ]
dumpBits :: [BL.ByteString] -> TreeIO ()
dumpBits :: [ByteString] -> TreeIO ()
dumpBits = IO () -> TreeIO ()
forall a. IO a -> RWST (DumpItem IO) () (TreeState IO) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> TreeIO ())
-> ([ByteString] -> IO ()) -> [ByteString] -> TreeIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> IO ()
BLC.putStrLn (ByteString -> IO ())
-> ([ByteString] -> ByteString) -> [ByteString] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
BL.intercalate ByteString
"\n"
patchAuthor :: (PatchInfoAnd p) x y -> String
patchAuthor :: forall (p :: * -> * -> *) x y. PatchInfoAnd p x y -> [Char]
patchAuthor = [Char] -> [Char]
cleanPatchAuthor ([Char] -> [Char])
-> (PatchInfoAnd p x y -> [Char]) -> PatchInfoAnd p x y -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> [Char]
piAuthor (PatchInfo -> [Char])
-> (PatchInfoAnd p x y -> PatchInfo)
-> PatchInfoAnd p x y
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd p x y -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info
cleanPatchAuthor :: String -> String
cleanPatchAuthor :: [Char] -> [Char]
cleanPatchAuthor [Char]
authorString
| [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
author = [Char] -> [Char]
unknownEmail [Char]
"unknown"
| Bool
otherwise = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'<') [Char]
author of
([Char]
"", Char
_:[Char]
email) -> case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'@') [Char]
email of
([Char]
n, [Char]
"") -> case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'>') [Char]
n of
([Char]
name, [Char]
_) -> [Char] -> [Char]
unknownEmail [Char]
name
([Char]
user, Char
_:[Char]
rest) -> case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'>') [Char]
rest of
([Char]
dom, [Char]
_) -> [Char] -> [Char] -> [Char]
mkAuthor [Char]
user ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
emailPad ([Char]
user [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"@" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
dom)
([Char]
_, [Char]
"") -> case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'@') [Char]
author of
([Char]
n, [Char]
"") -> [Char] -> [Char]
unknownEmail [Char]
n
([Char]
name, [Char]
_) -> [Char] -> [Char] -> [Char]
mkAuthor [Char]
name ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
emailPad [Char]
author
([Char]
n, Char
_:[Char]
rest) -> case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'>') [Char]
rest of
([Char]
email, [Char]
_) -> [Char]
n [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
emailPad [Char]
email
where
author :: [Char]
author = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace [Char]
authorString
unknownEmail :: [Char] -> [Char]
unknownEmail = ([Char] -> [Char] -> [Char]) -> [Char] -> [Char] -> [Char]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> [Char] -> [Char]
mkAuthor [Char]
"<unknown>"
emailPad :: [Char] -> [Char]
emailPad [Char]
email = [Char]
"<" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
email [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
">"
mkAuthor :: [Char] -> [Char] -> [Char]
mkAuthor [Char]
name [Char]
email = [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
email
cleanPatchAuthorTestCases :: [(String, String)]
cleanPatchAuthorTestCases :: [([Char], [Char])]
cleanPatchAuthorTestCases =
[ ([Char]
"<john@home>", [Char]
"john <john@home>")
, ([Char]
"john@home", [Char]
"john <john@home>")
, ([Char]
"john <john@home>", [Char]
"john <john@home>")
, ([Char]
"john <john@home", [Char]
"john <john@home>")
, ([Char]
"<john>", [Char]
"john <unknown>")
, ([Char]
"", [Char]
"unknown <unknown>")
, ([Char]
" ", [Char]
"unknown <unknown>")
]
patchDate :: (PatchInfoAnd p) x y -> String
patchDate :: forall (p :: * -> * -> *) x y. PatchInfoAnd p x y -> [Char]
patchDate = [Char] -> UTCTime -> [Char]
formatDateTime [Char]
"%s +0000" (UTCTime -> [Char])
-> (PatchInfoAnd p x y -> UTCTime) -> PatchInfoAnd p x y -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClockTime -> UTCTime
fromClockTime (ClockTime -> UTCTime)
-> (PatchInfoAnd p x y -> ClockTime)
-> PatchInfoAnd p x y
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CalendarTime -> ClockTime
toClockTime (CalendarTime -> ClockTime)
-> (PatchInfoAnd p x y -> CalendarTime)
-> PatchInfoAnd p x y
-> ClockTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
PatchInfo -> CalendarTime
piDate (PatchInfo -> CalendarTime)
-> (PatchInfoAnd p x y -> PatchInfo)
-> PatchInfoAnd p x y
-> CalendarTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfoAnd p x y -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info
patchMessage :: (PatchInfoAnd p) x y -> BLU.ByteString
patchMessage :: forall (p :: * -> * -> *) x y. PatchInfoAnd p x y -> ByteString
patchMessage PatchInfoAnd p x y
p = [ByteString] -> ByteString
BL.concat [ [Char] -> ByteString
BLU.fromString (PatchInfo -> [Char]
piName (PatchInfo -> [Char]) -> PatchInfo -> [Char]
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd p x y -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p x y
p)
, case [[Char]] -> [Char]
unlines ([[Char]] -> [Char])
-> (PatchInfo -> [[Char]]) -> PatchInfo -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PatchInfo -> [[Char]]
piLog (PatchInfo -> [Char]) -> PatchInfo -> [Char]
forall a b. (a -> b) -> a -> b
$ PatchInfoAnd p x y -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p x y
p of
[Char]
"" -> ByteString
BL.empty
[Char]
plog -> [Char] -> ByteString
BLU.fromString ([Char]
"\n\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
plog)
]
inOrderTag :: (Effect p) => [PatchInfo] -> PatchInfoAnd p wX wZ -> Bool
inOrderTag :: forall (p :: * -> * -> *) wX wZ.
Effect p =>
[PatchInfo] -> PatchInfoAnd p wX wZ -> Bool
inOrderTag [PatchInfo]
tags PatchInfoAnd p wX wZ
p = PatchInfo -> Bool
isTag (PatchInfoAnd p wX wZ -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wX wZ
p) Bool -> Bool -> Bool
&& PatchInfoAnd p wX wZ -> PatchInfo
forall (p :: * -> * -> *) wA wB. PatchInfoAndG p wA wB -> PatchInfo
info PatchInfoAnd p wX wZ
p PatchInfo -> [PatchInfo] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PatchInfo]
tags Bool -> Bool -> Bool
&& FL (PrimOf p) wX wZ -> Bool
forall (a :: * -> * -> *) wX wZ. FL a wX wZ -> Bool
nullFL (PatchInfoAnd p wX wZ -> FL (PrimOf (PatchInfoAndG (Named p))) wX wZ
forall wX wY.
PatchInfoAndG (Named p) wX wY
-> FL (PrimOf (PatchInfoAndG (Named p))) wX wY
forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect PatchInfoAnd p wX wZ
p)
next :: (Effect p) => [PatchInfo] -> Int -> PatchInfoAnd p x y -> Int
next :: forall (p :: * -> * -> *) x y.
Effect p =>
[PatchInfo] -> Int -> PatchInfoAnd p x y -> Int
next [PatchInfo]
tags Int
n PatchInfoAnd p x y
p = if [PatchInfo] -> PatchInfoAnd p x y -> Bool
forall (p :: * -> * -> *) wX wZ.
Effect p =>
[PatchInfo] -> PatchInfoAnd p wX wZ -> Bool
inOrderTag [PatchInfo]
tags PatchInfoAnd p x y
p then Int
n else Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1