--  Copyright (C) 2002-2003 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.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."