module Darcs.UI.Commands.Init ( initialize, initializeCmd ) where
import Prelude ()
import Darcs.Prelude
import Prelude hiding ( (^) )
import Darcs.UI.Commands
( DarcsCommand(..), withStdOpts, nodefaults, amNotInRepository, putInfo )
import Darcs.UI.Completion ( noArgs )
import Darcs.UI.Flags ( DarcsFlag( WorkRepoDir ) )
import Darcs.UI.Options ( (^), odesc, ocheck, onormalise, defaultFlags, (?) )
import qualified Darcs.UI.Options.All as O
import Darcs.UI.Options.All ( )
import Darcs.Util.Printer ( text )
import Darcs.Util.Path ( AbsolutePath )
import Darcs.Util.Text ( quote )
import Darcs.Repository ( createRepository, withUMaskFlag )
initializeDescription :: String
initializeDescription :: String
initializeDescription = "Create an empty repository."
initializeHelp :: String
initializeHelp :: String
initializeHelp =
"The `darcs initialize` command creates an empty repository in the\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"current directory. This repository lives in a new `_darcs` directory,\n"String -> String -> String
forall a. [a] -> [a] -> [a]
++
"which stores version control metadata and settings.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"Any existing files and subdirectories become UNSAVED changes:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"record them with `darcs record --look-for-adds`.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"By default, patches of the new repository are in the darcs-2 semantics.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"However it is possible to create a repository in darcs-1 semantics with\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"the flag `--darcs-1`, althought this is not recommended except for sharing\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"patches with a project that uses patches in the darcs-1 semantics.\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
"Initialize is commonly abbreviated to `init`.\n"
initialize :: DarcsCommand [DarcsFlag]
initialize :: DarcsCommand [DarcsFlag]
initialize = 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 = "initialize"
, commandHelp :: String
commandHelp = String
initializeHelp
, commandDescription :: String
commandDescription = String
initializeDescription
, commandExtraArgs :: Int
commandExtraArgs = -1
, commandExtraArgHelp :: [String]
commandExtraArgHelp = ["[<DIRECTORY>]"]
, commandPrereq :: [DarcsFlag] -> IO (Either String ())
commandPrereq = \_ -> 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 ()
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
initializeCmd
, 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 (WithPatchIndex -> () -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec DarcsOptDescr DarcsFlag Any (WithPatchIndex -> () -> Any)
forall a.
OptSpec DarcsOptDescr DarcsFlag a (WithPatchIndex -> () -> a)
initAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(PatchFormat -> WithWorkingDir -> Maybe String -> Any)
-> [DarcsOptDescr DarcsFlag]
forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc OptSpec
DarcsOptDescr
DarcsFlag
Any
(PatchFormat -> WithWorkingDir -> Maybe String -> Any)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(PatchFormat -> WithWorkingDir -> Maybe String -> a)
initBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(PatchFormat
-> WithWorkingDir
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> ()
-> UseCache
-> HooksConfig
-> [DarcsFlag])
-> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(PatchFormat
-> WithWorkingDir
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> ()
-> UseCache
-> HooksConfig
-> [DarcsFlag])
forall a.
DarcsOption
a
(PatchFormat
-> WithWorkingDir
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> ()
-> UseCache
-> HooksConfig
-> a)
initOpts
, commandCheckOptions :: [DarcsFlag] -> [String]
commandCheckOptions = OptSpec
DarcsOptDescr
DarcsFlag
Any
(PatchFormat
-> WithWorkingDir
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> ()
-> UseCache
-> HooksConfig
-> Any)
-> [DarcsFlag] -> [String]
forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [String]
ocheck OptSpec
DarcsOptDescr
DarcsFlag
Any
(PatchFormat
-> WithWorkingDir
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> ()
-> UseCache
-> HooksConfig
-> Any)
forall a.
DarcsOption
a
(PatchFormat
-> WithWorkingDir
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> ()
-> UseCache
-> HooksConfig
-> a)
initOpts
, commandParseOptions :: [DarcsFlag] -> [DarcsFlag]
commandParseOptions = OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(PatchFormat
-> WithWorkingDir
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> ()
-> UseCache
-> HooksConfig
-> [DarcsFlag])
-> [DarcsFlag] -> [DarcsFlag]
forall (d :: * -> *) f b. OptSpec d f [f] b -> [f] -> [f]
onormalise OptSpec
DarcsOptDescr
DarcsFlag
[DarcsFlag]
(PatchFormat
-> WithWorkingDir
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> ()
-> UseCache
-> HooksConfig
-> [DarcsFlag])
forall a.
DarcsOption
a
(PatchFormat
-> WithWorkingDir
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> ()
-> UseCache
-> HooksConfig
-> a)
initOpts
}
where
initBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(PatchFormat -> WithWorkingDir -> Maybe String -> a)
initBasicOpts = PrimOptSpec
DarcsOptDescr
DarcsFlag
(WithWorkingDir -> Maybe String -> a)
PatchFormat
PrimDarcsOption PatchFormat
O.patchFormat PrimOptSpec
DarcsOptDescr
DarcsFlag
(WithWorkingDir -> Maybe String -> a)
PatchFormat
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
(WithWorkingDir -> Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
(PatchFormat -> WithWorkingDir -> Maybe String -> 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 String -> a)
(WithWorkingDir -> Maybe String -> a)
PrimDarcsOption WithWorkingDir
O.withWorkingDir OptSpec
DarcsOptDescr
DarcsFlag
(Maybe String -> a)
(PatchFormat -> WithWorkingDir -> Maybe String -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Maybe String -> a)
-> OptSpec
DarcsOptDescr
DarcsFlag
a
(PatchFormat -> WithWorkingDir -> Maybe String -> a)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr DarcsFlag a (Maybe String -> a)
PrimDarcsOption (Maybe String)
O.repoDir
initAdvancedOpts :: OptSpec DarcsOptDescr DarcsFlag a (WithPatchIndex -> () -> a)
initAdvancedOpts = PrimOptSpec DarcsOptDescr DarcsFlag (() -> a) WithPatchIndex
PrimDarcsOption WithPatchIndex
O.patchIndexNo PrimOptSpec DarcsOptDescr DarcsFlag (() -> a) WithPatchIndex
-> OptSpec DarcsOptDescr DarcsFlag a (() -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (WithPatchIndex -> () -> 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 (() -> a)
PrimDarcsOption ()
O.hashed
initOpts :: DarcsOption
a
(PatchFormat
-> WithWorkingDir
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> ()
-> UseCache
-> HooksConfig
-> a)
initOpts = OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> ()
-> UseCache
-> HooksConfig
-> a)
(PatchFormat
-> WithWorkingDir
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> ()
-> UseCache
-> HooksConfig
-> a)
forall a.
OptSpec
DarcsOptDescr
DarcsFlag
a
(PatchFormat -> WithWorkingDir -> Maybe String -> a)
initBasicOpts OptSpec
DarcsOptDescr
DarcsFlag
(Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> ()
-> UseCache
-> HooksConfig
-> a)
(PatchFormat
-> WithWorkingDir
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> ()
-> UseCache
-> HooksConfig
-> a)
-> DarcsOption
(UseCache -> HooksConfig -> a)
(WithPatchIndex -> () -> UseCache -> HooksConfig -> a)
-> DarcsOption
a
(PatchFormat
-> WithWorkingDir
-> Maybe String
-> Maybe StdCmdAction
-> Bool
-> Bool
-> Verbosity
-> Bool
-> WithPatchIndex
-> ()
-> 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)
(WithPatchIndex -> () -> UseCache -> HooksConfig -> a)
forall a.
OptSpec DarcsOptDescr DarcsFlag a (WithPatchIndex -> () -> a)
initAdvancedOpts
initializeCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
initializeCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
initializeCmd aps :: (AbsolutePath, AbsolutePath)
aps opts :: [DarcsFlag]
opts [outname :: String
outname] | [()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ () | WorkRepoDir _ <- [DarcsFlag]
opts ] =
(AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
initializeCmd (AbsolutePath, AbsolutePath)
aps (String -> DarcsFlag
WorkRepoDir String
outnameDarcsFlag -> [DarcsFlag] -> [DarcsFlag]
forall a. a -> [a] -> [a]
:[DarcsFlag]
opts) []
initializeCmd _ opts :: [DarcsFlag]
opts [] =
UMask -> IO () -> IO ()
forall a. UMask -> IO a -> IO a
withUMaskFlag (PrimDarcsOption UMask
O.umask PrimDarcsOption UMask -> [DarcsFlag] -> UMask
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Either String ()
location <- [DarcsFlag] -> IO (Either String ())
amNotInRepository [DarcsFlag]
opts
case Either String ()
location of
Left msg :: String
msg -> String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Unable to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
quote ("darcs " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DarcsCommand [DarcsFlag] -> String
forall parsedFlags. DarcsCommand parsedFlags -> String
commandName DarcsCommand [DarcsFlag]
initialize)
String -> String -> String
forall a. [a] -> [a] -> [a]
++ " here.\n\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
Right () -> do
EmptyRepository
_ <- PatchFormat
-> WithWorkingDir
-> WithPatchIndex
-> UseCache
-> IO EmptyRepository
createRepository
(PrimDarcsOption PatchFormat
O.patchFormat PrimDarcsOption PatchFormat -> [DarcsFlag] -> PatchFormat
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption WithWorkingDir
O.withWorkingDir PrimDarcsOption WithWorkingDir -> [DarcsFlag] -> WithWorkingDir
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption WithPatchIndex
O.patchIndexNo PrimDarcsOption WithPatchIndex -> [DarcsFlag] -> WithPatchIndex
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption UseCache
O.useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
[DarcsFlag] -> Doc -> IO ()
putInfo [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "Repository initialized."
initializeCmd _ _ _ = String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "You must provide 'initialize' with either zero or one argument."