module Darcs.UI.Commands.Clone
( get
, put
, clone
, makeRepoName
, cloneToSSH
) where
import Prelude ()
import Darcs.Prelude
import System.Directory ( doesDirectoryExist, doesFileExist
, setCurrentDirectory )
import System.Exit ( ExitCode(..) )
import Control.Exception ( catch, SomeException )
import Control.Monad ( when, unless )
import Data.Maybe ( listToMaybe )
import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts
, nodefaults
, commandStub
, commandAlias
, putInfo
)
import Darcs.UI.Completion ( noArgs )
import Darcs.UI.Flags( DarcsFlag( NewRepo
, UpToPattern
, UpToPatch
, UpToHash
, OnePattern
, OnePatch
, OneHash
)
, matchAny, useCache, umask, remoteRepos
, setDefault, quiet, usePacks
, remoteDarcs, cloneKind, verbosity, setScriptsExecutable
, withWorkingDir, patchIndexNo )
import Darcs.UI.Options ( (^), odesc, ocheck, onormalise, defaultFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.UI.Commands.Util ( getUniqueRepositoryName )
import Darcs.Repository ( cloneRepository )
import Darcs.Repository.Format ( identifyRepoFormat
, RepoProperty ( HashedInventory
, RebaseInProgress
)
, formatHas
)
import Darcs.Util.Lock ( withTempDir )
import Darcs.Util.Ssh ( getSSH, SSHCmd(SCP) )
import Darcs.Repository.Flags
( CloneKind(CompleteClone), SetDefault(NoSetDefault), ForgetParent(..) )
import Darcs.Patch.Bundle ( scanContextFile )
import Darcs.Patch.Dummy ( DummyPatch )
import Darcs.Patch.Set ( PatchSet, Origin )
import Darcs.Repository.Prefs ( showMotd )
import Darcs.Util.Progress ( debugMessage )
import Darcs.Util.Printer ( text, ($$) )
import Darcs.Util.Path ( toFilePath, toPath, ioAbsoluteOrRemote, AbsolutePath )
import Darcs.Util.Workaround ( getCurrentDirectory )
import Darcs.Util.URL ( isSshUrl )
import Darcs.Util.Exec ( exec, Redirect(..), )
cloneDescription :: String
cloneDescription :: String
cloneDescription = "Make a copy of an existing repository."
cloneHelp :: String
cloneHelp :: String
cloneHelp =
[String] -> String
unlines
[ "Clone creates a copy of a repository. The optional second"
, "argument specifies a destination directory for the new copy;"
, "if omitted, it is inferred from the source location."
, ""
, "By default Darcs will copy every patch from the original repository."
, "If you expect the original repository to remain accessible, you can"
, "use `--lazy` to avoid copying patches until they are needed ('copy on"
, "demand'). This is particularly useful when copying a remote"
, "repository with a long history that you don't care about."
, ""
, "When cloning locally, Darcs automatically uses hard linking where"
, "possible. As well as saving time and space, this enables to move or"
, "delete the original repository without affecting the copy."
, "Hard linking requires that the copy be on the same filesystem as the"
, "original repository, and that the filesystem support hard linking."
, "This includes NTFS, HFS+ and all general-purpose Unix filesystems"
, "(such as ext, UFS and ZFS). FAT does not support hard links."
, ""
, "When cloning from a remote location, Darcs will look for and attempt"
, "to use packs created by `darcs optimize http` in the remote repository."
, "Packs are single big files that can be downloaded faster than many"
, "little files."
, ""
, "Darcs clone will not copy unrecorded changes to the source repository's"
, "working tree."
, ""
, "You can copy a repository to a ssh url, in which case the new repository"
, "will always be complete."
, ""
] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cloneHelpTag
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cloneHelpSSE
clone :: DarcsCommand [DarcsFlag]
clone :: DarcsCommand [DarcsFlag]
clone = DarcsCommand :: forall parsedFlags.
String
-> String
-> String
-> String
-> Int
-> [String]
-> ((AbsolutePath, AbsolutePath)
-> parsedFlags -> [String] -> IO ())
-> ([DarcsFlag] -> IO (Either String ()))
-> ((AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [String] -> IO [String])
-> ([DarcsFlag] -> AbsolutePath -> [String] -> IO [String])
-> [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag]
-> [DarcsFlag]
-> ([DarcsFlag] -> [String])
-> ([DarcsFlag] -> parsedFlags)
-> DarcsCommand parsedFlags
DarcsCommand
{ commandProgramName :: String
commandProgramName = "darcs"
, commandName :: String
commandName = "clone"
, commandHelp :: String
commandHelp = String
cloneHelp
, commandDescription :: String
commandDescription = String
cloneDescription
, commandExtraArgs :: Int
commandExtraArgs = -1
, commandExtraArgHelp :: [String]
commandExtraArgHelp = ["<REPOSITORY>", "[<DIRECTORY>]"]
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
cloneCmd
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = [DarcsFlag] -> IO (Either String ())
validContextFile
, 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 = OptSpec
DarcsOptDescr
DarcsFlag
Any
(Bool -> WithPatchIndex -> NetworkOptions -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
DarcsOptDescr
DarcsFlag
Any
(Bool -> WithPatchIndex -> NetworkOptions -> Any)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool -> WithPatchIndex -> NetworkOptions -> a)
cloneAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
DarcsOptDescr
DarcsFlag
Any
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> Any)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> a)
cloneBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> [DarcsFlag])
forall a.
DarcsOption
a
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> a)
cloneOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> Any)
-> [DarcsFlag] -> [String]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck OptSpec
DarcsOptDescr
DarcsFlag
Any
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> Any)
forall a.
DarcsOption
a
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> a)
cloneOpts
, commandParseOptions :: [DarcsFlag] -> [DarcsFlag]
commandParseOptions = OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> [DarcsFlag])
-> [DarcsFlag] -> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f] -> [f]
onormalise OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> [DarcsFlag])
forall a.
DarcsOption
a
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> a)
cloneOpts
}
where
cloneBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> a)
cloneBasicOpts
= PrimOptSpec
DarcsOptDescr
DarcsFlag
(CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> a)
(Maybe String)
PrimDarcsOption (Maybe String)
O.reponame
PrimOptSpec
DarcsOptDescr
DarcsFlag
(CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> a)
(Maybe String)
-> OptSpec
DarcsOptDescr
DarcsFlag
([MatchFlag]
-> Maybe Bool -> SetScriptsExecutable -> WithWorkingDir -> a)
(CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
([MatchFlag]
-> Maybe Bool -> SetScriptsExecutable -> WithWorkingDir -> a)
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> 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
([MatchFlag]
-> Maybe Bool -> SetScriptsExecutable -> WithWorkingDir -> a)
(CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> a)
PrimDarcsOption CloneKind
O.cloneKind
OptSpec
DarcsOptDescr
DarcsFlag
([MatchFlag]
-> Maybe Bool -> SetScriptsExecutable -> WithWorkingDir -> a)
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool -> SetScriptsExecutable -> WithWorkingDir -> a)
([MatchFlag]
-> Maybe Bool -> SetScriptsExecutable -> WithWorkingDir -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool -> SetScriptsExecutable -> WithWorkingDir -> a)
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> 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
(Maybe Bool -> SetScriptsExecutable -> WithWorkingDir -> a)
([MatchFlag]
-> Maybe Bool -> SetScriptsExecutable -> WithWorkingDir -> a)
MatchOption
O.matchOneContext
OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool -> SetScriptsExecutable -> WithWorkingDir -> a)
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(SetScriptsExecutable -> WithWorkingDir -> a)
(Maybe Bool -> SetScriptsExecutable -> WithWorkingDir -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(SetScriptsExecutable -> WithWorkingDir -> a)
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> 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
(SetScriptsExecutable -> WithWorkingDir -> a)
(Maybe Bool -> SetScriptsExecutable -> WithWorkingDir -> a)
PrimDarcsOption (Maybe Bool)
O.setDefault
OptSpec
DarcsOptDescr
DarcsFlag
(SetScriptsExecutable -> WithWorkingDir -> a)
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(WithWorkingDir -> a)
(SetScriptsExecutable -> WithWorkingDir -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(WithWorkingDir -> a)
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> 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
(WithWorkingDir -> a)
(SetScriptsExecutable -> WithWorkingDir -> a)
PrimDarcsOption SetScriptsExecutable
O.setScriptsExecutable
OptSpec
DarcsOptDescr
DarcsFlag
(WithWorkingDir -> a)
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> a)
-> OptSpec DarcsOptDescr DarcsFlag a (WithWorkingDir -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> 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 (WithWorkingDir -> a)
PrimDarcsOption WithWorkingDir
O.withWorkingDir
cloneAdvancedOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool -> WithPatchIndex -> NetworkOptions -> a)
cloneAdvancedOpts = PrimOptSpec
DarcsOptDescr
DarcsFlag
(WithPatchIndex -> NetworkOptions -> a)
Bool
PrimDarcsOption Bool
O.usePacks PrimOptSpec
DarcsOptDescr
DarcsFlag
(WithPatchIndex -> NetworkOptions -> a)
Bool
-> OptSpec
DarcsOptDescr
DarcsFlag
(NetworkOptions -> a)
(WithPatchIndex -> NetworkOptions -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(NetworkOptions -> a)
(Bool -> WithPatchIndex -> NetworkOptions -> 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
(NetworkOptions -> a)
(WithPatchIndex -> NetworkOptions -> a)
PrimDarcsOption WithPatchIndex
O.patchIndexNo OptSpec
DarcsOptDescr
DarcsFlag
(NetworkOptions -> a)
(Bool -> WithPatchIndex -> NetworkOptions -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (NetworkOptions -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool -> WithPatchIndex -> NetworkOptions -> 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 (NetworkOptions -> a)
PrimDarcsOption NetworkOptions
O.network
cloneOpts :: DarcsOption
a
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> a)
cloneOpts = OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> a)
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> a)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> a)
cloneBasicOpts OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> a)
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> a)
-> DarcsOption
(UseCache -> HooksConfig -> a)
(Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> a)
-> DarcsOption
a
(Maybe String
-> CloneKind
-> [MatchFlag]
-> Maybe Bool
-> SetScriptsExecutable
-> WithWorkingDir
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> a)
forall b c a.
DarcsOption
(Maybe StdCmdAction -> Bool -> Bool -> Verbosity -> Bool -> b) c
-> DarcsOption (UseCache -> HooksConfig -> a) b -> DarcsOption a c
`withStdOpts` DarcsOption
(UseCache -> HooksConfig -> a)
(Bool
-> WithPatchIndex
-> NetworkOptions
-> UseCache
-> HooksConfig
-> a)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(Bool -> WithPatchIndex -> NetworkOptions -> a)
cloneAdvancedOpts
get :: DarcsCommand [DarcsFlag]
get :: DarcsCommand [DarcsFlag]
get = String
-> Maybe (DarcsCommand [DarcsFlag])
-> DarcsCommand [DarcsFlag]
-> DarcsCommand [DarcsFlag]
forall pf.
String
-> Maybe (DarcsCommand pf) -> DarcsCommand pf -> DarcsCommand pf
commandAlias "get" Maybe (DarcsCommand [DarcsFlag])
forall a. Maybe a
Nothing DarcsCommand [DarcsFlag]
clone
putDescription :: String
putDescription :: String
putDescription = "Deprecated command, replaced by clone."
putHelp :: String
putHelp :: String
putHelp = [String] -> String
unlines
[ "This command is deprecated."
, ""
, "To clone the current repository to a ssh destination,"
, "use the syntax `darcs clone . user@server:path` ."
]
put :: DarcsCommand [DarcsFlag]
put :: DarcsCommand [DarcsFlag]
put = String
-> String
-> String
-> DarcsCommand [DarcsFlag]
-> DarcsCommand [DarcsFlag]
forall pf.
String -> String -> String -> DarcsCommand pf -> DarcsCommand pf
commandStub "put" String
putHelp String
putDescription DarcsCommand [DarcsFlag]
clone
cloneCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
cloneCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
cloneCmd fps :: (AbsolutePath, AbsolutePath)
fps opts :: [DarcsFlag]
opts [inrepodir :: String
inrepodir, outname :: String
outname] = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
cloneCmd (AbsolutePath, AbsolutePath)
fps (String -> DarcsFlag
NewRepo String
outnameDarcsFlag -> [DarcsFlag] -> [DarcsFlag]
forall a. a -> [a] -> [a]
:[DarcsFlag]
opts) [String
inrepodir]
cloneCmd _ opts :: [DarcsFlag]
opts [inrepodir :: String
inrepodir] = do
String -> IO ()
debugMessage "Starting work on clone..."
AbsoluteOrRemotePath
typed_repodir <- String -> IO AbsoluteOrRemotePath
ioAbsoluteOrRemote String
inrepodir
let repodir :: String
repodir = AbsoluteOrRemotePath -> String
forall a. FilePathOrURL a => a -> String
toPath AbsoluteOrRemotePath
typed_repodir
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([DarcsFlag] -> Bool
quiet [DarcsFlag]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
showMotd String
repodir
RepoFormat
rfsource <- String -> IO RepoFormat
identifyRepoFormat String
repodir
String -> IO ()
debugMessage (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Found the format of "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
repodirString -> String -> String
forall a. [a] -> [a] -> [a]
++"..."
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
RebaseInProgress RepoFormat
rfsource) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "Can't clone a repository with a rebase in progress"
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RepoProperty -> RepoFormat -> Bool
formatHas RepoProperty
HashedInventory RepoFormat
rfsource) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> Doc
text "***********************************************************************"
Doc -> Doc -> Doc
$$ String -> Doc
text " _______ Sorry for the wait! The repository you are cloning is"
Doc -> Doc -> Doc
$$ String -> Doc
text " | | using the DEPRECATED 'old-fashioned' format. I'm doing a"
Doc -> Doc -> Doc
$$ String -> Doc
text " | O O | hashed copy instead, but this may take a while."
Doc -> Doc -> Doc
$$ String -> Doc
text " | ___ |"
Doc -> Doc -> Doc
$$ String -> Doc
text " | / \\ | We recommend that the maintainer upgrade the remote copy"
Doc -> Doc -> Doc
$$ String -> Doc
text " |_______| as well. See http://wiki.darcs.net/OF for more information."
Doc -> Doc -> Doc
$$ String -> Doc
text ""
Doc -> Doc -> Doc
$$ String -> Doc
text "***********************************************************************"
case [DarcsFlag] -> Maybe String
cloneToSSH [DarcsFlag]
opts of
Just repo :: String
repo -> do
String -> (AbsolutePath -> IO ()) -> IO ()
forall a. String -> (AbsolutePath -> IO a) -> IO a
withTempDir "clone" ((AbsolutePath -> IO ()) -> IO ())
-> (AbsolutePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \_ -> do
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "Creating local clone..."
String
currentDir <- IO String
getCurrentDirectory
String
mysimplename <- Bool -> [DarcsFlag] -> String -> IO String
makeRepoName Bool
True [] String
repodir
String
-> String
-> Verbosity
-> UseCache
-> CloneKind
-> UMask
-> RemoteDarcs
-> SetScriptsExecutable
-> RemoteRepos
-> SetDefault
-> [MatchFlag]
-> RepoFormat
-> WithWorkingDir
-> WithPatchIndex
-> Bool
-> ForgetParent
-> IO ()
cloneRepository String
repodir String
mysimplename (PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
CloneKind
CompleteClone (PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) ([DarcsFlag] -> RemoteDarcs
remoteDarcs [DarcsFlag]
opts)
(PrimDarcsOption SetScriptsExecutable
setScriptsExecutable PrimDarcsOption SetScriptsExecutable
-> [DarcsFlag] -> SetScriptsExecutable
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption RemoteRepos
remoteRepos PrimDarcsOption RemoteRepos -> [DarcsFlag] -> RemoteRepos
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (Bool -> SetDefault
NoSetDefault Bool
True)
(MatchOption
matchAny MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? (DarcsFlag -> DarcsFlag) -> [DarcsFlag] -> [DarcsFlag]
forall a b. (a -> b) -> [a] -> [b]
map DarcsFlag -> DarcsFlag
convertUpToToOne [DarcsFlag]
opts)
RepoFormat
rfsource
(PrimDarcsOption WithWorkingDir
withWorkingDir PrimDarcsOption WithWorkingDir -> [DarcsFlag] -> WithWorkingDir
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption WithPatchIndex
patchIndexNo PrimDarcsOption WithPatchIndex -> [DarcsFlag] -> WithPatchIndex
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption Bool
usePacks PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
ForgetParent
YesForgetParent
String -> IO ()
setCurrentDirectory String
currentDir
(scp :: String
scp, args :: [String]
args) <- SSHCmd -> IO (String, [String])
getSSH SSHCmd
SCP
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ "Transferring clone using " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scp String -> String -> String
forall a. [a] -> [a] -> [a]
++ "..."
ExitCode
r <- String -> [String] -> Redirects -> IO ExitCode
exec String
scp ([String]
args [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["-r", String
mysimplename String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/", String
repo]) (Redirect
AsIs,Redirect
AsIs,Redirect
AsIs)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
r ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Problem during " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scp String -> String -> String
forall a. [a] -> [a] -> [a]
++ " transfer."
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "Cloning and transferring successful."
Nothing -> do
String
mysimplename <- Bool -> [DarcsFlag] -> String -> IO String
makeRepoName Bool
True [DarcsFlag]
opts String
repodir
String
-> String
-> Verbosity
-> UseCache
-> CloneKind
-> UMask
-> RemoteDarcs
-> SetScriptsExecutable
-> RemoteRepos
-> SetDefault
-> [MatchFlag]
-> RepoFormat
-> WithWorkingDir
-> WithPatchIndex
-> Bool
-> ForgetParent
-> IO ()
cloneRepository String
repodir String
mysimplename (PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UseCache
useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption CloneKind
cloneKind PrimDarcsOption CloneKind -> [DarcsFlag] -> CloneKind
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) ([DarcsFlag] -> RemoteDarcs
remoteDarcs [DarcsFlag]
opts)
(PrimDarcsOption SetScriptsExecutable
setScriptsExecutable PrimDarcsOption SetScriptsExecutable
-> [DarcsFlag] -> SetScriptsExecutable
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption RemoteRepos
remoteRepos PrimDarcsOption RemoteRepos -> [DarcsFlag] -> RemoteRepos
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (Bool -> [DarcsFlag] -> SetDefault
setDefault Bool
True [DarcsFlag]
opts)
(MatchOption
matchAny MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? (DarcsFlag -> DarcsFlag) -> [DarcsFlag] -> [DarcsFlag]
forall a b. (a -> b) -> [a] -> [b]
map DarcsFlag -> DarcsFlag
convertUpToToOne [DarcsFlag]
opts)
RepoFormat
rfsource
(PrimDarcsOption WithWorkingDir
withWorkingDir PrimDarcsOption WithWorkingDir -> [DarcsFlag] -> WithWorkingDir
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption WithPatchIndex
patchIndexNo PrimDarcsOption WithPatchIndex -> [DarcsFlag] -> WithPatchIndex
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption Bool
usePacks PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
ForgetParent
NoForgetParent
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "Finished cloning."
cloneCmd _ _ _ = String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "You must provide 'clone' with either one or two arguments."
cloneToSSH :: [DarcsFlag] -> Maybe String
cloneToSSH :: [DarcsFlag] -> Maybe String
cloneToSSH fs :: [DarcsFlag]
fs = case PrimDarcsOption (Maybe String)
O.reponame PrimDarcsOption (Maybe String) -> [DarcsFlag] -> Maybe String
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
fs of
Nothing -> Maybe String
forall a. Maybe a
Nothing
Just r :: String
r -> if String -> Bool
isSshUrl String
r then String -> Maybe String
forall a. a -> Maybe a
Just String
r else Maybe String
forall a. Maybe a
Nothing
makeRepoName :: Bool -> [DarcsFlag] -> FilePath -> IO String
makeRepoName :: Bool -> [DarcsFlag] -> String -> IO String
makeRepoName talkative :: Bool
talkative fs :: [DarcsFlag]
fs d :: String
d =
case PrimDarcsOption (Maybe String)
O.reponame PrimDarcsOption (Maybe String) -> [DarcsFlag] -> Maybe String
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
fs of
Just n :: 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 String -> IO String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ "Directory or file named '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' already exists."
else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
n
Nothing ->
case String -> String
mkName String
d of
"" -> Bool -> String -> IO String
getUniqueRepositoryName Bool
talkative "anonymous_repo"
base :: String
base@('/':_) -> Bool -> String -> IO String
getUniqueRepositoryName Bool
talkative String
base
base :: String
base
-> do
String
cwd <- IO String
getCurrentDirectory
Bool -> String -> IO String
getUniqueRepositoryName Bool
talkative (String
cwd String -> String -> String
forall a. [a] -> [a] -> [a]
++ "/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
base)
where mkName :: String -> String
mkName = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '.') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` "/:")) (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '/') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse
cloneHelpTag :: String
cloneHelpTag :: String
cloneHelpTag =
[String] -> String
unlines
[ "It is often desirable to make a copy of a repository that excludes"
, "some patches. For example, if releases are tagged then `darcs clone"
, "--tag .` would make a copy of the repository as at the latest release."
, ""
, "An untagged repository state can still be identified unambiguously by"
, "a context file, as generated by `darcs log --context`. Given the"
, "name of such a file, the `--context` option will create a repository"
, "that includes only the patches from that context. When a user reports"
, "a bug in an unreleased version of your project, the recommended way to"
, "find out exactly what version they were running is to have them"
, "include a context file in the bug report."
, ""
, "You can also make a copy of an untagged state using the `--to-patch` or"
, "`--to-match` options, which exclude patches *after* the first matching"
, "patch. Because these options treat the set of patches as an ordered"
, "sequence, you may get different results after reordering with `darcs"
, "optimize reorder`."
, ""
]
cloneHelpSSE :: String
cloneHelpSSE :: String
cloneHelpSSE =
[String] -> String
unlines
[ "The `--set-scripts-executable` option causes scripts to be made"
, "executable in the working tree. A script is any file that starts"
, "with a shebang (\"#!\")."
]
validContextFile :: [DarcsFlag] -> IO (Either String ())
validContextFile :: [DarcsFlag] -> IO (Either String ())
validContextFile opts :: [DarcsFlag]
opts =
case [DarcsFlag] -> Maybe AbsolutePath
getContext [DarcsFlag]
opts of
Nothing -> Either String () -> IO (Either String ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ () -> Either String ()
forall a b. b -> Either a b
Right ()
Just ctxAbsolutePath :: AbsolutePath
ctxAbsolutePath -> do
let ctxFilePath :: String
ctxFilePath = AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath AbsolutePath
ctxAbsolutePath
Bool
exists <- String -> IO Bool
doesFileExist String
ctxFilePath
if Bool
exists
then do
(PatchSet Any DummyPatch Origin Any
ps :: PatchSet rt DummyPatch Origin wX) <-
String -> IO (PatchSet Any DummyPatch Origin Any)
forall (rt :: RepoType) (p :: * -> * -> *) wX.
String -> IO (PatchSet rt p Origin wX)
scanContextFile String
ctxFilePath
(PatchSet Any DummyPatch Origin Any
ps PatchSet Any DummyPatch Origin Any
-> IO (Either String ()) -> IO (Either String ())
forall a b. a -> b -> b
`seq` Either String () -> IO (Either String ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ () -> Either String ()
forall a b. b -> Either a b
Right ()) IO (Either String ())
-> (SomeException -> IO (Either String ()))
-> IO (Either String ())
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(SomeException
_ :: SomeException) ->
Either String () -> IO (Either String ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String () -> IO (Either String ()))
-> (String -> Either String ()) -> String -> IO (Either String ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String ()
forall a b. a -> Either a b
Left (String -> IO (Either String ()))
-> String -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ "File " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ctxFilePath
String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is not a valid context file"
else Either String () -> IO (Either String ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String () -> IO (Either String ()))
-> (String -> Either String ()) -> String -> IO (Either String ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String ()
forall a b. a -> Either a b
Left (String -> IO (Either String ()))
-> String -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$
"Context file " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ctxFilePath String -> String -> String
forall a. [a] -> [a] -> [a]
++ " does not exist"
getContext :: [DarcsFlag] -> Maybe AbsolutePath
getContext :: [DarcsFlag] -> Maybe AbsolutePath
getContext fs :: [DarcsFlag]
fs = [AbsolutePath] -> Maybe AbsolutePath
forall a. [a] -> Maybe a
listToMaybe [ AbsolutePath
f | O.Context f :: AbsolutePath
f <- MatchOption
O.context MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
fs ]
convertUpToToOne :: DarcsFlag -> DarcsFlag
convertUpToToOne :: DarcsFlag -> DarcsFlag
convertUpToToOne (UpToPattern p :: String
p) = String -> DarcsFlag
OnePattern String
p
convertUpToToOne (UpToPatch p :: String
p) = String -> DarcsFlag
OnePatch String
p
convertUpToToOne (UpToHash p :: String
p) = String -> DarcsFlag
OneHash String
p
convertUpToToOne f :: DarcsFlag
f = DarcsFlag
f