--  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.

{-# 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.Commands.Util ( commonHelpWithPrefsTemplates )
import Darcs.UI.Completion ( noArgs )
import Darcs.UI.Flags ( DarcsFlag, withNewRepo )
import Darcs.UI.Options ( (?), (^) )
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 ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ([[Char]] -> Doc) -> [[[Char]]] -> [Doc]
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."
    ]
  ] [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ [Doc
darcs3Warning, Doc
commonHelpWithPrefsTemplates]

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]
_ -> Either [Char] () -> IO (Either [Char] ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either [Char] () -> IO (Either [Char] ()))
-> Either [Char] () -> IO (Either [Char] ())
forall a b. (a -> b) -> a -> b
$ () -> Either [Char] ()
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
    , commandOptions :: CommandOptions
commandOptions = CommandOptions
initOpts
    }
  where
    initBasicOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (PatchFormat -> WithWorkingDir -> Maybe [Char] -> a)
initBasicOpts = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (WithWorkingDir -> Maybe [Char] -> a)
  PatchFormat
PrimDarcsOption PatchFormat
O.patchFormat PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (WithWorkingDir -> Maybe [Char] -> a)
  PatchFormat
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe [Char] -> a)
     (WithWorkingDir -> Maybe [Char] -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (Maybe [Char] -> a)
     (PatchFormat -> WithWorkingDir -> Maybe [Char] -> 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 [Char] -> a)
  (WithWorkingDir -> Maybe [Char] -> a)
PrimDarcsOption WithWorkingDir
O.withWorkingDir OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe [Char] -> a)
  (PatchFormat -> WithWorkingDir -> Maybe [Char] -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (Maybe [Char] -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (PatchFormat -> WithWorkingDir -> Maybe [Char] -> 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 [Char] -> a)
PrimDarcsOption (Maybe [Char])
O.newRepo
    initAdvancedOpts :: OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (WithPatchIndex -> () -> UMask -> WithPrefsTemplates -> a)
initAdvancedOpts = PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (() -> UMask -> WithPrefsTemplates -> a)
  WithPatchIndex
PrimDarcsOption WithPatchIndex
O.patchIndexNo PrimOptSpec
  DarcsOptDescr
  DarcsFlag
  (() -> UMask -> WithPrefsTemplates -> a)
  WithPatchIndex
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (UMask -> WithPrefsTemplates -> a)
     (() -> UMask -> WithPrefsTemplates -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (UMask -> WithPrefsTemplates -> a)
     (WithPatchIndex -> () -> UMask -> 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 -> WithPrefsTemplates -> a)
  (() -> UMask -> WithPrefsTemplates -> a)
PrimDarcsOption ()
O.hashed OptSpec
  DarcsOptDescr
  DarcsFlag
  (UMask -> WithPrefsTemplates -> a)
  (WithPatchIndex -> () -> UMask -> WithPrefsTemplates -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithPrefsTemplates -> a)
     (UMask -> WithPrefsTemplates -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     (WithPrefsTemplates -> a)
     (WithPatchIndex -> () -> UMask -> 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)
  (UMask -> WithPrefsTemplates -> a)
PrimDarcsOption UMask
O.umask OptSpec
  DarcsOptDescr
  DarcsFlag
  (WithPrefsTemplates -> a)
  (WithPatchIndex -> () -> UMask -> WithPrefsTemplates -> a)
-> OptSpec DarcsOptDescr DarcsFlag a (WithPrefsTemplates -> a)
-> OptSpec
     DarcsOptDescr
     DarcsFlag
     a
     (WithPatchIndex -> () -> UMask -> 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
    initOpts :: CommandOptions
initOpts = OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> WithPatchIndex
   -> ()
   -> UMask
   -> WithPrefsTemplates
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (PatchFormat
   -> WithWorkingDir
   -> Maybe [Char]
   -> Maybe StdCmdAction
   -> Verbosity
   -> WithPatchIndex
   -> ()
   -> UMask
   -> WithPrefsTemplates
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (PatchFormat -> WithWorkingDir -> Maybe [Char] -> a)
initBasicOpts OptSpec
  DarcsOptDescr
  DarcsFlag
  (Maybe StdCmdAction
   -> Verbosity
   -> WithPatchIndex
   -> ()
   -> UMask
   -> WithPrefsTemplates
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
  (PatchFormat
   -> WithWorkingDir
   -> Maybe [Char]
   -> Maybe StdCmdAction
   -> Verbosity
   -> WithPatchIndex
   -> ()
   -> UMask
   -> WithPrefsTemplates
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
-> DarcsOption
     (UseCache
      -> UseIndex -> HooksConfig -> Bool -> Bool -> [DarcsFlag])
     (WithPatchIndex
      -> ()
      -> UMask
      -> 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])
  (WithPatchIndex
   -> ()
   -> UMask
   -> WithPrefsTemplates
   -> UseCache
   -> UseIndex
   -> HooksConfig
   -> Bool
   -> Bool
   -> [DarcsFlag])
forall {a}.
OptSpec
  DarcsOptDescr
  DarcsFlag
  a
  (WithPatchIndex -> () -> UMask -> WithPrefsTemplates -> a)
initAdvancedOpts

initializeCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO ()
initializeCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [[Char]] -> IO ()
initializeCmd (AbsolutePath, AbsolutePath)
_ [DarcsFlag]
opts [[Char]
outname]
  | Maybe [Char]
Nothing <- PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe [Char])
PrimDarcsOption (Maybe [Char])
O.newRepo PrimDarcsOption (Maybe [Char]) -> [DarcsFlag] -> Maybe [Char]
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]]
_ =
  [Char] -> IO ()
forall a. [Char] -> IO a
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 =
  UMask -> IO () -> IO ()
forall a. UMask -> IO a -> IO a
withUMaskFlag (PrimOptSpec DarcsOptDescr DarcsFlag a UMask
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 [Char] ()
location <- [DarcsFlag] -> IO (Either [Char] ())
amNotInRepository [DarcsFlag]
opts
    case Either [Char] ()
location of
      Left [Char]
msg -> [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc -> [Char]
renderString (Doc -> [Char]) -> Doc -> [Char]
forall a b. (a -> b) -> a -> b
$
        Doc
"Unable to" Doc -> Doc -> Doc
<+> [Char] -> Doc
quoted ([Char]
"darcs " [Char] -> [Char] -> [Char]
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
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PrimOptSpec DarcsOptDescr DarcsFlag a PatchFormat
PrimDarcsOption PatchFormat
O.patchFormat PrimDarcsOption PatchFormat -> [DarcsFlag] -> PatchFormat
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts PatchFormat -> PatchFormat -> Bool
forall a. Eq a => a -> a -> Bool
== PatchFormat
O.PatchFormat3) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          [DarcsFlag] -> Doc -> IO ()
putWarning [DarcsFlag]
opts (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
            Doc
"============================= WARNING =============================" Doc -> Doc -> Doc
$$
            Doc
darcs3Warning Doc -> Doc -> Doc
$$
            Doc
"==================================================================="
        EmptyRepository
_ <- PatchFormat
-> WithWorkingDir
-> WithPatchIndex
-> UseCache
-> WithPrefsTemplates
-> IO EmptyRepository
createRepository
          (PrimOptSpec DarcsOptDescr DarcsFlag a PatchFormat
PrimDarcsOption PatchFormat
O.patchFormat PrimDarcsOption PatchFormat -> [DarcsFlag] -> PatchFormat
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
          (PrimOptSpec DarcsOptDescr DarcsFlag a WithWorkingDir
PrimDarcsOption WithWorkingDir
O.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
O.patchIndexNo PrimDarcsOption WithPatchIndex -> [DarcsFlag] -> WithPatchIndex
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
          (PrimOptSpec DarcsOptDescr DarcsFlag a UseCache
PrimDarcsOption UseCache
O.useCache PrimDarcsOption UseCache -> [DarcsFlag] -> UseCache
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? [DarcsFlag]
opts)
          (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] -> [Char] -> IO ()
putFinished [DarcsFlag]
opts ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"initializing repository"