--  Copyright (C) 2002-2005 David Roundy
--
--  This program is free software; you can redistribute it and/or modify
--  it under the terms of the GNU General Public License as published by
--  the Free Software Foundation; either version 2, or (at your option)
--  any later version.
--
--  This program is distributed in the hope that it will be useful,
--  but WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
--  GNU General Public License for more details.
--
--  You should have received a copy of the GNU General Public License
--  along with this program; see the file COPYING.  If not, write to
--  the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
--  Boston, MA 02110-1301, USA.

module Darcs.UI.Commands.Clone
    ( get
    , put
    , clone
    , makeRepoName
    , cloneToSSH
    , otherHelpInheritDefault
    ) where

import Darcs.Prelude

import System.Directory ( doesDirectoryExist, doesFileExist
                        , setCurrentDirectory )
import System.Exit ( ExitCode(..) )
import System.FilePath.Posix ( joinPath, splitDirectories )
import Control.Monad ( when, unless )

import Darcs.UI.Commands ( DarcsCommand(..), withStdOpts
                      , nodefaults
                      , commandStub
                      , commandAlias
                      , putInfo
                      , putFinished
                      )
import Darcs.UI.Completion ( noArgs )
import Darcs.UI.Flags
    ( DarcsFlag
    , cloneKind
    , fixUrl
    , patchIndexNo
    , quiet
    , setDefault
    , setScriptsExecutable
    , umask
    , useCache
    , usePacks
    , verbosity
    , withNewRepo
    , withWorkingDir
    )
import Darcs.UI.Options ( (?), (^) )
import qualified Darcs.UI.Options.All as O
import Darcs.UI.Commands.Util
    ( commonHelpWithPrefsTemplates
    , getUniqueRepositoryName
    )
import Darcs.Patch.Match ( MatchFlag(..) )
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,SSH) )
import Darcs.Repository.Flags
    ( CloneKind(CompleteClone), SetDefault(NoSetDefault), ForgetParent(..) )
import Darcs.Repository.Prefs ( showMotd )
import Darcs.Util.Progress ( debugMessage )
import Darcs.Util.Printer ( Doc, formatWords, formatText, text, vsep, ($$), ($+$) )
import Darcs.Util.Path ( AbsolutePath )
import Darcs.Util.Workaround ( getCurrentDirectory )
import Darcs.Util.URL ( SshFilePath(..), isSshUrl, splitSshUrl, sshCanonRepo )
import Darcs.Util.Exec ( exec, Redirect(..), )

cloneDescription :: String
cloneDescription :: String
cloneDescription = String
"Make a copy of an existing repository."

