module Darcs.UI.Commands.Convert.Darcs2 ( convertDarcs2 ) where
import Control.Monad ( when, unless )
import qualified Data.ByteString as B
import Data.Maybe ( catMaybes )
import Data.List ( lookup )
import System.FilePath.Posix ( (</>) )
import System.Directory ( doesDirectoryExist, doesFileExist )
import Darcs.Prelude
import Darcs.Patch ( RepoPatch, effect, displayPatch )
import Darcs.Patch.Apply ( ApplyState )
import Darcs.Patch.Info ( isTag, piRename, piTag )
import Darcs.Patch.Named ( Named(..), getdeps, patch2patchinfo, patchcontents )
import Darcs.Patch.PatchInfoAnd ( PatchInfoAnd, hopefully, info, n2pia )
import Darcs.Patch.Progress ( progressFL )
import Darcs.Patch.RepoType ( IsRepoType(..), RebaseType(..), RepoType(..) )
import Darcs.Patch.Set ( inOrderTags, patchSet2FL, patchSet2RL )
import qualified Darcs.Patch.V1 as V1 ( RepoPatchV1 )
import Darcs.Patch.V1.Commute ( publicUnravel )
import qualified Darcs.Patch.V1.Core as V1 ( RepoPatchV1(PP), isMerger )
import qualified Darcs.Patch.V1.Prim as V1 ( Prim(..) )
import qualified Darcs.Patch.V2.Prim as V2 ( Prim(..) )
import qualified Darcs.Patch.V2.RepoPatch as V2 ( RepoPatchV2(Normal) )
import Darcs.Patch.V2.RepoPatch ( mergeUnravelled )
import Darcs.Patch.Witnesses.Eq ( EqCheck(..), (=/\=) )
import Darcs.Patch.Witnesses.Ordered
( FL(..)
, bunchFL
, concatFL
, foldFL_M
, mapFL_FL
, mapRL
)
import Darcs.Patch.Witnesses.Sealed ( FlippedSeal(..), mapSeal )
import Darcs.Repository
( RepoJob(..)
, Repository
, applyToWorking
, createRepositoryV2
, finalizeRepositoryChanges
, invalidateIndex
, readRepo
, revertRepositoryChanges
, withRepositoryLocation
, withUMaskFlag
)
import qualified Darcs.Repository as R ( setScriptsExecutable )
import Darcs.Repository.Flags ( Compression(..), UpdatePending(..) )
import Darcs.Repository.Format
( RepoProperty(Darcs2)
, formatHas
, identifyRepoFormat
)
import Darcs.Repository.Hashed ( UpdatePristine(..), tentativelyAddPatch_ )
import Darcs.Repository.Prefs ( showMotd, prefsFilePath )
import Darcs.UI.Commands ( DarcsCommand(..), nodefaults, putFinished, withStdOpts )
import Darcs.UI.Commands.Convert.Util ( updatePending )
import Darcs.UI.Completion ( noArgs )
import Darcs.UI.Flags
( verbosity, useCache, umask, withWorkingDir, patchIndexNo
, DarcsFlag, withNewRepo
, quiet
)
import Darcs.UI.Options ( (^), odesc, ocheck, defaultFlags, parseFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.Util.External ( fetchFilePS, Cachable(Uncachable) )
import Darcs.Util.Exception ( catchall )
import Darcs.Util.Lock ( withNewDirectory )
import Darcs.Util.Path( ioAbsoluteOrRemote, toPath, AbsolutePath )
import Darcs.Util.Printer ( Doc, text, ($$) )
import Darcs.Util.Printer.Color ( traceDoc )
import Darcs.Util.Prompt ( askUser )
import Darcs.Util.Tree( Tree )
import Darcs.Util.Workaround ( getCurrentDirectory )
type RepoPatchV1 = V1.RepoPatchV1 V1.Prim
type RepoPatchV2 = V2.RepoPatchV2 V2.Prim
convertDarcs2Help :: Doc
convertDarcs2Help :: Doc
convertDarcs2Help = String -> Doc
text forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"This command converts a repository that uses the old patch semantics"
, String
"`darcs-1` to a new repository with current `darcs-2` semantics."
, String
""
, String
convertDarcs2Help'
]
convertDarcs2Help' :: String
convertDarcs2Help' :: String
convertDarcs2Help' = [String] -> String
unlines
[ String
"WARNING: the repository produced by this command is not understood by"
, String
"Darcs 1.x, and patches cannot be exchanged between repositories in"
, String
"darcs-1 and darcs-2 formats."
, String
""
, String
"Furthermore, repositories created by different invocations of"
, String
"this command SHOULD NOT exchange patches."
]
convertDarcs2 :: DarcsCommand
convertDarcs2 :: DarcsCommand
convertDarcs2 = DarcsCommand
{ commandProgramName :: String
commandProgramName = String
"darcs"
, commandName :: String
commandName = String
"darcs-2"
, commandHelp :: Doc
commandHelp = Doc
convertDarcs2Help
, commandDescription :: String
commandDescription = String
"Convert darcs-1 repository to the darcs-2 patch format"
, commandExtraArgs :: Int
commandExtraArgs = -Int
1
, commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"<SOURCE>", String
"[<DESTINATION>]"]
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
toDarcs2
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = \[DarcsFlag]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String]
noArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [String] -> IO [String]
nodefaults
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(NetworkOptions -> WithPatchIndex -> UMask -> a)
convertDarcs2AdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe String -> SetScriptsExecutable -> WithWorkingDir -> a)
convertDarcs2BasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags (forall {a}.
DarcsOption
a
(Maybe String
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Verbosity
-> NetworkOptions
-> WithPatchIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
convertDarcs2Opts forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ forall {a}. PrimOptSpec DarcsOptDescr DarcsFlag a PatchFormat
convertDarcs2SilentOpts)
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck forall {a}.
DarcsOption
a
(Maybe String
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Verbosity
-> NetworkOptions
-> WithPatchIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
convertDarcs2Opts
}
where
convertDarcs2BasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe String -> SetScriptsExecutable -> WithWorkingDir -> a)
convertDarcs2BasicOpts = PrimDarcsOption (Maybe String)
O.newRepo forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption SetScriptsExecutable
O.setScriptsExecutable forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption WithWorkingDir
O.withWorkingDir
convertDarcs2AdvancedOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(NetworkOptions -> WithPatchIndex -> UMask -> a)
convertDarcs2AdvancedOpts = PrimDarcsOption NetworkOptions
O.network forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption WithPatchIndex
O.patchIndexNo forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption UMask
O.umask
convertDarcs2Opts :: DarcsOption
a
(Maybe String
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Verbosity
-> NetworkOptions
-> WithPatchIndex
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
convertDarcs2Opts = forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe String -> SetScriptsExecutable -> WithWorkingDir -> a)
convertDarcs2BasicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(NetworkOptions -> WithPatchIndex -> UMask -> a)
convertDarcs2AdvancedOpts
convertDarcs2SilentOpts :: PrimOptSpec DarcsOptDescr DarcsFlag a PatchFormat
convertDarcs2SilentOpts = forall {a}. PrimOptSpec DarcsOptDescr DarcsFlag a PatchFormat
O.patchFormat
toDarcs2 :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
toDarcs2 :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
toDarcs2 (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts' [String]
args = do
(String
inrepodir, [DarcsFlag]
opts) <-
case [String]
args of
[String
arg1, String
arg2] -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
arg1, String -> [DarcsFlag] -> [DarcsFlag]
withNewRepo String
arg2 [DarcsFlag]
opts')
[String
arg1] -> forall (m :: * -> *) a. Monad m => a -> m a
return (String
arg1, [DarcsFlag]
opts')
[String]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"You must provide either one or two arguments."
AbsoluteOrRemotePath
typed_repodir <- String -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote String
inrepodir
let repodir :: String
repodir = forall a. FilePathOrURL a => a -> String
toPath AbsoluteOrRemotePath
typed_repodir
RepoFormat
format <- String -> IO RepoFormat
identifyRepoFormat String
repodir
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
Darcs2 RepoFormat
format) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Repository is already in darcs 2 format."
String -> IO ()
putStrLn String
convertDarcs2Help'
let vow :: String
vow = String
"I understand the consequences of my action"
String -> IO ()
putStrLn String
"Please confirm that you have read and understood the above"
String
vow' <- String -> IO String
askUser (String
"by typing `" forall a. [a] -> [a] -> [a]
++ String
vow forall a. [a] -> [a] -> [a]
++ String
"': ")
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
vow' forall a. Eq a => a -> a -> Bool
/= String
vow) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"User didn't understand the consequences."
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([DarcsFlag] -> Bool
quiet [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$ String -> IO ()
showMotd String
repodir
String
mysimplename <- [DarcsFlag] -> String -> IO String
makeRepoName [DarcsFlag]
opts String
repodir
forall a. UMask -> IO a -> IO a
withUMaskFlag (PrimDarcsOption UMask
umask forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$ String -> IO () -> IO ()
withNewDirectory String
mysimplename forall a b. (a -> b) -> a -> b
$ do
Repository
('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
_repo <- WithWorkingDir
-> WithPatchIndex
-> UseCache
-> IO
(Repository
('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin)
createRepositoryV2
(PrimDarcsOption WithWorkingDir
withWorkingDir forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption WithPatchIndex
patchIndexNo forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
O.useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
Repository
('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
_repo <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT
-> UpdatePending -> IO (Repository rt p wR wU wR)
revertRepositoryChanges Repository
('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
_repo UpdatePending
NoUpdatePending
forall a. UseCache -> String -> RepoJob a -> IO a
withRepositoryLocation (PrimDarcsOption UseCache
useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) String
repodir forall a b. (a -> b) -> a -> b
$ forall a.
(forall wR wU.
Repository ('RepoType 'NoRebase) (RepoPatchV1 Prim) wR wU wR
-> IO a)
-> RepoJob a
V1Job forall a b. (a -> b) -> a -> b
$ \Repository ('RepoType 'NoRebase) (RepoPatchV1 Prim) wR wU wR
other -> do
PatchSet ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin wR
theirstuff <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p) =>
Repository rt p wR wU wT -> IO (PatchSet rt p Origin wR)
readRepo Repository ('RepoType 'NoRebase) (RepoPatchV1 Prim) wR wU wR
other
let patches :: FL
(PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim)))
Origin
wR
patches = forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL (forall wX wY.
Named (RepoPatchV1 Prim) wX wY
-> PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV2 Prim) wX wY
convertNamed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully) forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> FL (PatchInfoAnd rt p) wStart wX
patchSet2FL PatchSet ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin wR
theirstuff
outOfOrderTags :: [(PatchInfo, [PatchInfo])]
outOfOrderTags = forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b wX wY.
(forall wW wZ. a wW wZ -> b) -> RL a wX wY -> [b]
mapRL forall {p :: * -> * -> *} {rt :: RepoType} {wX} {wY}.
HasDeps p =>
PatchInfoAndG rt p wX wY -> Maybe (PatchInfo, [PatchInfo])
oot forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wStart wX.
PatchSet rt p wStart wX -> RL (PatchInfoAnd rt p) wStart wX
patchSet2RL PatchSet ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin wR
theirstuff
where oot :: PatchInfoAndG rt p wX wY -> Maybe (PatchInfo, [PatchInfo])
oot PatchInfoAndG rt p wX wY
t = if PatchInfo -> Bool
isTag (forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAndG rt p wX wY
t) Bool -> Bool -> Bool
&& forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAndG rt p wX wY
t forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall (rt :: RepoType) (p :: * -> * -> *) wS wX.
PatchSet rt p wS wX -> [PatchInfo]
inOrderTags PatchSet ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin wR
theirstuff
then forall a. a -> Maybe a
Just (forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> PatchInfo
info PatchInfoAndG rt p wX wY
t, forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps forall a b. (a -> b) -> a -> b
$ forall (rt :: RepoType) (p :: * -> * -> *) wA wB.
PatchInfoAndG rt p wA wB -> p wA wB
hopefully PatchInfoAndG rt p wX wY
t)
else forall a. Maybe a
Nothing
fixDep :: PatchInfo -> [PatchInfo]
fixDep PatchInfo
p = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup PatchInfo
p [(PatchInfo, [PatchInfo])]
outOfOrderTags of
Just [PatchInfo]
d -> PatchInfo
p forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PatchInfo -> [PatchInfo]
fixDep [PatchInfo]
d
Maybe [PatchInfo]
Nothing -> [PatchInfo
p]
primV1toV2 :: Prim x y -> Prim x y
primV1toV2 = forall x y. Prim x y -> Prim x y
V2.Prim forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x y. Prim x y -> Prim x y
V1.unPrim
convertOne :: RepoPatchV1 wX wY -> FL RepoPatchV2 wX wY
convertOne :: forall wX wY. RepoPatchV1 wX wY -> FL (RepoPatchV2 Prim) wX wY
convertOne RepoPatchV1 wX wY
x | forall (prim :: * -> * -> *) wA wB. RepoPatchV1 prim wA wB -> Bool
V1.isMerger RepoPatchV1 wX wY
x =
let ex :: FL Prim wX wY
ex = forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall {x} {y}. Prim x y -> Prim x y
primV1toV2 (forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect RepoPatchV1 wX wY
x) in
case forall (prim :: * -> * -> *) wX.
PrimPatch prim =>
[Sealed (FL prim wX)] -> Maybe (FlippedSeal (RepoPatchV2 prim) wX)
mergeUnravelled forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> *) (b :: * -> *).
(forall wX. a wX -> b wX) -> Sealed a -> Sealed b
mapSeal (forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall {x} {y}. Prim x y -> Prim x y
primV1toV2)) forall a b. (a -> b) -> a -> b
$ forall (prim :: * -> * -> *) wX wY.
PrimPatch prim =>
RepoPatchV1 prim wX wY -> [Sealed (FL prim wY)]
publicUnravel RepoPatchV1 wX wY
x of
Just (FlippedSeal RepoPatchV2 Prim wX wY
y) ->
case forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect RepoPatchV2 Prim wX wY
y forall (p :: * -> * -> *) wA wC wB.
Eq2 p =>
p wA wC -> p wB wC -> EqCheck wA wB
=/\= FL Prim wX wY
ex of
EqCheck wX wX
IsEq -> RepoPatchV2 Prim wX wY
y forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
EqCheck wX wX
NotEq ->
forall a. Doc -> a -> a
traceDoc (String -> Doc
text String
"lossy conversion:" Doc -> Doc -> Doc
$$
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch RepoPatchV1 wX wY
x) forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RepoPatchV2 prim wX wY
V2.Normal FL Prim wX wY
ex
Maybe (FlippedSeal (RepoPatchV2 Prim) wY)
Nothing -> forall a. Doc -> a -> a
traceDoc (String -> Doc
text
String
"lossy conversion of complicated conflict:" Doc -> Doc -> Doc
$$
forall (p :: * -> * -> *) wX wY. ShowPatchBasic p => p wX wY -> Doc
displayPatch RepoPatchV1 wX wY
x) forall a b. (a -> b) -> a -> b
$
forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RepoPatchV2 prim wX wY
V2.Normal FL Prim wX wY
ex
convertOne (V1.PP Prim wX wY
x) = forall (prim :: * -> * -> *) wX wY.
prim wX wY -> RepoPatchV2 prim wX wY
V2.Normal (forall {x} {y}. Prim x y -> Prim x y
primV1toV2 Prim wX wY
x) forall (a :: * -> * -> *) wX wY wZ.
a wX wY -> FL a wY wZ -> FL a wX wZ
:>: forall (a :: * -> * -> *) wX. FL a wX wX
NilFL
convertOne RepoPatchV1 wX wY
_ = forall a. HasCallStack => String -> a
error String
"impossible case"
convertFL :: FL RepoPatchV1 wX wY -> FL RepoPatchV2 wX wY
convertFL :: forall wX wY.
FL (RepoPatchV1 Prim) wX wY -> FL (RepoPatchV2 Prim) wX wY
convertFL = forall (a :: * -> * -> *) wX wZ. FL (FL a) wX wZ -> FL a wX wZ
concatFL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: * -> * -> *) (b :: * -> * -> *) wX wZ.
(forall wW wY. a wW wY -> b wW wY) -> FL a wX wZ -> FL b wX wZ
mapFL_FL forall wX wY. RepoPatchV1 wX wY -> FL (RepoPatchV2 Prim) wX wY
convertOne
convertNamed :: Named RepoPatchV1 wX wY
-> PatchInfoAnd ('RepoType 'NoRebase) RepoPatchV2 wX wY
convertNamed :: forall wX wY.
Named (RepoPatchV1 Prim) wX wY
-> PatchInfoAnd ('RepoType 'NoRebase) (RepoPatchV2 Prim) wX wY
convertNamed Named (RepoPatchV1 Prim) wX wY
n = forall (p :: * -> * -> *) wX wY (rt :: RepoType).
(Ident p, PatchId p ~ PatchInfo) =>
p wX wY -> PatchInfoAndG rt p wX wY
n2pia forall a b. (a -> b) -> a -> b
$
forall (p :: * -> * -> *) wX wY.
PatchInfo -> [PatchInfo] -> FL p wX wY -> Named p wX wY
NamedP
(PatchInfo -> PatchInfo
convertInfo forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY. Named p wX wY -> PatchInfo
patch2patchinfo Named (RepoPatchV1 Prim) wX wY
n)
(forall a b. (a -> b) -> [a] -> [b]
map PatchInfo -> PatchInfo
convertInfo forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap PatchInfo -> [PatchInfo]
fixDep forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY.
HasDeps p =>
p wX wY -> [PatchInfo]
getdeps Named (RepoPatchV1 Prim) wX wY
n)
(forall wX wY.
FL (RepoPatchV1 Prim) wX wY -> FL (RepoPatchV2 Prim) wX wY
convertFL forall a b. (a -> b) -> a -> b
$ forall (p :: * -> * -> *) wX wY. Named p wX wY -> FL p wX wY
patchcontents Named (RepoPatchV1 Prim) wX wY
n)
convertInfo :: PatchInfo -> PatchInfo
convertInfo PatchInfo
n | PatchInfo
n forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` forall (rt :: RepoType) (p :: * -> * -> *) wS wX.
PatchSet rt p wS wX -> [PatchInfo]
inOrderTags PatchSet ('RepoType 'NoRebase) (RepoPatchV1 Prim) Origin wR
theirstuff = PatchInfo
n
| Bool
otherwise = forall b a. b -> (a -> b) -> Maybe a -> b
maybe PatchInfo
n (\String
t -> PatchInfo -> String -> PatchInfo
piRename PatchInfo
n (String
"old tag: "forall a. [a] -> [a] -> [a]
++String
t)) forall a b. (a -> b) -> a -> b
$ PatchInfo -> Maybe String
piTag PatchInfo
n
Repository ('RepoType 'NoRebase) (RepoPatchV2 Prim) wR wR wR
_ <- forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> Repository rt p wX wX wX
-> FL (FL (PatchInfoAnd rt p)) wX wY
-> IO (Repository rt p wY wY wY)
applyAll [DarcsFlag]
opts Repository
('RepoType 'NoRebase) (RepoPatchV2 Prim) Origin Origin Origin
_repo forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) wX wY.
Int -> FL a wX wY -> FL (FL a) wX wY
bunchFL Int
100 forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) wX wY. String -> FL a wX wY -> FL a wX wY
progressFL String
"Converting patch" FL
(PatchInfoAndG ('RepoType 'NoRebase) (Named (RepoPatchV2 Prim)))
Origin
wR
patches
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimDarcsOption SetScriptsExecutable
O.setScriptsExecutable [DarcsFlag]
opts forall a. Eq a => a -> a -> Bool
== SetScriptsExecutable
O.YesSetScriptsExecutable)
IO ()
R.setScriptsExecutable
(String -> Cachable -> IO ByteString
fetchFilePS (String
repodir String -> String -> String
</> String
prefsFilePath) Cachable
Uncachable forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ByteString -> IO ()
B.writeFile String
prefsFilePath)
forall a. IO a -> IO a -> IO a
`catchall` forall (m :: * -> *) a. Monad m => a -> m a
return ()
[DarcsFlag] -> String -> IO ()
putFinished [DarcsFlag]
opts String
"converting"
where
applyOne :: (RepoPatch p, ApplyState p ~ Tree)
=> [DarcsFlag]
-> W2 (Repository rt p wR) wX
-> PatchInfoAnd rt p wX wY
-> IO (W2 (Repository rt p wR) wY)
applyOne :: forall (p :: * -> * -> *) (rt :: RepoType) wR wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> W2 (Repository rt p wR) wX
-> PatchInfoAnd rt p wX wY
-> IO (W2 (Repository rt p wR) wY)
applyOne [DarcsFlag]
opts (W2 Repository rt p wR wX wX
_repo) PatchInfoAnd rt p wX wY
x = do
Repository rt p wR wX wY
_repo <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(RepoPatch p, ApplyState p ~ Tree) =>
UpdatePristine
-> Repository rt p wR wU wT
-> Compression
-> Verbosity
-> UpdatePending
-> PatchInfoAnd rt p wT wY
-> IO (Repository rt p wR wU wY)
tentativelyAddPatch_ ([DarcsFlag] -> UpdatePristine
updatePristine [DarcsFlag]
opts) Repository rt p wR wX wX
_repo
Compression
GzipCompression (PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) ([DarcsFlag] -> UpdatePending
updatePending [DarcsFlag]
opts) PatchInfoAnd rt p wX wY
x
Repository rt p wR wY wY
_repo <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT wY.
(ApplyState p ~ Tree, RepoPatch p) =>
Repository rt p wR wU wT
-> Verbosity
-> FL (PrimOf p) wU wY
-> IO (Repository rt p wR wY wT)
applyToWorking Repository rt p wR wX wY
_repo (PrimDarcsOption Verbosity
verbosity forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (forall (p :: * -> * -> *) wX wY.
Effect p =>
p wX wY -> FL (PrimOf p) wX wY
effect PatchInfoAnd rt p wX wY
x)
forall t. t -> IO ()
invalidateIndex Repository rt p wR wY wY
_repo
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (r :: * -> * -> *) wX. r wX wX -> W2 r wX
W2 Repository rt p wR wY wY
_repo)
applySome :: [DarcsFlag]
-> W3 (Repository rt p) wR
-> FL (PatchInfoAndG rt (Named p)) wR wX
-> IO (W3 (Repository rt p) wX)
applySome [DarcsFlag]
opts (W3 Repository rt p wR wR wR
_repo) FL (PatchInfoAndG rt (Named p)) wR wX
xs = do
Repository rt p wR wX wX
_repo <- forall (r :: * -> * -> *) wX. W2 r wX -> r wX wX
unW2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (r :: * -> *) (p :: * -> * -> *) wX wY.
Monad m =>
(forall wA wB. r wA -> p wA wB -> m (r wB))
-> r wX -> FL p wX wY -> m (r wY)
foldFL_M (forall (p :: * -> * -> *) (rt :: RepoType) wR wX wY.
(RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> W2 (Repository rt p wR) wX
-> PatchInfoAnd rt p wX wY
-> IO (W2 (Repository rt p wR) wY)
applyOne [DarcsFlag]
opts) (forall (r :: * -> * -> *) wX. r wX wX -> W2 r wX
W2 Repository rt p wR wR wR
_repo) FL (PatchInfoAndG rt (Named p)) wR wX
xs
Repository rt p wX wX wX
_repo <- forall (rt :: RepoType) (p :: * -> * -> *) wR wU wT.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
Repository rt p wR wU wT
-> UpdatePending -> Compression -> IO (Repository rt p wT wU wT)
finalizeRepositoryChanges Repository rt p wR wX wX
_repo ([DarcsFlag] -> UpdatePending
updatePending [DarcsFlag]
opts) Compression
GzipCompression
Repository rt p wX wX wX
_repo <- forall (p :: * -> * -> *) (rt :: RepoType) wR wU wT.
RepoPatch p =>
Repository rt p wR wU wT
-> UpdatePending -> IO (Repository rt p wR wU wR)
revertRepositoryChanges Repository rt p wX wX wX
_repo ([DarcsFlag] -> UpdatePending
updatePending [DarcsFlag]
opts)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall (r :: * -> * -> * -> *) wX. r wX wX wX -> W3 r wX
W3 Repository rt p wX wX wX
_repo)
applyAll :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
=> [DarcsFlag]
-> Repository rt p wX wX wX
-> FL (FL (PatchInfoAnd rt p)) wX wY
-> IO (Repository rt p wY wY wY)
applyAll :: forall (rt :: RepoType) (p :: * -> * -> *) wX wY.
(IsRepoType rt, RepoPatch p, ApplyState p ~ Tree) =>
[DarcsFlag]
-> Repository rt p wX wX wX
-> FL (FL (PatchInfoAnd rt p)) wX wY
-> IO (Repository rt p wY wY wY)
applyAll [DarcsFlag]
opts Repository rt p wX wX wX
r FL (FL (PatchInfoAnd rt p)) wX wY
xss = forall (r :: * -> * -> * -> *) wX. W3 r wX -> r wX wX wX
unW3 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) (r :: * -> *) (p :: * -> * -> *) wX wY.
Monad m =>
(forall wA wB. r wA -> p wA wB -> m (r wB))
-> r wX -> FL p wX wY -> m (r wY)
foldFL_M (forall {p :: * -> * -> *} {rt :: RepoType} {wR} {wX}.
(ApplyState p ~ ApplyState (PrimOf p), IsRepoType rt,
Annotate (PrimOf p), Effect p, Check p, Conflict p, FromPrim p,
IsHunk p, Merge p, PrimPatchBase p, Summary p, ToPrim p, Unwind p,
Commute p, Eq2 p, PatchInspect p, RepairToFL p, ReadPatch p,
ShowPatch p, ShowContextPatch p, PatchListFormat p,
ApplyState p ~ Tree) =>
[DarcsFlag]
-> W3 (Repository rt p) wR
-> FL (PatchInfoAndG rt (Named p)) wR wX
-> IO (W3 (Repository rt p) wX)
applySome [DarcsFlag]
opts) (forall (r :: * -> * -> * -> *) wX. r wX wX wX -> W3 r wX
W3 Repository rt p wX wX wX
r) FL (FL (PatchInfoAnd rt p)) wX wY
xss
updatePristine :: [DarcsFlag] -> UpdatePristine
updatePristine :: [DarcsFlag] -> UpdatePristine
updatePristine [DarcsFlag]
opts =
case PrimDarcsOption WithWorkingDir
withWorkingDir forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
WithWorkingDir
O.WithWorkingDir -> UpdatePristine
UpdatePristine
WithWorkingDir
O.NoWorkingDir -> UpdatePristine
UpdatePristine
newtype W2 r wX = W2 {forall (r :: * -> * -> *) wX. W2 r wX -> r wX wX
unW2 :: r wX wX}
newtype W3 r wX = W3 {forall (r :: * -> * -> * -> *) wX. W3 r wX -> r wX wX wX
unW3 :: r wX wX wX}
makeRepoName :: [DarcsFlag] -> FilePath -> IO String
makeRepoName :: [DarcsFlag] -> String -> IO String
makeRepoName [DarcsFlag]
opts String
d =
case PrimDarcsOption (Maybe String)
O.newRepo forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts of
Just String
n -> do
Bool
exists <- String -> IO Bool
doesDirectoryExist String
n
Bool
file_exists <- String -> IO Bool
doesFileExist String
n
if Bool
exists Bool -> Bool -> Bool
|| Bool
file_exists
then forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Directory or file named '" forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++ String
"' already exists."
else forall (m :: * -> *) a. Monad m => a -> m a
return String
n
Maybe String
Nothing ->
case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'.') forall a b. (a -> b) -> a -> b
$
forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'/' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
':') forall a b. (a -> b) -> a -> b
$
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'/') forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse String
d of
String
"" -> String -> IO String
modifyRepoName String
"anonymous_repo"
String
base -> String -> IO String
modifyRepoName String
base
modifyRepoName :: String -> IO String
modifyRepoName :: String -> IO String
modifyRepoName String
name =
if forall a. [a] -> a
head String
name forall a. Eq a => a -> a -> Bool
== Char
'/'
then String -> Int -> IO String
mrn String
name (-Int
1)
else do String
cwd <- IO String
getCurrentDirectory
String -> Int -> IO String
mrn (String
cwd forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ String
name) (-Int
1)
where
mrn :: String -> Int -> IO String
mrn :: String -> Int -> IO String
mrn String
n Int
i = do
Bool
exists <- String -> IO Bool
doesDirectoryExist String
thename
Bool
file_exists <- String -> IO Bool
doesFileExist String
thename
if Bool -> Bool
not Bool
exists Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
file_exists
then do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i forall a. Eq a => a -> a -> Bool
/= -Int
1) forall a b. (a -> b) -> a -> b
$
String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Directory '"forall a. [a] -> [a] -> [a]
++ String
n forall a. [a] -> [a] -> [a]
++
String
"' already exists, creating repository as '"forall a. [a] -> [a] -> [a]
++
String
thename forall a. [a] -> [a] -> [a]
++String
"'"
forall (m :: * -> *) a. Monad m => a -> m a
return String
thename
else String -> Int -> IO String
mrn String
n forall a b. (a -> b) -> a -> b
$ Int
iforall a. Num a => a -> a -> a
+Int
1
where thename :: String
thename = if Int
i forall a. Eq a => a -> a -> Bool
== -Int
1 then String
n else String
nforall a. [a] -> [a] -> [a]
++String
"_"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Int
i