{-# LANGUAGE OverloadedStrings #-}
module Darcs.UI.Commands.Init ( initialize, initializeCmd ) where
import Darcs.Prelude
import Control.Monad ( when )
import Darcs.Repository ( createRepository, withUMaskFlag )
import Darcs.UI.Commands
( DarcsCommand(..)
, amNotInRepository
, nodefaults
, putFinished
, withStdOpts
, putWarning
)
import Darcs.UI.Completion ( noArgs )
import Darcs.UI.Flags ( DarcsFlag, withNewRepo )
import Darcs.UI.Options ( defaultFlags, ocheck, odesc, (?), (^) )
import Darcs.UI.Options.All ()
import qualified Darcs.UI.Options.All as O
import Darcs.Util.Path ( AbsolutePath )
import Darcs.Util.Printer
( Doc
, formatWords
, quoted
, renderString
, text
, vsep
, ($$)
, (<+>)
)
initializeDescription :: String
initializeDescription :: [Char]
initializeDescription = [Char]
"Create an empty repository."
initializeHelp :: Doc
initializeHelp :: Doc
initializeHelp = [Doc] -> Doc
vsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [[Char]] -> Doc
formatWords
[ [ [Char]
"The `darcs initialize` command creates an empty repository in the"
, [Char]
"current directory. This repository lives in a new `_darcs` directory,"
, [Char]
"which stores version control metadata and settings."
]
, [ [Char]
"Existing files and subdirectories are not touched. You can"
, [Char]
"record them with `darcs record --look-for-adds`."
]
, [ [Char]
"Initialize is commonly abbreviated to `init`."
]
, [ [Char]
"Darcs currently supports three kinds of patch semantics. These are called"
, [Char]
"`darcs-1`, `darcs-2`, and `darcs-3`. They are mutually incompatible, that"
, [Char]
"is, you cannot exchange patches between repos with different semantics."
]
, [ [Char]
"By default, patches of the new repository are in the darcs-2 semantics."
, [Char]
"However it is possible to create a repository in darcs-1 semantics with"
, [Char]
"the flag `--darcs-1`, althought this is not recommended except for sharing"
, [Char]
"patches with a project that uses patches in the darcs-1 semantics."
]
] forall a. [a] -> [a] -> [a]
++ [Doc
darcs3Warning]
darcs3Warning :: Doc
darcs3Warning :: Doc
darcs3Warning = [[Char]] -> Doc
formatWords
[ [Char]
"The `darcs-3` semantics is EXPERIMENTAL and new in version 2.16. It is"
, [Char]
"included only as a technology preview and we do NOT recommend to use it"
, [Char]
"for any serious work. The on-disk format is not yet finalized and we"
, [Char]
"cannot and will not promise that later releases will work with darcs-3"
, [Char]
"repos created with any darcs version before 3.0."
]
initialize :: DarcsCommand
initialize :: DarcsCommand
initialize = DarcsCommand
{ commandProgramName :: [Char]
commandProgramName = [Char]
"darcs"
, commandName :: [Char]
commandName = [Char]
"initialize"
, commandHelp :: Doc
commandHelp = Doc
initializeHelp
, commandDescription :: [Char]
commandDescription = [Char]
initializeDescription
, commandExtraArgs :: Int
commandExtraArgs = -Int
1
, commandExtraArgHelp :: [[Char]]
commandExtraArgHelp = [[Char]
"[<DIRECTORY>]"]
, commandPrereq :: [DarcsFlag] -> IO (Either [Char] ())
commandPrereq = \[DarcsFlag]
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
, commandCommand :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
commandCommand = (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
initializeCmd
, commandCompleteArgs :: (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [[Char]] -> IO [[Char]]
commandCompleteArgs = (AbsolutePath, AbsolutePath)
-> [DarcsFlag] -> [[Char]] -> IO [[Char]]
noArgs
, commandArgdefaults :: [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
commandArgdefaults = [DarcsFlag] -> AbsolutePath -> [[Char]] -> IO [[Char]]
nodefaults
, commandAdvancedOptions :: [DarcsOptDescr DarcsFlag]
commandAdvancedOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr DarcsFlag a (WithPatchIndex -> () -> UMask -> a)
initAdvancedOpts
, commandBasicOptions :: [DarcsOptDescr DarcsFlag]
commandBasicOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [d f]
odesc forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(PatchFormat -> WithWorkingDir -> Maybe [Char] -> a)
initBasicOpts
, commandDefaults :: [DarcsFlag]
commandDefaults = forall (d :: * -> *) f b. OptSpec d f [f] b -> [f]
defaultFlags forall {a}.
DarcsOption
a
(PatchFormat
-> WithWorkingDir
-> Maybe [Char]
-> Maybe StdCmdAction
-> Verbosity
-> WithPatchIndex
-> ()
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
initOpts
, commandCheckOptions :: [DarcsFlag] -> [[Char]]
commandCheckOptions = forall (d :: * -> *) f a b. OptSpec d f a b -> [f] -> [[Char]]
ocheck forall {a}.
DarcsOption
a
(PatchFormat
-> WithWorkingDir
-> Maybe [Char]
-> Maybe StdCmdAction
-> Verbosity
-> WithPatchIndex
-> ()
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
initOpts
}
where
initBasicOpts :: OptSpec
DarcsOptDescr
DarcsFlag
a
(PatchFormat -> WithWorkingDir -> Maybe [Char] -> a)
initBasicOpts = PrimDarcsOption PatchFormat
O.patchFormat forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption WithWorkingDir
O.withWorkingDir forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption (Maybe [Char])
O.newRepo
initAdvancedOpts :: OptSpec
DarcsOptDescr DarcsFlag a (WithPatchIndex -> () -> UMask -> a)
initAdvancedOpts = PrimDarcsOption WithPatchIndex
O.patchIndexNo forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption ()
O.hashed forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ PrimDarcsOption UMask
O.umask
initOpts :: DarcsOption
a
(PatchFormat
-> WithWorkingDir
-> Maybe [Char]
-> Maybe StdCmdAction
-> Verbosity
-> WithPatchIndex
-> ()
-> UMask
-> UseCache
-> HooksConfig
-> Bool
-> Bool
-> Bool
-> a)
initOpts = forall {a}.
OptSpec
DarcsOptDescr
DarcsFlag
a
(PatchFormat -> WithWorkingDir -> Maybe [Char] -> a)
initBasicOpts forall b c a.
DarcsOption (Maybe StdCmdAction -> Verbosity -> b) c
-> DarcsOption
(UseCache -> HooksConfig -> Bool -> Bool -> Bool -> a) b
-> DarcsOption a c
`withStdOpts` forall {a}.
OptSpec
DarcsOptDescr DarcsFlag a (WithPatchIndex -> () -> UMask -> a)
initAdvancedOpts
initializeCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
initializeCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
initializeCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [[Char]
outname]
| Maybe [Char]
Nothing <- PrimDarcsOption (Maybe [Char])
O.newRepo forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts = [DarcsFlag] -> IO ()
doInit ([Char] -> [DarcsFlag] -> [DarcsFlag]
withNewRepo [Char]
outname [DarcsFlag]
opts)
initializeCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [] = [DarcsFlag] -> IO ()
doInit [DarcsFlag]
opts
initializeCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
_ [[Char]]
_ =
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"You must provide 'initialize' with either zero or one argument."
doInit :: [DarcsFlag] -> IO ()
doInit :: [DarcsFlag] -> IO ()
doInit [DarcsFlag]
opts =
forall a. UMask -> IO a -> IO a
withUMaskFlag (PrimDarcsOption UMask
O.umask forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts) forall a b. (a -> b) -> a -> b
$ do
Either [Char] ()
location <- [DarcsFlag] -> IO (Either [Char] ())
amNotInRepository [DarcsFlag]
opts
case Either [Char] ()
location of
Left [Char]
msg -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall a b. (a -> b) -> a -> b
$ Doc -> [Char]
renderString forall a b. (a -> b) -> a -> b
$
Doc
"Unable to" Doc -> Doc -> Doc
<+> [Char] -> Doc
quoted ([Char]
"darcs " forall a. [a] -> [a] -> [a]
++ DarcsCommand -> [Char]
commandName DarcsCommand
initialize)
Doc -> Doc -> Doc
<+> Doc
"here:" Doc -> Doc -> Doc
$$ [Char] -> Doc
text [Char]
msg
Right () -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PrimDarcsOption PatchFormat
O.patchFormat forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts forall a. Eq a => a -> a -> Bool
== PatchFormat
O.PatchFormat3) forall a b. (a -> b) -> a -> b
$
[DarcsFlag] -> Doc -> IO ()
putWarning [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$
Doc
"============================= WARNING =============================" Doc -> Doc -> Doc
$$
Doc
darcs3Warning Doc -> Doc -> Doc
$$
Doc
"==================================================================="
EmptyRepository
_ <- PatchFormat
-> WithWorkingDir
-> WithPatchIndex
-> UseCache
-> IO EmptyRepository
createRepository
(PrimDarcsOption PatchFormat
O.patchFormat forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption WithWorkingDir
O.withWorkingDir forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption WithPatchIndex
O.patchIndexNo forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
(PrimDarcsOption UseCache
O.useCache forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
[DarcsFlag] -> [Char] -> IO ()
putFinished [DarcsFlag]
opts forall a b. (a -> b) -> a -> b
$ [Char]
"initializing repository"