-- 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.Flags ( DarcsFlag( WorkRepoDir ), withWorkingDir, patchFormat, runPatchIndex ) import Darcs.UI.Options ( DarcsOption, (^), odesc, ocheck, onormalise, defaultFlags ) import qualified Darcs.UI.Options.All as O ( patchFormat, useWorkingDir, workingRepoDir, patchIndex, hashed , PatchFormat, WithWorkingDir, WithPatchIndex , StdCmdAction, Verbosity, UseCache, PatchFormat(..) ) import Darcs.UI.Options.All ( ) import Darcs.Util.Printer ( text ) import Darcs.Util.Path ( AbsolutePath ) import Darcs.Util.Text ( quote ) import Darcs.Repository ( createRepository ) initializeDescription :: String initializeDescription = "Create an empty repository." initializeHelp :: String initializeHelp = "The `darcs initialize` command creates an empty repository in the\n" ++ "current directory. This repository lives in a new `_darcs` directory,\n"++ "which stores version control metadata and settings.\n" ++ "\n" ++ "Any existing files and subdirectories become UNSAVED changes:\n" ++ "record them with `darcs record --look-for-adds`.\n" ++ "\n" ++ "By default, patches of the new repository are in the darcs-2 semantics.\n" ++ "However it is possible to create a repository in darcs-1 semantics with\n" ++ "the flag `--darcs-1`, althought this is not recommended except for sharing\n" ++ "patches with a project that uses patches in the darcs-1 semantics.\n" ++ "\n" ++ "Initialize is commonly abbreviated to `init`.\n" initBasicOpts :: DarcsOption a (O.PatchFormat -> O.WithWorkingDir -> Maybe String -> a) initBasicOpts = O.patchFormat ^ O.useWorkingDir ^ O.workingRepoDir initAdvancedOpts :: DarcsOption a (O.WithPatchIndex -> () -> a) initAdvancedOpts = O.patchIndex ^ O.hashed initOpts :: DarcsOption a (O.PatchFormat -> O.WithWorkingDir -> Maybe String -> Maybe O.StdCmdAction -> Bool -> Bool -> O.Verbosity -> Bool -> O.WithPatchIndex -> () -> O.UseCache -> Maybe String -> Bool -> Maybe String -> Bool -> a) initOpts = initBasicOpts `withStdOpts` initAdvancedOpts initialize :: DarcsCommand [DarcsFlag] initialize = DarcsCommand { commandProgramName = "darcs" , commandName = "initialize" , commandHelp = initializeHelp , commandDescription = initializeDescription , commandExtraArgs = -1 , commandExtraArgHelp = ["[]"] , commandPrereq = \_ -> return $ Right () , commandCommand = initializeCmd , commandGetArgPossibilities = return [] , commandArgdefaults = nodefaults , commandAdvancedOptions = odesc initAdvancedOpts , commandBasicOptions = odesc initBasicOpts , commandDefaults = defaultFlags initOpts , commandCheckOptions = ocheck initOpts , commandParseOptions = onormalise initOpts } initializeCmd :: (AbsolutePath, AbsolutePath) -> [DarcsFlag] -> [String] -> IO () initializeCmd aps opts [outname] | null [ () | WorkRepoDir _ <- opts ] = initializeCmd aps (WorkRepoDir outname:opts) [] initializeCmd _ opts [] = do location <- amNotInRepository opts case location of Left msg -> fail $ "Unable to " ++ quote ("darcs " ++ commandName initialize) ++ " here.\n\n" ++ msg Right () -> do createRepository (patchFormat opts) (withWorkingDir opts) (runPatchIndex opts) putInfo opts $ text "Repository initialized." initializeCmd _ _ _ = fail "You must provide 'initialize' with either zero or one argument."