cloneHelp :: Doc
cloneHelp :: Doc
cloneHelp = [Doc] -> Doc
vsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
  ([String] -> Doc) -> [[String]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> Doc
formatWords
  [ [ String
"Clone creates a copy of a repository.  The optional second"
    , String
"argument specifies a destination directory for the new copy;"
    , String
"if omitted, it is inferred from the source location."
    ]
  , [ String
"By default Darcs will copy every patch from the original repository."
    , String
"If you expect the original repository to remain accessible, you can"
    , String
"use `--lazy` to avoid copying patches until they are needed ('copy on"
    , String
"demand').  This is particularly useful when copying a remote"
    , String
"repository with a long history that you don't care about."
    ]
  , [ String
"When cloning locally, Darcs automatically uses hard linking where"
    , String
"possible.  As well as saving time and space, this enables to move or"
    , String
"delete the original repository without affecting the copy."
    , String
"Hard linking requires that the copy be on the same filesystem as the"
    , String
"original repository, and that the filesystem support hard linking."
    , String
"This includes NTFS, HFS+ and all general-purpose Unix filesystems"
    , String
"(such as ext, UFS and ZFS). FAT does not support hard links."
    ]
  , [ String
"When cloning from a remote location, Darcs will look for and attempt"
    , String
"to use packs created by `darcs optimize http` in the remote repository."
    , String
"Packs are single big files that can be downloaded faster than many"
    , String
"little files."
    ]
  , [ String
"Darcs clone will not copy unrecorded changes to the source repository's"
    , String
"working tree."
    ]
  , [ String
"You can copy a repository to a ssh url, in which case the new repository"
    , String
"will always be complete."
    ]
  ]
  [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++
  [ Doc
cloneHelpTag
  , Doc
cloneHelpSSE
  , Doc
cloneHelpInheritDefault
  , Doc
commonHelpWithPrefsTemplates
  ]

clone :: DarcsCommand
clone :: DarcsCommand
clone = DarcsCommand
    { commandProgramName :: String
commandProgramName = String
"darcs"
    , commandName :: String
commandName = String
"clone"
    , commandHelp :: Doc
commandHelp = Doc
cloneHelp
    , commandDescription :: String
commandDescription = String
cloneDescription
    , commandExtraArgs :: Int
commandExtraArgs = -Int
1
    , commandExtraArgHelp :: [String]
commandExtraArgHelp = [String
"<REPOSITORY>", String
"[<DIRECTORY>]"]
    , commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
cloneCmd
    , commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = \[DarcsFlag]
_ -> Either String () -> IO (Either String ())
forall a. a -> IO a
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 ()
    , 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
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
cloneOpts
    }
  where
    cloneBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe String
   -> CloneKind
   -> [MatchFlag]
   -> Maybe Bool
   -> InheritDefault
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> a)
cloneBasicOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (CloneKind
   -> [MatchFlag]
   -> Maybe Bool
   -> InheritDefault
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> a)
  (Maybe String)
PrimDarcsOption (Maybe String)
O.newRepo
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (CloneKind
   -> [MatchFlag]
   -> Maybe Bool
   -> InheritDefault
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> a)
  (Maybe String)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     ([MatchFlag]
      -> Maybe Bool
      -> InheritDefault
      -> SetScriptsExecutable
      -> WithWorkingDir
      -> a)
     (CloneKind
      -> [MatchFlag]
      -> Maybe Bool
      -> InheritDefault
      -> SetScriptsExecutable
      -> WithWorkingDir
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     ([MatchFlag]
      -> Maybe Bool
      -> InheritDefault
      -> SetScriptsExecutable
      -> WithWorkingDir
      -> a)
     (Maybe String
      -> CloneKind
      -> [MatchFlag]
      -> Maybe Bool
      -> InheritDefault
      -> 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
   -> InheritDefault
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> a)
  (CloneKind
   -> [MatchFlag]
   -> Maybe Bool
   -> InheritDefault
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> a)
PrimDarcsOption CloneKind
O.cloneKind
      OptSpec
  DarcsOptDescr
  DarcsFlag
  ([MatchFlag]
   -> Maybe Bool
   -> InheritDefault
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> a)
  (Maybe String
   -> CloneKind
   -> [MatchFlag]
   -> Maybe Bool
   -> InheritDefault
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> InheritDefault -> SetScriptsExecutable -> WithWorkingDir -> a)
     ([MatchFlag]
      -> Maybe Bool
      -> InheritDefault
      -> SetScriptsExecutable
      -> WithWorkingDir
      -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe Bool
      -> InheritDefault -> SetScriptsExecutable -> WithWorkingDir -> a)
     (Maybe String
      -> CloneKind
      -> [MatchFlag]
      -> Maybe Bool
      -> InheritDefault
      -> 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
   -> InheritDefault -> SetScriptsExecutable -> WithWorkingDir -> a)
  ([MatchFlag]
   -> Maybe Bool
   -> InheritDefault
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> a)
MatchOption
O.matchOneContext
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe Bool
   -> InheritDefault -> SetScriptsExecutable -> WithWorkingDir -> a)
  (Maybe String
   -> CloneKind
   -> [MatchFlag]
   -> Maybe Bool
   -> InheritDefault
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (InheritDefault -> SetScriptsExecutable -> WithWorkingDir -> a)
     (Maybe Bool
      -> InheritDefault -> SetScriptsExecutable -> WithWorkingDir -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (InheritDefault -> SetScriptsExecutable -> WithWorkingDir -> a)
     (Maybe String
      -> CloneKind
      -> [MatchFlag]
      -> Maybe Bool
      -> InheritDefault
      -> 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
  (InheritDefault -> SetScriptsExecutable -> WithWorkingDir -> a)
  (Maybe Bool
   -> InheritDefault -> SetScriptsExecutable -> WithWorkingDir -> a)
PrimDarcsOption (Maybe Bool)
O.setDefault
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (InheritDefault -> SetScriptsExecutable -> WithWorkingDir -> a)
  (Maybe String
   -> CloneKind
   -> [MatchFlag]
   -> Maybe Bool
   -> InheritDefault
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (SetScriptsExecutable -> WithWorkingDir -> a)
     (InheritDefault -> SetScriptsExecutable -> WithWorkingDir -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (SetScriptsExecutable -> WithWorkingDir -> a)
     (Maybe String
      -> CloneKind
      -> [MatchFlag]
      -> Maybe Bool
      -> InheritDefault
      -> 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)
  (InheritDefault -> SetScriptsExecutable -> WithWorkingDir -> a)
PrimDarcsOption InheritDefault
O.inheritDefault
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (SetScriptsExecutable -> WithWorkingDir -> a)
  (Maybe String
   -> CloneKind
   -> [MatchFlag]
   -> Maybe Bool
   -> InheritDefault
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithWorkingDir -> a)
     (SetScriptsExecutable -> WithWorkingDir -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithWorkingDir -> a)
     (Maybe String
      -> CloneKind
      -> [MatchFlag]
      -> Maybe Bool
      -> InheritDefault
      -> 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
   -> InheritDefault
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (WithWorkingDir -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (Maybe String
      -> CloneKind
      -> [MatchFlag]
      -> Maybe Bool
      -> InheritDefault
      -> 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
   -> UMask
   -> RemoteDarcs
   -> WithPrefsTemplates
   -> a)
cloneAdvancedOpts
      = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (WithPatchIndex -> UMask -> RemoteDarcs -> WithPrefsTemplates -> a)
  Bool
PrimDarcsOption Bool
O.usePacks
      PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (WithPatchIndex -> UMask -> RemoteDarcs -> WithPrefsTemplates -> a)
  Bool
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (UMask -> RemoteDarcs -> WithPrefsTemplates -> a)
     (WithPatchIndex -> UMask -> RemoteDarcs -> WithPrefsTemplates -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (UMask -> RemoteDarcs -> WithPrefsTemplates -> a)
     (Bool
      -> WithPatchIndex
      -> UMask
      -> RemoteDarcs
      -> WithPrefsTemplates
      -> 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
  (UMask -> RemoteDarcs -> WithPrefsTemplates -> a)
  (WithPatchIndex -> UMask -> RemoteDarcs -> WithPrefsTemplates -> a)
PrimDarcsOption WithPatchIndex
O.patchIndexNo
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (UMask -> RemoteDarcs -> WithPrefsTemplates -> a)
  (Bool
   -> WithPatchIndex
   -> UMask
   -> RemoteDarcs
   -> WithPrefsTemplates
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (RemoteDarcs -> WithPrefsTemplates -> a)
     (UMask -> RemoteDarcs -> WithPrefsTemplates -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (RemoteDarcs -> WithPrefsTemplates -> a)
     (Bool
      -> WithPatchIndex
      -> UMask
      -> RemoteDarcs
      -> WithPrefsTemplates
      -> 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
  (RemoteDarcs -> WithPrefsTemplates -> a)
  (UMask -> RemoteDarcs -> WithPrefsTemplates -> a)
PrimDarcsOption UMask
O.umask
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (RemoteDarcs -> WithPrefsTemplates -> a)
  (Bool
   -> WithPatchIndex
   -> UMask
   -> RemoteDarcs
   -> WithPrefsTemplates
   -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithPrefsTemplates -> a)
     (RemoteDarcs -> WithPrefsTemplates -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithPrefsTemplates -> a)
     (Bool
      -> WithPatchIndex
      -> UMask
      -> RemoteDarcs
      -> WithPrefsTemplates
      -> 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
  (WithPrefsTemplates -> a)
  (RemoteDarcs -> WithPrefsTemplates -> a)
PrimDarcsOption RemoteDarcs
O.remoteDarcs
      OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithPrefsTemplates -> a)
  (Bool
   -> WithPatchIndex
   -> UMask
   -> RemoteDarcs
   -> WithPrefsTemplates
   -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (WithPrefsTemplates -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (Bool
      -> WithPatchIndex
      -> UMask
      -> RemoteDarcs
      -> WithPrefsTemplates
      -> 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 (WithPrefsTemplates -> a)
PrimDarcsOption WithPrefsTemplates
O.withPrefsTemplates
    cloneOpts :: CommandOptions
cloneOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> Bool
   -> WithPatchIndex
   -> UMask
   -> RemoteDarcs
   -> WithPrefsTemplates
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe String
   -> CloneKind
   -> [MatchFlag]
   -> Maybe Bool
   -> InheritDefault
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> Bool
   -> WithPatchIndex
   -> UMask
   -> RemoteDarcs
   -> WithPrefsTemplates
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Maybe String
   -> CloneKind
   -> [MatchFlag]
   -> Maybe Bool
   -> InheritDefault
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> a)
cloneBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> Bool
   -> WithPatchIndex
   -> UMask
   -> RemoteDarcs
   -> WithPrefsTemplates
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (Maybe String
   -> CloneKind
   -> [MatchFlag]
   -> Maybe Bool
   -> InheritDefault
   -> SetScriptsExecutable
   -> WithWorkingDir
   -> Maybe StdCmdAction
   -> Verbosity
   -> Bool
   -> WithPatchIndex
   -> UMask
   -> RemoteDarcs
   -> WithPrefsTemplates
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (Bool
      -> WithPatchIndex
      -> UMask
      -> RemoteDarcs
      -> WithPrefsTemplates
      -> 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])
  (Bool
   -> WithPatchIndex
   -> UMask
   -> RemoteDarcs
   -> WithPrefsTemplates
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (Bool
   -> WithPatchIndex
   -> UMask
   -> RemoteDarcs
   -> WithPrefsTemplates
   -> a)
cloneAdvancedOpts

get :: DarcsCommand
get :: DarcsCommand
get = String -> Maybe DarcsCommand -> DarcsCommand -> DarcsCommand
commandAlias String
"get" Maybe DarcsCommand
forall a. Maybe a
Nothing DarcsCommand
clone

putDescription :: String
putDescription :: String
putDescription = String
"Deprecated command, replaced by clone."

putHelp :: Doc
putHelp :: Doc
putHelp = Int -> [String] -> Doc
formatText Int
80
 [ String
"This command is deprecated."
 , String
"To clone the current repository to a ssh destination, " String -> String -> String
forall a. [a] -> [a] -> [a]
++
   String
"use the syntax `darcs clone . user@server:path` ."
 ]

put :: DarcsCommand
put :: DarcsCommand
put = String -> Doc -> String -> DarcsCommand -> DarcsCommand
commandStub String
"put" Doc
putHelp String
putDescription DarcsCommand
clone

cloneCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
cloneCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
cloneCmd (AbsolutePath, AbsolutePath)
fps [DarcsFlag]
opts [String
inrepodir, String
outname] = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
cloneCmd (AbsolutePath, AbsolutePath)
fps (String -> [DarcsFlag] -> [DarcsFlag]
withNewRepo String
outname [DarcsFlag]
opts) [String
inrepodir]
cloneCmd (AbsolutePath
_,AbsolutePath
o) [DarcsFlag]
opts [String
inrepodir] = do
  String -> IO ()
debugMessage String
"Starting work on clone..."
  String
repodir <- AbsolutePath -> String -> IO String
fixUrl AbsolutePath
o String
inrepodir
  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
$ String
"Found the format of "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
repodirString -> String -> String
forall a. [a] -> [a] -> [a]
++String
"..."

  -- This merely forbids clone from an old-style rebase in progress, which is
  -- exactly what we want. Transferring patches from repos with new-style
  -- rebase in progress is unproblematic and fully supported.
  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 a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Cannot clone a repository with an old-style 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 String
"***********************************************************************"
    Doc -> Doc -> Doc
$$ String -> Doc
text String
"  _______   Sorry for the wait! The repository you are cloning is"
    Doc -> Doc -> Doc
$$ String -> Doc
text String
" |       |  using the DEPRECATED 'old-fashioned' format. I'm doing a"
    Doc -> Doc -> Doc
$$ String -> Doc
text String
" | O   O |  hashed copy instead, but this may take a while."
    Doc -> Doc -> Doc
$$ String -> Doc
text String
" |  ___  |"
    Doc -> Doc -> Doc
$$ String -> Doc
text String
" | /   \\ |  We recommend that the maintainer upgrade the remote copy"
    Doc -> Doc -> Doc
$$ String -> Doc
text String
" |_______|  as well. See http://wiki.darcs.net/OF for more information."
    Doc -> Doc -> Doc
$$ String -> Doc
text String
""
    Doc -> Doc -> Doc
$$ String -> Doc
text String
"***********************************************************************"

  case [DarcsFlag] -> Maybe String
cloneToSSH [DarcsFlag]
opts of
    Just String
repo -> do
      String -> (AbsolutePath -> IO ()) -> IO ()
forall a. String -> (AbsolutePath -> IO a) -> IO a
withTempDir String
"clone" ((AbsolutePath -> IO ()) -> IO ())
-> (AbsolutePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AbsolutePath
_ -> do
         String -> IO ()
prepareRemoteDir String
repo
         [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Creating local clone..."
         String
currentDir <- IO String
getCurrentDirectory
         String
mysimplename <- Bool -> [DarcsFlag] -> String -> IO String
makeRepoName Bool
True [] String
repodir -- give correct name to local clone
         String
-> String
-> Verbosity
-> UseCache
-> CloneKind
-> UMask
-> RemoteDarcs
-> SetScriptsExecutable
-> SetDefault
-> InheritDefault
-> [MatchFlag]
-> RepoFormat
-> WithWorkingDir
-> WithPatchIndex
-> Bool
-> ForgetParent
-> WithPrefsTemplates
-> IO ()
cloneRepository String
repodir String
mysimplename (PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (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)
                         CloneKind
CompleteClone (PrimOptSpec DarcsOptDescr DarcsFlag a UMask
PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimOptSpec DarcsOptDescr DarcsFlag a RemoteDarcs
PrimDarcsOption RemoteDarcs
O.remoteDarcs PrimDarcsOption RemoteDarcs -> [DarcsFlag] -> RemoteDarcs
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                         (PrimOptSpec DarcsOptDescr DarcsFlag a SetScriptsExecutable
PrimDarcsOption SetScriptsExecutable
setScriptsExecutable PrimDarcsOption SetScriptsExecutable
-> [DarcsFlag] -> SetScriptsExecutable
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                         (Bool -> SetDefault
NoSetDefault Bool
True)
                         InheritDefault
O.NoInheritDefault -- never inherit defaultrepo when cloning to ssh
                         ((MatchFlag -> MatchFlag) -> [MatchFlag] -> [MatchFlag]
forall a b. (a -> b) -> [a] -> [b]
map MatchFlag -> MatchFlag
convertUpToToOne (PrimOptSpec DarcsOptDescr DarcsFlag a [MatchFlag]
MatchOption
O.matchOneContext MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts))
                         RepoFormat
rfsource
                         (PrimOptSpec DarcsOptDescr DarcsFlag a WithWorkingDir
PrimDarcsOption WithWorkingDir
withWorkingDir PrimDarcsOption WithWorkingDir -> [DarcsFlag] -> WithWorkingDir
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                         (PrimOptSpec DarcsOptDescr DarcsFlag a WithPatchIndex
PrimDarcsOption WithPatchIndex
patchIndexNo PrimDarcsOption WithPatchIndex -> [DarcsFlag] -> WithPatchIndex
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                         (PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
usePacks PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                         ForgetParent
YesForgetParent
                         (PrimOptSpec DarcsOptDescr DarcsFlag a WithPrefsTemplates
PrimDarcsOption WithPrefsTemplates
O.withPrefsTemplates PrimDarcsOption WithPrefsTemplates
-> [DarcsFlag] -> WithPrefsTemplates
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
         String -> IO ()
setCurrentDirectory String
currentDir
         (String
scp, [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
$ String
"Transferring clone using " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..."
         -- This has the precondition that the last part of 'repo' does not
         -- exist on the remote host, but all its parent directories do,
         -- which is ensured by 'prepareRemoteDir'.
         -- Note that adding the trailing slash to the source is essential
         -- in order to allow DARCS_SCP=rsync to work the same way as scp.
         ExitCode
r <- String -> [String] -> Redirects -> IO ExitCode
exec String
scp ([String]
args [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"-r", String
mysimplename String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/", 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 a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Problem during " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
scp String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" transfer."
         [DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"Cloning and transferring successful."
    Maybe String
Nothing -> do
      String
mysimplename <- Bool -> [DarcsFlag] -> String -> IO String
makeRepoName Bool
True [DarcsFlag]
opts String
repodir
      String
-> String
-> Verbosity
-> UseCache
-> CloneKind
-> UMask
-> RemoteDarcs
-> SetScriptsExecutable
-> SetDefault
-> InheritDefault
-> [MatchFlag]
-> RepoFormat
-> WithWorkingDir
-> WithPatchIndex
-> Bool
-> ForgetParent
-> WithPrefsTemplates
-> IO ()
cloneRepository String
repodir String
mysimplename (PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
PrimDarcsOption Verbosity
verbosity PrimDarcsOption Verbosity -> [DarcsFlag] -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (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)
                  (PrimOptSpec DarcsOptDescr DarcsFlag a CloneKind
PrimDarcsOption CloneKind
cloneKind PrimDarcsOption CloneKind -> [DarcsFlag] -> CloneKind
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimOptSpec DarcsOptDescr DarcsFlag a UMask
PrimDarcsOption UMask
umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (PrimOptSpec DarcsOptDescr DarcsFlag a RemoteDarcs
PrimDarcsOption RemoteDarcs
O.remoteDarcs PrimDarcsOption RemoteDarcs -> [DarcsFlag] -> RemoteDarcs
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                  (PrimOptSpec DarcsOptDescr DarcsFlag a SetScriptsExecutable
PrimDarcsOption SetScriptsExecutable
setScriptsExecutable PrimDarcsOption SetScriptsExecutable
-> [DarcsFlag] -> SetScriptsExecutable
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                  (Bool -> [DarcsFlag] -> SetDefault
setDefault Bool
True [DarcsFlag]
opts)
                  (PrimOptSpec DarcsOptDescr DarcsFlag a InheritDefault
PrimDarcsOption InheritDefault
O.inheritDefault PrimDarcsOption InheritDefault -> [DarcsFlag] -> InheritDefault
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                  ((MatchFlag -> MatchFlag) -> [MatchFlag] -> [MatchFlag]
forall a b. (a -> b) -> [a] -> [b]
map MatchFlag -> MatchFlag
convertUpToToOne (PrimOptSpec DarcsOptDescr DarcsFlag a [MatchFlag]
MatchOption
O.matchOneContext MatchOption -> [DarcsFlag] -> [MatchFlag]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts))
                  RepoFormat
rfsource
                  (PrimOptSpec DarcsOptDescr DarcsFlag a WithWorkingDir
PrimDarcsOption WithWorkingDir
withWorkingDir PrimDarcsOption WithWorkingDir -> [DarcsFlag] -> WithWorkingDir
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                  (PrimOptSpec DarcsOptDescr DarcsFlag a WithPatchIndex
PrimDarcsOption WithPatchIndex
patchIndexNo PrimDarcsOption WithPatchIndex -> [DarcsFlag] -> WithPatchIndex
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                  (PrimOptSpec DarcsOptDescr DarcsFlag a Bool
PrimDarcsOption Bool
usePacks PrimDarcsOption Bool -> [DarcsFlag] -> Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
                  ForgetParent
NoForgetParent
                  (PrimOptSpec DarcsOptDescr DarcsFlag a WithPrefsTemplates
PrimDarcsOption WithPrefsTemplates
O.withPrefsTemplates PrimDarcsOption WithPrefsTemplates
-> [DarcsFlag] -> WithPrefsTemplates
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
      [DarcsFlag] -> String -> IO ()
putFinished [DarcsFlag]
opts String
"cloning"

cloneCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
_ [String]
_ = String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"You must provide 'clone' with either one or two arguments."

cloneToSSH :: [DarcsFlag] -> Maybe String
cloneToSSH :: [DarcsFlag] -> Maybe String
cloneToSSH [DarcsFlag]
fs = case PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe String)
PrimDarcsOption (Maybe String)
O.newRepo PrimDarcsOption (Maybe String) -> [DarcsFlag] -> Maybe String
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
fs of
  Maybe String
Nothing -> Maybe String
forall a. Maybe a
Nothing
  Just String
r -> if String -> Bool
isSshUrl String
r then String -> Maybe String
forall a. a -> Maybe a
Just (SshFilePath -> String
sshCanonRepo (SshFilePath -> String) -> SshFilePath -> String
forall a b. (a -> b) -> a -> b
$ String -> SshFilePath
splitSshUrl String
r) else Maybe String
forall a. Maybe a
Nothing

mkRemoteDirectory :: Bool -> String -> FilePath -> IO ()
mkRemoteDirectory :: Bool -> String -> String -> IO ()
mkRemoteDirectory Bool
recursive String
sshUhost String
path = do
  (String
ssh, [String]
ssh_args) <- SSHCmd -> IO (String, [String])
getSSH SSHCmd
SSH
  let ssh_cmd :: String
ssh_cmd = String
"mkdir " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Bool
recursive then String
"-p " else String
"") String -> String -> String
forall a. [a] -> [a] -> [a]
++  String
"'" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
  ExitCode
r <- String -> [String] -> Redirects -> IO ExitCode
exec String
ssh ([String]
ssh_args [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
sshUhost, String
ssh_cmd]) (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 a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Cannot create remote directory '"  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'."

rmRemoteDirectory :: String -> FilePath -> IO ()
rmRemoteDirectory :: String -> String -> IO ()
rmRemoteDirectory String
sshUhost String
path = do
  (String
ssh, [String]
ssh_args) <- SSHCmd -> IO (String, [String])
getSSH SSHCmd
SSH
  let ssh_cmd :: String
ssh_cmd = String
"rmdir '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"
  ExitCode
r <- String -> [String] -> Redirects -> IO ExitCode
exec String
ssh ([String]
ssh_args [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
sshUhost, String
ssh_cmd]) (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 a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Cannot remove remote directory '"  String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'."

-- | Make sure that the remote directory does not exist, but all its
-- parent directories do.
prepareRemoteDir :: String -> IO ()
prepareRemoteDir :: String -> IO ()
prepareRemoteDir String
rpath = do
  let sshfp :: SshFilePath
sshfp = String -> SshFilePath
splitSshUrl String
rpath
  let sshRepoParent :: String
sshRepoParent = if [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
sshPathParts Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then [String] -> String
joinPath ([String] -> [String]
forall a. HasCallStack => [a] -> [a]
init [String]
sshPathParts) else []
        where
          sshPathParts :: [String]
sshPathParts = String -> [String]
splitDirectories (SshFilePath -> String
sshRepo SshFilePath
sshfp)

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
sshRepoParent) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> String -> IO ()
mkRemoteDirectory Bool
True (SshFilePath -> String
sshUhost SshFilePath
sshfp) String
sshRepoParent
  Bool -> String -> String -> IO ()
mkRemoteDirectory Bool
False (SshFilePath -> String
sshUhost SshFilePath
sshfp) (SshFilePath -> String
sshRepo SshFilePath
sshfp)
  String -> String -> IO ()
rmRemoteDirectory (SshFilePath -> String
sshUhost SshFilePath
sshfp) (SshFilePath -> String
sshRepo SshFilePath
sshfp)

makeRepoName :: Bool -> [DarcsFlag] -> FilePath -> IO String
makeRepoName :: Bool -> [DarcsFlag] -> String -> IO String
makeRepoName Bool
talkative [DarcsFlag]
fs String
d =
  case PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe String)
PrimDarcsOption (Maybe String)
O.newRepo PrimDarcsOption (Maybe String) -> [DarcsFlag] -> Maybe String
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
fs 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 String -> IO String
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
"Directory or file named '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' already exists."
        else String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
n
    Maybe String
Nothing ->
      case String -> String
mkName String
d of
        String
"" -> Bool -> String -> IO String
getUniqueRepositoryName Bool
talkative String
"anonymous_repo"
        base :: String
base@(Char
'/':String
_) -> Bool -> String -> IO String
getUniqueRepositoryName Bool
talkative String
base -- Absolute
        String
base -- Relative
         -> 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 -> 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
== Char
'.') (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 a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"/:")) (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
== Char
'/') (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse

cloneHelpTag :: Doc
cloneHelpTag :: Doc
cloneHelpTag = [String] -> Doc
formatWords
  [ String
""
  , String
"It is often desirable to make a copy of a repository that excludes"
  , String
"some patches.  For example, if releases are tagged then `darcs clone"
  , String
"--tag .` would make a copy of the repository as at the latest release."
  , String
""
  , String
"An untagged repository state can still be identified unambiguously by"
  , String
"a context file, as generated by `darcs log --context`.  Given the"
  , String
"name of such a file, the `--context` option will create a repository"
  , String
"that includes only the patches from that context.  When a user reports"
  , String
"a bug in an unreleased version of your project, the recommended way to"
  , String
"find out exactly what version they were running is to have them" 
  , String
"include a context file in the bug report."
  , String
""
  , String
"You can also make a copy of an untagged state using the `--to-patch` or"
  , String
"`--to-match` options, which exclude patches *after* the first matching"
  , String
"patch.  Because these options treat the set of patches as an ordered"
  , String
"sequence, you may get different results after reordering with `darcs"
  , String
"optimize reorder`."
  ]

cloneHelpSSE :: Doc
cloneHelpSSE :: Doc
cloneHelpSSE = [String] -> Doc
formatWords
  [ String
"The `--set-scripts-executable` option causes scripts to be made"
  , String
"executable in the working tree. A script is any file that starts"
  , String
"with a shebang (\"#!\")."
  ]

cloneHelpInheritDefault :: Doc
cloneHelpInheritDefault :: Doc
cloneHelpInheritDefault = Doc
commonHelpInheritDefault Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
  [ String
"For the clone command it means the following:"
  , String
"If the source repository already has a defaultrepo set (either because"
  , String
"you cloned it or because you explicitly used the --set-default option),"
  , String
"and both source and target are locally valid paths on the same host,"
  , String
"then the target repo will get the same defaultrepo as the source repo."
  , String
"Otherwise the target repo gets the source repo itself as defaultrepo,"
  , String
"i.e. we fall back to the defalt behavior (--no-inherit-default)."
  ]

otherHelpInheritDefault :: Doc
otherHelpInheritDefault :: Doc
otherHelpInheritDefault = Doc
commonHelpInheritDefault Doc -> Doc -> Doc
$+$ [String] -> Doc
formatWords
  [ String
"For the commands push, pull, and send it means the following:"
  , String
"Changes the meaning of the --set-default option so that it sets the"
  , String
"(local) defaultrepo to the defaultrepo of the remote repo, instead of"
  , String
"the remote repo itself. This happens only if the remote repo does have"
  , String
"a defaultrepo set and both local and remote repositories are locally"
  , String
"valid paths on the same host, otherwise fall back to the default behavior"
  , String
"(--no-inherit-default)."
  ]

commonHelpInheritDefault :: Doc
commonHelpInheritDefault :: Doc
commonHelpInheritDefault = [String] -> Doc
formatWords
  [ String
"The --inherit-default option is meant to support a work flow where"
  , String
"you have different branches of the same upstream repository and want"
  , String
"all your branches to have the same upstream repo as the defaultrepo."
  , String
"It is most useful when enabled globally by adding 'ALL --inherit-default'"
  , String
"to your ~/darcs/defaults file."
  ]

-- | The 'clone' command takes --to-patch and --to-match as arguments,
-- but internally wants to handle them as if they were --patch and --match.
-- This function does the conversion.
convertUpToToOne :: MatchFlag -> MatchFlag
convertUpToToOne :: MatchFlag -> MatchFlag
convertUpToToOne (UpToPattern String
p) = String -> MatchFlag
OnePattern String
p
convertUpToToOne (UpToPatch String
p) = String -> MatchFlag
OnePatch String
p
convertUpToToOne (UpToHash String
p) = String -> MatchFlag
OneHash String
p
convertUpToToOne MatchFlag
f = MatchFlag
f