% Copyright (C) 2002-2004 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. \begin{code} {-# OPTIONS_GHC -cpp #-} {-# LANGUAGE CPP #-} #include "gadts.h" module Darcs.Arguments ( DarcsFlag( .. ), flagToString, maxCount, isin, arein, definePatches, defineChanges, fixFilePathOrStd, fixUrl, fixSubPaths, areFileArgs, DarcsOption( .. ), option_from_darcsoption, help, list_options, list_files, any_verbosity, disable, restrict_paths, notest, test, working_repo_dir, testByDefault, remote_repo, leave_test_dir, possibly_remote_repo_dir, get_repourl, list_registered_files, list_unregistered_files, author, get_author, get_easy_author, get_sendmail_cmd, patchname_option, distname_option, logfile, rmlogfile, from_opt, subject, get_subject, in_reply_to, get_in_reply_to, target, cc, get_cc, output, output_auto_name, recursive, inventory_choices, get_inventory_choices, askdeps, ignoretimes, lookforadds, ask_long_comment, sendmail_cmd, environmentHelpSendmail, sign, verify, edit_description, reponame, tagname, creatorhash, apply_conflict_options, reply, pull_conflict_options, use_external_merge, deps_sel, nocompress, uncompress_nocompress, repo_combinator, options_latex, reorder_patches, noskip_boring, allow_problematic_filenames, applyas, human_readable, changes_reverse, only_to_files, changes_format, match_one_context, match_one_nontag, match_maxcount, send_to_context, get_context, pipe_interactive, all_interactive, all_pipe_interactive, summary, unified, tokens, checkpoint, partial, partial_check, diff_cmd_flag, diffflags, unidiff, xmloutput, force_replace, dry_run, dry_run_noxml, print_dry_run_message_and_exit, showFriendly, match_one, match_several, match_range, match_several_or_range, happy_forwarding, match_several_or_last, set_default, fancy_move_add, set_scripts_executable, sibling, flagsToSiblings, relink, relink_pristine, nolinks, files, directories, pending, posthook_cmd, posthook_prompt, get_posthook_cmd, prehook_cmd, prehook_prompt, get_prehook_cmd, nullFlag, umask_option, store_in_memory, patch_select_flag, network_options, no_cache, allow_unrelated_repos, check_or_repair, just_this_repo ) where import System.Console.GetOpt import System.Directory ( doesDirectoryExist ) import Data.List ( (\\), nub ) import Data.Maybe ( fromMaybe, listToMaybe ) import System.Exit ( ExitCode(ExitSuccess), exitWith ) import Data.Maybe ( catMaybes ) import Control.Monad ( when, unless ) import Data.Char ( isDigit ) #ifndef WIN32 import Printer ( renderString ) import System.Posix.Env ( setEnv ) import Darcs.Patch ( list_touched_files ) import Progress ( beginTedious, endTedious, tediousSize, finishedOneIO ) #endif import Darcs.Hopefully ( PatchInfoAnd, info, hopefullyM ) import Darcs.Patch ( RepoPatch, Patchy, showNicely, description, xml_summary ) import Darcs.Patch.Info ( to_xml ) import Darcs.Ordered ( FL, mapFL ) import qualified Darcs.Patch ( summary ) import Darcs.Utils ( askUser, maybeGetEnv, firstNotBlank, firstJustIO, withCurrentDirectory ) import Darcs.Repository.Prefs ( boring_file_filter, get_preflist, get_global ) import Darcs.URL ( is_file ) import Darcs.RepoPath ( AbsolutePath, AbsolutePathOrStd, SubPath, toFilePath, makeSubPathOf, simpleSubPath, ioAbsolute, ioAbsoluteOrStd, makeAbsolute, makeAbsoluteOrStd, rootDirectory ) import Darcs.Patch.MatchData ( patch_match ) import Darcs.Flags ( DarcsFlag(..), maxCount ) import Darcs.Repository ( slurp_pending, withRepository, ($-) ) import Darcs.Repository.HashedRepo ( slurp_all_but_darcs ) import Darcs.SlurpDirectory ( list_slurpy ) import Darcs.Global ( darcsdir ) import Printer ( Doc, putDocLn, text, vsep, ($$), vcat, insert_before_lastline, prefix ) import URL ( pipeliningEnabledByDefault ) #include "impossible.h" data FlagContent = NoContent | AbsoluteContent AbsolutePath | AbsoluteOrStdContent AbsolutePathOrStd | StringContent String deriving (Eq, Show, Ord) -- getContent is very tedious to write, but this is the only way (that -- I know of) to guarantee that it works for all flags (which then -- guarantees that isAnAbsolute, isa, flagToString, etc also work -- properly) -- | 'get_content' returns the content of a flag, if any. -- For instance, the content of @Author \"Louis Aragon\"@ is @StringContent -- \"Louis Aragon\"@, while the content of @Pipe@ is @NoContent@ getContent :: DarcsFlag -> FlagContent getContent (PatchName s) = StringContent s getContent (Output s) = AbsoluteOrStdContent s getContent Verbose = NoContent getContent Help = NoContent getContent ListOptions = NoContent getContent Test = NoContent getContent NoTest = NoContent getContent OnlyChangesToFiles = NoContent getContent LeaveTestDir = NoContent getContent NoLeaveTestDir = NoContent getContent Timings = NoContent getContent Debug = NoContent getContent DebugVerbose = NoContent getContent DebugHTTP = NoContent getContent NormalVerbosity = NoContent getContent Quiet = NoContent getContent (Target s) = StringContent s getContent (Cc s) = StringContent s getContent (Subject s) = StringContent s getContent (InReplyTo s) = StringContent s getContent (SendmailCmd s) = StringContent s getContent (Author s) = StringContent s getContent (OnePatch s) = StringContent s getContent (SeveralPatch s) = StringContent s getContent (AfterPatch s) = StringContent s getContent (UpToPatch s) = StringContent s getContent (TagName s) = StringContent s getContent (LastN s) = StringContent (show s) getContent (MaxCount s) = StringContent (show s) getContent (OneTag s) = StringContent s getContent (AfterTag s) = StringContent s getContent (UpToTag s) = StringContent s getContent (Context s) = AbsoluteContent s getContent (LogFile s) = AbsoluteContent s getContent (OutputAutoName s) = AbsoluteContent s getContent NumberPatches = NoContent getContent (PatchIndexRange _ _) = NoContent -- FIXME this doesn't fit into a neat category getContent Count = NoContent getContent All = NoContent getContent Recursive = NoContent getContent NoRecursive = NoContent getContent Reorder = NoContent getContent RestrictPaths = NoContent getContent DontRestrictPaths = NoContent getContent AskDeps = NoContent getContent NoAskDeps = NoContent getContent RmLogFile = NoContent getContent (DistName s) = StringContent s getContent (CreatorHash s) = StringContent s getContent (SignAs s) = StringContent s getContent (SignSSL s) = StringContent s getContent (Verify s) = AbsoluteContent s getContent (VerifySSL s) = AbsoluteContent s getContent IgnoreTimes = NoContent getContent LookForAdds = NoContent getContent NoLookForAdds = NoContent getContent AnyOrder = NoContent getContent Intersection = NoContent getContent Unified = NoContent getContent Union = NoContent getContent Complement = NoContent getContent Sign = NoContent getContent NoSign = NoContent getContent HappyForwarding = NoContent getContent SSHControlMaster = NoContent getContent NoSSHControlMaster = NoContent getContent (Toks s) = StringContent s getContent (WorkRepoDir s) = StringContent s getContent (WorkRepoUrl s) = StringContent s getContent (RemoteRepo s) = StringContent s getContent (NewRepo s) = StringContent s getContent (Reply s) = StringContent s getContent EditDescription = NoContent getContent NoEditDescription = NoContent getContent EditLongComment = NoContent getContent NoEditLongComment = NoContent getContent PromptLongComment = NoContent getContent AllowConflicts = NoContent getContent MarkConflicts = NoContent getContent NoAllowConflicts = NoContent getContent Boring = NoContent getContent AllowCaseOnly = NoContent getContent AllowWindowsReserved = NoContent getContent DontGrabDeps = NoContent getContent DontPromptForDependencies = NoContent getContent PromptForDependencies = NoContent getContent Compress = NoContent getContent NoCompress = NoContent getContent UnCompress = NoContent getContent MachineReadable = NoContent getContent HumanReadable = NoContent getContent Pipe = NoContent getContent Interactive = NoContent getContent Summary = NoContent getContent NoSummary = NoContent getContent (ApplyAs s) = StringContent s getContent (DiffCmd s) = StringContent s getContent (ExternalMerge s) = StringContent s getContent (DiffFlags s) = StringContent s getContent (OnePattern _) = NoContent -- FIXME!!! getContent (SeveralPattern _) = NoContent -- FIXME!!! getContent (UpToPattern _) = NoContent -- FIXME!!! getContent (AfterPattern _) = NoContent -- FIXME!!! getContent Reverse = NoContent getContent CheckPoint = NoContent getContent Partial = NoContent getContent Complete = NoContent getContent Lazy = NoContent getContent Ephemeral = NoContent getContent (FixFilePath _ _) = NoContent -- FIXME!!! getContent XMLOutput = NoContent getContent ForceReplace = NoContent getContent NonApply = NoContent getContent NonVerify = NoContent getContent NonForce = NoContent getContent DryRun = NoContent getContent SetDefault = NoContent getContent NoSetDefault = NoContent getContent FancyMoveAdd = NoContent getContent NoFancyMoveAdd = NoContent getContent Disable = NoContent getContent SetScriptsExecutable = NoContent getContent DontSetScriptsExecutable = NoContent getContent UseHashedInventory = NoContent getContent UseOldFashionedInventory = NoContent getContent UseFormat2 = NoContent getContent PristinePlain = NoContent getContent PristineNone = NoContent getContent NoUpdateWorking = NoContent getContent Relink = NoContent getContent RelinkPristine = NoContent getContent NoLinks = NoContent getContent Files = NoContent getContent NoFiles = NoContent getContent Directories = NoContent getContent NoDirectories = NoContent getContent Pending = NoContent getContent NoPending = NoContent getContent NoPosthook = NoContent getContent AskPosthook = NoContent getContent (Sibling s) = AbsoluteContent s getContent (PosthookCmd s) = StringContent s getContent RunPosthook = NoContent getContent NoPrehook = NoContent getContent RunPrehook = NoContent getContent AskPrehook = NoContent getContent StoreInMemory = NoContent getContent HTTPPipelining = NoContent getContent NoHTTPPipelining = NoContent getContent NoCache = NoContent getContent NullFlag = NoContent getContent (PrehookCmd s) = StringContent s getContent (UMask s) = StringContent s getContent AllowUnrelatedRepos = NoContent getContent Check = NoContent getContent Repair = NoContent getContent JustThisRepo = NoContent get_content :: DarcsFlag -> Maybe String get_content f = do StringContent s <- Just $ getContent f return s -- | @a `'isa'` b@ tests whether @a@ is flag @b@ with a string argument. -- @b@ typically is a Flag constructor expecting a string -- For example, @(Author \"Ted Hughes\") `isa` Author@ returns true. isa :: DarcsFlag -> (String -> DarcsFlag) -> Bool a `isa` b = case get_content a of Nothing -> False Just s -> a == b s -- | @a `'isAnAbsolute'` b@ tests whether @a@ is flag @b@ with an absolute path argument. -- @b@ typically is a Flag constructor expecting an absolute path argument -- For example, @(Context contextfile) `isAnAbsolute` Context@ returns true. isAnAbsolute :: DarcsFlag -> (AbsolutePath -> DarcsFlag) -> Bool isAnAbsolute f x = case getContent f of AbsoluteContent s -> f == x s _ -> False -- | @a `'isAnAbsoluteOrStd'` b@ tests whether @a@ is flag @b@ with a path argument. -- @b@ typically is a Flag constructor expecting a path argument -- For example, @(Output o) `isAnAbsoluteOrStd` @ returns true. isAnAbsoluteOrStd :: DarcsFlag -> (AbsolutePathOrStd -> DarcsFlag) -> Bool isAnAbsoluteOrStd f x = case getContent f of AbsoluteOrStdContent s -> f == x s _ -> False isin :: (String->DarcsFlag) -> [DarcsFlag] -> Bool f `isin` fs = any (`isa` f) fs arein :: [DarcsOption] -> [DarcsFlag] -> Bool (DarcsNoArgOption _ _ f _ : dos') `arein` fs = f `elem` fs || dos' `arein` fs (DarcsArgOption _ _ f _ _ : dos') `arein` fs = f `isin` fs || dos' `arein` fs (DarcsAbsPathOption _ _ f _ _ : dos') `arein` fs = any (`isAnAbsolute` f) fs || dos' `arein` fs (DarcsAbsPathOrStdOption _ _ f _ _ : dos') `arein` fs = any (`isAnAbsoluteOrStd` f) fs || dos' `arein` fs (DarcsOptAbsPathOption _ _ _ f _ _ : dos') `arein` fs = any (`isAnAbsolute` f) fs || dos' `arein` fs (DarcsMultipleChoiceOption os: dos') `arein` fs = os `arein` fs || dos' `arein` fs [] `arein` _ = False -- | A type for darcs' options. The value contains the command line -- switch(es) for the option, a help string, and a function to build a -- @DarcsFlag@ from the command line arguments. for each constructor, -- 'shortSwitches' represents the list of short command line switches -- which invoke the option, longSwitches the list of long command line -- switches, optDescr the description of the option, and argDescr the description -- of its argument, if any. mkFlag is a function which makes a @DarcsFlag@ from -- the arguments of the option. data DarcsOption = DarcsArgOption [Char] [String] (String->DarcsFlag) String String -- ^ @DarcsArgOption shortSwitches longSwitches mkFlag ArgDescr OptDescr@ -- The constructor for options with a string argument, such as -- @--tag@ | DarcsAbsPathOption [Char] [String] (AbsolutePath -> DarcsFlag) String String -- ^ @DarcsAbsPathOption shortSwitches longSwitches mkFlag ArgDescr OptDescr@ -- The constructor for options with an absolute path argument, such as -- @--sibling@ | DarcsAbsPathOrStdOption [Char] [String] (AbsolutePathOrStd -> DarcsFlag) String String -- ^ @DarcsAbsPathOrStdOption shortSwitches longSwitches mkFlag ArgDescr OptDescr@ -- The constructor for options with a path argument, such as @-o@ | DarcsOptAbsPathOption [Char] [String] String (AbsolutePath -> DarcsFlag) String String -- ^ @DarcsOptAbsPathOrStdOption shortSwitches longSwitches defaultPath -- mkFlag ArgDescr OptDescr@ where defaultPath is a default value -- for the Path, as a string to be parsed as if it had been given -- on the command line. -- The constructor for options with an optional path argument, such as @-O@ | DarcsNoArgOption [Char] [String] DarcsFlag String -- ^ @DarcsNoArgOption shortSwitches longSwitches mkFlag optDescr@ -- The constructon fon options with no arguments. | DarcsMultipleChoiceOption [DarcsOption] -- ^ A constructor for grouping related options together, such as -- @--hashed@, @--darcs-2@ and @--old-fashioned-inventory@. option_from_darcsoption :: AbsolutePath -> DarcsOption -> [OptDescr DarcsFlag] option_from_darcsoption _ (DarcsNoArgOption a b c h) = [Option a b (NoArg c) h] option_from_darcsoption _ (DarcsArgOption a b c n h) = [Option a b (ReqArg c n) h] option_from_darcsoption wd (DarcsMultipleChoiceOption os) = concatMap (option_from_darcsoption wd) os option_from_darcsoption wd (DarcsAbsPathOrStdOption a b c n h) = [Option a b (ReqArg (c . makeAbsoluteOrStd wd) n) h] option_from_darcsoption wd (DarcsAbsPathOption a b c n h) = [Option a b (ReqArg (c . makeAbsolute wd) n) h] option_from_darcsoption wd (DarcsOptAbsPathOption a b d c n h) = [Option a b (OptArg (c . makeAbsolute wd . fromMaybe d) n) h] -- | 'concat_option' creates a DarcsMultipleChoiceOption from a list of -- option, flattening any DarcsMultipleChoiceOption in the list. concat_options :: [DarcsOption] -> DarcsOption concat_options os = DarcsMultipleChoiceOption $ concatMap from_option os where from_option (DarcsMultipleChoiceOption xs) = xs from_option x = [x] extract_fix_path :: [DarcsFlag] -> Maybe (AbsolutePath, AbsolutePath) extract_fix_path [] = Nothing extract_fix_path ((FixFilePath repo orig):_) = Just (repo, orig) extract_fix_path (_:fs) = extract_fix_path fs fixFilePath :: [DarcsFlag] -> FilePath -> IO AbsolutePath fixFilePath opts f = case extract_fix_path opts of Nothing -> bug "Can't fix path in fixFilePath" Just (_,o) -> withCurrentDirectory o $ ioAbsolute f fixFilePathOrStd :: [DarcsFlag] -> FilePath -> IO AbsolutePathOrStd fixFilePathOrStd opts f = case extract_fix_path opts of Nothing -> bug "Can't fix path in fixFilePathOrStd" Just (_,o) -> withCurrentDirectory o $ ioAbsoluteOrStd f fixUrl :: [DarcsFlag] -> String -> IO String fixUrl opts f = if is_file f then toFilePath `fmap` fixFilePath opts f else return f fixSubPaths :: [DarcsFlag] -> [FilePath] -> IO [SubPath] fixSubPaths flags fs = withCurrentDirectory o $ do fixedfs <- mapM fixit $ filter (not.null) fs let (good, bad) = partitionEither fixedfs unless (null bad) $ putStrLn $ "Ignoring non-repository paths: " ++ unwords bad return $ nub good where (r,o) = case extract_fix_path flags of Just xxx -> xxx Nothing -> bug "Can't fix path in fixSubPaths" fixit p = do ap <- ioAbsolute p case makeSubPathOf r ap of Just sp -> return $ Right sp Nothing -> return $ maybe (Left p) Right $ simpleSubPath p partitionEither :: [Either a b] -> ([b],[a]) partitionEither es = ( [b | Right b <- es] , [a | Left a <- es] ) -- as opposed to just '.' areFileArgs :: [SubPath] -> Bool areFileArgs rps = concatMap toFilePath rps /= "" -- | 'list_option' is an option which lists the command's arguments list_options :: DarcsOption list_options = DarcsNoArgOption [] ["list-options"] ListOptions "simply list the command's arguments" flagToString :: [DarcsOption] -> DarcsFlag -> Maybe String flagToString x f = maybeHead $ catMaybes $ map f2o x where f2o (DarcsArgOption _ (s:_) c _ _) = do arg <- get_content f if c arg == f then return $ unwords [('-':'-':s), arg] else Nothing f2o (DarcsNoArgOption _ (s:_) f' _) | f == f' = Just ('-':'-':s) f2o (DarcsMultipleChoiceOption xs) = maybeHead $ catMaybes $ map f2o xs f2o _ = Nothing maybeHead (a:_) = Just a maybeHead [] = Nothing reponame :: DarcsOption tagname :: DarcsOption deps_sel :: DarcsOption checkpoint :: DarcsOption partial :: DarcsOption partial_check :: DarcsOption tokens :: DarcsOption working_repo_dir :: DarcsOption possibly_remote_repo_dir :: DarcsOption disable :: DarcsOption restrict_paths :: DarcsOption pipe_interactive, all_pipe_interactive, all_interactive, all_patches, interactive, pipe, human_readable, diffflags, allow_problematic_filenames, noskip_boring, ask_long_comment, match_one_nontag, changes_reverse, creatorhash, changes_format, match_one_context, happy_forwarding, send_to_context, diff_cmd_flag, store_in_memory, use_external_merge, pull_conflict_options, target, cc, apply_conflict_options, reply, xmloutput, distname_option, patchname_option, edit_description, output, output_auto_name, unidiff, repo_combinator, unified, summary, uncompress_nocompress, subject, in_reply_to, nocompress, match_several_or_range, match_several_or_last, author, askdeps, lookforadds, ignoretimes, test, notest, help, force_replace, allow_unrelated_repos, match_one, match_range, match_several, fancy_move_add, sendmail_cmd, logfile, rmlogfile, leave_test_dir, from_opt, set_default :: DarcsOption recursive :: String -> DarcsOption sign, applyas, verify :: DarcsOption \end{code} \section{Common options to darcs commands} \begin{options} --help \end{options} Every \verb|COMMAND| accepts \verb!--help! as an argument, which tells it to provide a bit of help. Among other things, this help always provides an accurate listing of the options available with that command, and is guaranteed never to be out of sync with the version of darcs you actually have installed (unlike this manual, which could be for an entirely different version of darcs). \begin{verbatim} % darcs COMMAND --help \end{verbatim} \begin{code} help = DarcsNoArgOption ['h'] ["help"] Help "shows brief description of command and its arguments" \end{code} \begin{options} --disable \end{options} Every {\tt COMMAND} accepts the \verb!--disable! option, which can be used in \verb!_darcs/prefs/defaults! to disable some commands in the repository. This can be helpful if you want to protect the repository from accidental use of advanced commands like obliterate, unpull, unrecord or amend-record. \begin{code} disable = DarcsNoArgOption [] ["disable"] Disable "disable this command" \end{code} \begin{options} --verbose, --quiet, --normal-verbosity \end{options} Most commands also accept the \verb!--verbose! option, which tells darcs to provide additional output. The amount of verbosity varies from command to command. Commands that accept \verb!--verbose\verb! also accept \verb!--quiet\verb!, which surpresses non-error output, and \verb!--normal-verbosity\verb! which can be used to restore the default verbosity if \verb!--verbose! or \verb!--quiet! is in the defaults file. \begin{options} --debug, --debug-http \end{options} Many commands also accept the \verb!--debug! option, which causes darcs to generate additional output that may be useful for debugging its behavior, but which otherwise would not be interesting. Option \verb!--debug-http! makes darcs output debugging info for libcurl. \begin{code} any_verbosity :: [DarcsOption] any_verbosity =[DarcsMultipleChoiceOption [DarcsNoArgOption [] ["debug"] Debug "give only debug output", DarcsNoArgOption [] ["debug-verbose"] DebugVerbose "give debug and verbose output", DarcsNoArgOption [] ["debug-http"] DebugHTTP "give debug output for libcurl", DarcsNoArgOption ['v'] ["verbose"] Verbose "give verbose output", DarcsNoArgOption ['q'] ["quiet"] Quiet "suppress informational output", DarcsNoArgOption [] ["standard-verbosity"] NormalVerbosity "neither verbose nor quiet output"], DarcsNoArgOption [] ["timings"] Timings "provide debugging timings information"] \end{code} \begin{options} --repodir \end{options} Another common option is the \verb!--repodir! option, which allows you to specify the directory of the repository in which to perform the command. This option is used with commands, such as whatsnew, that ordinarily would be performed within a repository directory, and allows you to use those commands without actually being in the repository directory when calling the command. This is useful when running darcs in a pipe, as might be the case when running \verb'apply' from a mailer. \begin{code} working_repo_dir = DarcsArgOption [] ["repodir"] WorkRepoDir "DIRECTORY" "specify the repository directory in which to run" possibly_remote_repo_dir = DarcsArgOption [] ["repo"] WorkRepoUrl "URL" "specify the repository URL" -- | 'get_repourl' takes a list of flags and returns the url of the -- repository specified by @Repodir \"directory\"@ in that list of flags, if any. -- This flag is present if darcs was invoked with @--repodir=DIRECTORY@ get_repourl :: [DarcsFlag] -> Maybe String get_repourl [] = Nothing get_repourl (WorkRepoUrl d:_) | not (is_file d) = Just d get_repourl (_:fs) = get_repourl fs \end{code} \begin{options} --remote-repo \end{options} Some commands, such as \verb'pull' require a remote repository to be specified, either from the command line or as a default. The \verb!--remote-repo! provides an alternative way to supply this remote repository path. This flag can be seen as temporarily ``replacing'' the default repository. Setting it causes the command to ignore the default repository (it also does not affect, i.e. overwrite the default repository). On the other hand, if any other repositories are supplied as command line arguments, this flag will be ignored (and the default repository may be overwritten). \begin{code} -- | 'remote_repo' is the option used to specify the URL of the remote -- repository to work with remote_repo :: DarcsOption remote_repo = DarcsArgOption [] ["remote-repo"] RemoteRepo "URL" "specify the remote repository URL to work with" \end{code} \input{Darcs/Match.lhs} \input{Darcs/Patch/Match.lhs} \begin{code} patchname_option = DarcsArgOption ['m'] ["patch-name"] PatchName "PATCHNAME" "name of patch" send_to_context = DarcsAbsPathOption [] ["context"] Context "FILENAME" "send to context stored in FILENAME" match_one_context = DarcsMultipleChoiceOption [DarcsArgOption [] ["to-match"] mp "PATTERN" "select changes up to a patch matching PATTERN", DarcsArgOption [] ["to-patch"] OnePatch "REGEXP" "select changes up to a patch matching REGEXP", __tag, DarcsAbsPathOption [] ["context"] Context "FILENAME" "version specified by the context in FILENAME" ] where mp s = OnePattern (patch_match s) match_one = concat_options [__match, __patch, __tag, __index] match_one_nontag = concat_options [__match, __patch, __index] match_several = concat_options [__matches, __patches, __tags] match_range = concat_options [match_to, match_from, __match, __patch, __last, __indexes] match_several_or_range = concat_options [match_to, match_from, __last, __indexes, __matches, __patches, __tags] match_several_or_last = concat_options [match_from, __last, __matches, __patches, __tags] match_to, match_from :: DarcsOption match_to = DarcsMultipleChoiceOption [DarcsArgOption [] ["to-match"] uptop "PATTERN" "select changes up to a patch matching PATTERN", DarcsArgOption [] ["to-patch"] UpToPatch "REGEXP" "select changes up to a patch matching REGEXP", DarcsArgOption [] ["to-tag"] UpToTag "REGEXP" "select changes up to a tag matching REGEXP"] where uptop s = UpToPattern (patch_match s) match_from = DarcsMultipleChoiceOption [DarcsArgOption [] ["from-match"] fromp "PATTERN" "select changes starting with a patch matching PATTERN", DarcsArgOption [] ["from-patch"] AfterPatch "REGEXP" "select changes starting with a patch matching REGEXP", DarcsArgOption [] ["from-tag"] AfterTag "REGEXP" "select changes starting with a tag matching REGEXP"] where fromp s = AfterPattern (patch_match s) __tag, __tags, __patch, __patches, __match, __matches, __last, __index, __indexes :: DarcsOption __tag = DarcsArgOption ['t'] ["tag"] OneTag "REGEXP" "select tag matching REGEXP" __tags = DarcsArgOption ['t'] ["tags"] OneTag "REGEXP" "select tags matching REGEXP" __patch = DarcsArgOption ['p'] ["patch"] OnePatch "REGEXP" "select a single patch matching REGEXP" __patches = DarcsArgOption ['p'] ["patches"] SeveralPatch "REGEXP" "select patches matching REGEXP" __match = DarcsArgOption [] ["match"] mp "PATTERN" "select a single patch matching PATTERN" where mp s = OnePattern (patch_match s) __matches = DarcsArgOption [] ["matches"] mp "PATTERN" "select patches matching PATTERN" where mp s = SeveralPattern (patch_match s) __last = DarcsArgOption [] ["last"] lastn "NUMBER" "select the last NUMBER patches" where lastn = LastN . number_string __index = DarcsArgOption ['n'] ["index"] indexrange "N" "select one patch" where indexrange s = if all isDigit s then PatchIndexRange (read s) (read s) else PatchIndexRange 0 0 __indexes = DarcsArgOption ['n'] ["index"] indexrange "N-M" "select a range of patches" where indexrange s = if all isokay s then if '-' `elem` s then let x1 = takeWhile (/= '-') s x2 = reverse $ takeWhile (/= '-') $ reverse s in PatchIndexRange (read x1) (read x2) else PatchIndexRange (read s) (read s) else PatchIndexRange 0 0 isokay c = isDigit c || c == '-' match_maxcount :: DarcsOption match_maxcount = DarcsArgOption [] ["max-count"] mc "NUMBER" "return only NUMBER results" where mc = MaxCount . number_string -- | 'get_context' takes a list of flags and returns the context -- specified by @Context c@ in that list of flags, if any. -- This flag is present if darcs was invoked with @--context=FILE@ get_context :: [DarcsFlag] -> Maybe AbsolutePath get_context xs = listToMaybe [ c | Context c <- xs ] notest = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["no-test"] NoTest "don't run the test script", DarcsNoArgOption [] ["test"] Test "run the test script"] test = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["test"] Test "run the test script", DarcsNoArgOption [] ["no-test"] NoTest "don't run the test script"] leave_test_dir = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["leave-test-directory"] LeaveTestDir "don't remove the test directory", DarcsNoArgOption [] ["remove-test-directory"] NoLeaveTestDir "remove the test directory"] testByDefault :: [DarcsFlag] -> [DarcsFlag] testByDefault o = if NoTest `elem` o then o else Test:o \end{code} \begin{options} --ignore-times \end{options} Darcs optimizes its operations by keeping track of the modification times of your files. This dramatically speeds up commands such as \verb!whatsnew! and \verb!record! which would otherwise require reading every file in the repository and comparing it with a reference version. However, there are times when this can cause problems, such as when running a series of darcs commands from a script, in which case often a file will be modified twice in the same second, which can lead to the second modification going unnoticed. The solution to such predicaments is the \verb!--ignore-times! option, which instructs darcs not to trust the file modification times, but instead to check each file's contents explicitly. \begin{code} ignoretimes = DarcsNoArgOption [] ["ignore-times"] IgnoreTimes "don't trust the file modification times" lookforadds = DarcsMultipleChoiceOption [DarcsNoArgOption ['l'] ["look-for-adds"] LookForAdds "look for (non-boring) files that could be added", DarcsNoArgOption [] ["dont-look-for-adds"] NoLookForAdds "don't look for any files that could be added [DEFAULT]"] fancy_move_add = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["date-trick"] FancyMoveAdd "add files with date appended to avoid conflict [EXPERIMENTAL] ", DarcsNoArgOption [] ["no-date-trick"] NoFancyMoveAdd "don't use experimental date appending trick [DEFAULT]"] askdeps = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["ask-deps"] AskDeps "ask for extra dependencies", DarcsNoArgOption [] ["no-ask-deps"] NoAskDeps "don't ask for extra dependencies"] ask_long_comment = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["edit-long-comment"] EditLongComment "edit the long comment by default", DarcsNoArgOption [] ["skip-long-comment"] NoEditLongComment "don't give a long comment", DarcsNoArgOption [] ["prompt-long-comment"] PromptLongComment "prompt for whether to edit the long comment"] \end{code} \begin{options} --author \end{options} \label{env:DARCS_EMAIL} Several commands need to be able to identify you. Conventionally, you provide an email address for this purpose, which can include comments, e.g.\ \verb!David Roundy !. The easiest way to do this is to define an environment variable \verb!EMAIL! or \verb!DARCS_EMAIL! (with the latter overriding the former). You can also override this using the \verb!--author! flag to any command. Alternatively, you could set your email address on a per-repository basis using the ``defaults'' mechanism for ``ALL'' commands, as described in Appendix~\ref{repository_format}. Or, you could specify the author on a per-repository basis using the \verb!_darcs/prefs/author! file as described in section~\ref{author_prefs}. Also, a global author file can be created in your home directory with the name \verb!.darcs/author!, on MS Windows~\ref{ms_win}. This file overrides the contents of the environment variables, but a repository-specific author file overrides the global author file. \begin{code} logfile = DarcsAbsPathOption [] ["logfile"] LogFile "FILE" "give patch name and comment in file" rmlogfile = DarcsNoArgOption [] ["delete-logfile"] RmLogFile "delete the logfile when done" author = DarcsArgOption ['A'] ["author"] Author "EMAIL" "specify author id" from_opt = DarcsArgOption [] ["from"] Author "EMAIL" "specify email address" -- | 'get_author' takes a list of flags and returns the author of the -- change specified by @Author \"Leo Tolstoy\"@ in that list of flags, if any. -- Otherwise, if @Pipe@ is present, asks the user who is the author and -- returns the answer. If neither are present, try to guess the author, -- from @_darcs/prefs@, and if it's not possible, ask the user. get_author :: [DarcsFlag] -> IO String get_author (Author a:_) = return a get_author (Pipe:_) = do askUser "Who is the author? " get_author (_:flags) = get_author flags get_author [] = do easy_author <- get_easy_author case easy_author of Just a -> return a Nothing -> do aminrepo <- doesDirectoryExist (darcsdir++"/prefs") if aminrepo then do putDocLn $ text "Each patch is attributed to its author, usually by email address (for" $$ text "example, `Fred Bloggs '). Darcs could not determine" $$ text "your email address, so you will be prompted for it." $$ text "" $$ text ("Your address will be stored in " ++ darcsdir ++ "/prefs/author.") $$ text "It will be used for all patches recorded in this repository." $$ text "If you move that file to ~/.darcs/author, it will be used for patches" $$ text "you record in ALL repositories." add <- askUser "What is your email address? " writeFile (darcsdir++"/prefs/author") add return add else askUser "What is your email address (e.g. Fred Bloggs )? " -- | 'get_easy_author' tries to get the author name first from the repository preferences, -- then from global preferences, then from environment variables. Returns 'Nothing' if it -- could not get it. get_easy_author :: IO (Maybe String) get_easy_author = firstJustIO [ firstNotBlank `fmap` get_preflist "author", firstNotBlank `fmap` get_global "author", maybeGetEnv "DARCS_EMAIL", maybeGetEnv "EMAIL" ] \end{code} \begin{options} --dont-compress, --compress \end{options} By default, darcs commands that write patches to disk will compress the patch files. If you don't want this, you can choose the \verb!--dont-compress! option, which causes darcs not to compress the patch file. \begin{code} nocompress = concat_options [__compress, __dont_compress] uncompress_nocompress = concat_options [__compress, __dont_compress, __uncompress] __compress, __dont_compress, __uncompress :: DarcsOption __compress = DarcsNoArgOption [] ["compress"] Compress "create compressed patches" __dont_compress = DarcsNoArgOption [] ["dont-compress"] NoCompress "don't create compressed patches" __uncompress = DarcsNoArgOption [] ["uncompress"] UnCompress "uncompress patches" summary = DarcsMultipleChoiceOption [DarcsNoArgOption ['s'] ["summary"] Summary "summarize changes", DarcsNoArgOption [] ["no-summary"] NoSummary "don't summarize changes"] unified = DarcsNoArgOption ['u'] ["unified"] Unified "output patch in a darcs-specific format similar to diff -u" unidiff = DarcsNoArgOption ['u'] ["unified"] Unified "pass -u option to diff" diff_cmd_flag = DarcsArgOption [] ["diff-command"] DiffCmd "COMMAND" "specify diff command (ignores --diff-opts)" store_in_memory = DarcsNoArgOption [] ["store-in-memory"] StoreInMemory "do patch application in memory rather than on disk" target = DarcsArgOption [] ["to"] Target "EMAIL" "specify destination email" cc = DarcsArgOption [] ["cc"] Cc "EMAIL" "mail results to additional EMAIL(s). Requires --reply" -- |'get_cc' takes a list of flags and returns the addresses to send a copy of -- the patch bundle to when using @darcs send@. -- looks for a cc address specified by @Cc \"address\"@ in that list of flags. -- Returns the addresses as a comma separated string. get_cc :: [DarcsFlag] -> String get_cc fs = lt $ catMaybes $ map whatcc fs where whatcc (Cc t) = Just t whatcc _ = Nothing lt [t] = t lt [t,""] = t lt (t:ts) = t++" , "++lt ts lt [] = "" subject = DarcsArgOption [] ["subject"] Subject "SUBJECT" "specify mail subject" -- |'get_subject' takes a list of flags and returns the subject of the mail -- to be sent by @darcs send@. Looks for a subject specified by -- @Subject \"subject\"@ in that list of flags, if any. -- This flag is present if darcs was invoked with @--subject=SUBJECT@ get_subject :: [DarcsFlag] -> Maybe String get_subject (Subject s:_) = Just s get_subject (_:fs) = get_subject fs get_subject [] = Nothing in_reply_to = DarcsArgOption [] ["in-reply-to"] InReplyTo "EMAIL" "specify in-reply-to header" get_in_reply_to :: [DarcsFlag] -> Maybe String get_in_reply_to (InReplyTo s:_) = Just s get_in_reply_to (_:fs) = get_in_reply_to fs get_in_reply_to [] = Nothing output = DarcsAbsPathOrStdOption ['o'] ["output"] Output "FILE" "specify output filename" output_auto_name = DarcsOptAbsPathOption ['O'] ["output-auto-name"] "." OutputAutoName "DIRECTORY" "output to automatically named file in DIRECTORY, default: current directory" edit_description = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["edit-description"] EditDescription "edit the patch bundle description", DarcsNoArgOption [] ["dont-edit-description"] NoEditDescription "don't edit the patch bundle description"] distname_option = DarcsArgOption ['d'] ["dist-name"] DistName "DISTNAME" "name of version" recursive h = DarcsMultipleChoiceOption [DarcsNoArgOption ['r'] ["recursive"] Recursive h, DarcsNoArgOption [] ["not-recursive"] NoRecursive ("don't "++h)] inventory_choices :: DarcsOption inventory_choices = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["hashed"] UseHashedInventory "Some new features. Compatible with older repos", DarcsNoArgOption [] ["darcs-2"] UseFormat2 "All features. Related repos must use same format [DEFAULT]", DarcsNoArgOption [] ["old-fashioned-inventory"] UseOldFashionedInventory "Minimal features. What older repos use."] get_inventory_choices :: DarcsOption get_inventory_choices = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["hashed"] UseHashedInventory "Convert darcs-1 format to hashed format", DarcsNoArgOption [] ["old-fashioned-inventory"] UseOldFashionedInventory "Convert from hashed to darcs-1 format"] xmloutput = DarcsNoArgOption [] ["xml-output"] XMLOutput "generate XML formatted output" creatorhash = DarcsArgOption [] ["creator-hash"] CreatorHash "HASH" "specify hash of creator patch (see docs)" sign = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["sign"] Sign "sign the patch with your gpg key", DarcsArgOption [] ["sign-as"] SignAs "KEYID" "sign the patch with a given keyid", DarcsArgOption [] ["sign-ssl"] SignSSL "IDFILE" "sign the patch using openssl with a given private key", DarcsNoArgOption [] ["dont-sign"] NoSign "don't sign the patch"] applyas = DarcsMultipleChoiceOption [DarcsArgOption [] ["apply-as"] ApplyAs "USERNAME" "apply patch as another user using sudo", DarcsNoArgOption [] ["apply-as-myself"] NonApply "don't use sudo to apply as another user [DEFAULT]"] happy_forwarding = DarcsNoArgOption [] ["happy-forwarding"] HappyForwarding "forward unsigned messages without extra header" set_default = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["set-default"] SetDefault "set default repository [DEFAULT]", DarcsNoArgOption [] ["no-set-default"] NoSetDefault "don't set default repository"] verify = DarcsMultipleChoiceOption [DarcsAbsPathOption [] ["verify"] Verify "PUBRING" "verify that the patch was signed by a key in PUBRING", DarcsAbsPathOption [] ["verify-ssl"] VerifySSL "KEYS" "verify using openSSL with authorized keys from file KEYS", DarcsNoArgOption [] ["no-verify"] NonVerify "don't verify patch signature"] reponame = DarcsArgOption [] ["repo-name","repodir"] NewRepo "DIRECTORY" "path of output directory" --repodir is there for compatibility --should be removed eventually tagname = DarcsArgOption ['t'] ["tag"] TagName "TAGNAME" "name of version to checkpoint" deps_sel = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["no-deps"] DontGrabDeps "don't automatically fulfill dependencies", DarcsNoArgOption [] ["dont-prompt-for-dependencies"] DontPromptForDependencies "don't ask about patches that are depended on by matched patches (with --match or --patch)", DarcsNoArgOption [] ["prompt-for-dependencies"] PromptForDependencies "prompt about patches that are depended on by matched patches [DEFAULT]"] checkpoint = DarcsNoArgOption [] ["checkpoint"] CheckPoint "create a checkpoint file (see get --partial)" tokens = DarcsArgOption [] ["token-chars"] Toks "\"[CHARS]\"" "define token to contain these characters" partial = concat_options [__partial, __lazy, __ephemeral, __complete] partial_check = concat_options [__complete, __partial] __partial, __lazy, __ephemeral, __complete :: DarcsOption __partial = DarcsNoArgOption [] ["partial"] Partial "get partial repository using checkpoint (old-fashioned format only)" __lazy = DarcsNoArgOption [] ["lazy"] Lazy "get patch files only as needed" __ephemeral = DarcsNoArgOption [] ["ephemeral"] Ephemeral "don't save patch files in the repository" __complete = DarcsNoArgOption [] ["complete"] Complete "get a complete copy of the repository" force_replace = DarcsMultipleChoiceOption [DarcsNoArgOption ['f'] ["force"] ForceReplace "proceed with replace even if 'new' token already exists", DarcsNoArgOption [] ["no-force"] NonForce "don't force the replace if it looks scary"] reply = DarcsArgOption [] ["reply"] Reply "FROM" "reply to email-based patch using FROM address" apply_conflict_options = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["mark-conflicts"] MarkConflicts "mark conflicts", DarcsNoArgOption [] ["allow-conflicts"] AllowConflicts "allow conflicts, but don't mark them", DarcsNoArgOption [] ["no-resolve-conflicts"] NoAllowConflicts "equivalent to --dont-allow-conflicts, for backwards compatibility", DarcsNoArgOption [] ["dont-allow-conflicts"] NoAllowConflicts "fail on patches that create conflicts [DEFAULT]"] pull_conflict_options = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["mark-conflicts"] MarkConflicts "mark conflicts [DEFAULT]", DarcsNoArgOption [] ["allow-conflicts"] AllowConflicts "allow conflicts, but don't mark them", DarcsNoArgOption [] ["dont-allow-conflicts"] NoAllowConflicts "fail on patches that create conflicts"] use_external_merge = DarcsArgOption [] ["external-merge"] ExternalMerge "COMMAND" "use external tool to merge conflicts" \end{code} \begin{options} --dry-run \end{options} The \verb!--dry-run! option will cause darcs not to actually take the specified action, but only print what would have happened. Not all commands accept \verb!--dry-run!, but those that do should accept the \verb!--summary! option. \begin{options} --summary, --no-summary \end{options} The \verb!--summary! option shows a summary of the patches that would have been pulled/pushed/whatever. The format is similar to the output format of \verb!cvs update! and looks like this: \begin{verbatim} A ./added_but_not_recorded.c A! ./added_but_not_recorded_conflicts.c a ./would_be_added_if_look_for_adds_option_was_used.h M ./modified.t -1 +1 M! ./modified_conflicts.t -1 +1 R ./removed_but_not_recorded.c R! ./removed_but_not_recorded_conflicts.c \end{verbatim} You can probably guess what the flags mean from the clever file names. \begin{description} \item{\texttt{A}} is for files that have been added but not recorded yet. \item{\texttt{a}} is for files found using the \verb!--look-for-adds! option available for \verb!whatsnew! and \verb!record!. They have not been added yet, but would be added automatically if \verb!--look-for-adds! were used with the next \verb!record! command. \item{\texttt{M}} is for files that have been modified in the working directory but not recorded yet. The number of added and subtracted lines is also shown. \item{\texttt{R}} is for files that have been removed, but the removal is not recorded yet. \end{description} An exclamation mark appears next to any option that has a conflict. \begin{code} -- NOTE: I'd rather work to have no uses of dry_run_noxml, so that any time -- --dry-run is a possibility, automated users can examine the results more -- easily with --xml. dry_run_noxml :: DarcsOption dry_run_noxml = DarcsNoArgOption [] ["dry-run"] DryRun "don't actually take the action" dry_run :: [DarcsOption] dry_run = [dry_run_noxml, xmloutput] -- | @'showFriendly' flags patch@ returns a 'Doc' representing the right -- way to show @patch@ given the list @flags@ of flags darcs was invoked with. showFriendly :: Patchy p => [DarcsFlag] -> p C(x y) -> Doc showFriendly opts p | Verbose `elem` opts = showNicely p | Summary `elem` opts = Darcs.Patch.summary p | otherwise = description p -- | @'print_dry_run_message_and_exit' action opts patches@ prints a string -- representing the action that would be taken if the @--dry-run@ option -- had not been passed to darcs. Then darcs exits successfully. -- @action@ is the name of the action being taken, like @\"push\"@ -- @opts@ is the list of flags which were sent to darcs -- @patches@ is the sequence of patches which would be touched by @action@. print_dry_run_message_and_exit :: RepoPatch p => String -> [DarcsFlag] -> FL (PatchInfoAnd p) C(x y) -> IO () print_dry_run_message_and_exit action opts patches = do when (DryRun `elem` opts) $ do putInfo $ text $ "Would " ++ action ++ " the following changes:" putDocLn $ put_mode putInfo $ text $ "" putInfo $ text $ "Making no changes: this is a dry run." exitWith ExitSuccess when (All `elem` opts && Summary `elem` opts) $ do putInfo $ text $ "Will " ++ action ++ " the following changes:" putDocLn $ put_mode where put_mode = if XMLOutput `elem` opts then (text "" $$ vcat (mapFL (indent . xml_info) patches) $$ text "") else (vsep $ mapFL (showFriendly opts) patches) putInfo = if XMLOutput `elem` opts then \_ -> return () else putDocLn xml_info pl | Summary `elem` opts = xml_with_summary pl | otherwise = (to_xml . info) pl xml_with_summary hp | Just p <- hopefullyM hp = insert_before_lastline (to_xml $ info hp) (indent $ xml_summary p) xml_with_summary hp = to_xml (info hp) indent = prefix " " \end{code} \input{Darcs/Resolution.lhs} \begin{code} noskip_boring = DarcsNoArgOption [] ["boring"] Boring "don't skip boring files" allow_problematic_filenames = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["case-ok"] AllowCaseOnly "don't refuse to add files differing only in case" ,DarcsNoArgOption [] ["reserved-ok"] AllowWindowsReserved "don't refuse to add files with Windows-reserved names" ] diffflags = DarcsArgOption [] ["diff-opts"] DiffFlags "OPTIONS" "options to pass to diff" changes_format = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["context"] (Context rootDirectory) "give output suitable for get --context", xmloutput, human_readable, DarcsNoArgOption [] ["number"] NumberPatches "number the changes", DarcsNoArgOption [] ["count"] Count "output count of changes" ] changes_reverse = DarcsNoArgOption [] ["reverse"] Reverse "show changes in reverse order" only_to_files :: DarcsOption only_to_files = DarcsNoArgOption [] ["only-to-files"] OnlyChangesToFiles "show only changes to specified files" human_readable = DarcsNoArgOption [] ["human-readable"] HumanReadable "give human-readable output" pipe = DarcsNoArgOption [] ["pipe"] Pipe "ask user interactively for the patch metadata" interactive = DarcsNoArgOption ['i'] ["interactive"] Interactive "prompt user interactively" all_patches = DarcsNoArgOption ['a'] ["all"] All "answer yes to all patches" all_interactive = DarcsMultipleChoiceOption [all_patches, interactive] all_pipe_interactive = DarcsMultipleChoiceOption [all_patches,pipe,interactive] pipe_interactive = DarcsMultipleChoiceOption [pipe, interactive] repo_combinator = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["intersection"] Intersection "take intersection of all repositories", DarcsNoArgOption [] ["union"] Union "take union of all repositories [DEFAULT]", DarcsNoArgOption [] ["complement"] Complement "take complement of repositories (in order listed)"] -- | 'list_files' returns the list of all non-boring files in the repository list_files :: IO [String] list_files = do s <- slurp_all_but_darcs "." skip_boring <- boring_file_filter return (map drop_dotslash $ skip_boring $ list_slurpy s) drop_dotslash :: String -> String drop_dotslash ('.':'/':x) = drop_dotslash x drop_dotslash x = x -- | 'list_unregistered_files' returns the list of all non-boring unregistered -- files in the repository. list_unregistered_files :: IO [String] list_unregistered_files = withRepository [] $- \repository -> do s <- slurp_all_but_darcs "." skip_boring <- boring_file_filter regs <- slurp_pending repository return $ map drop_dotslash $ (skip_boring $ list_slurpy s) \\ (list_slurpy regs) -- | 'list_registered_files' returns the list of all registered files in the repository. list_registered_files :: IO [String] list_registered_files = (map drop_dotslash . list_slurpy) `fmap` (withRepository [] slurp_pending) options_latex :: [DarcsOption] -> String options_latex opts = "\\begin{tabular}{lll}\n"++ unlines (map option_latex opts)++ "\\end{tabular}\n" latex_help :: String -> String latex_help h = "\\begin{minipage}{7cm}\n\\raggedright\n" ++ h ++ "\\end{minipage}\n" option_latex :: DarcsOption -> String option_latex (DarcsNoArgOption a b _ h) = show_short_options a ++ show_long_options b ++ latex_help h ++ "\\\\" option_latex (DarcsArgOption a b _ arg h) = show_short_options a ++ show_long_options (map (++(" "++arg)) b) ++ latex_help h ++ "\\\\" option_latex (DarcsAbsPathOrStdOption a b _ arg h) = show_short_options a ++ show_long_options (map (++(" "++arg)) b) ++ latex_help h ++ "\\\\" option_latex (DarcsAbsPathOption a b _ arg h) = show_short_options a ++ show_long_options (map (++(" "++arg)) b) ++ latex_help h ++ "\\\\" option_latex (DarcsOptAbsPathOption a b _ _ arg h) = show_short_options a ++ show_long_options (map (++("[="++arg++"]")) b) ++ latex_help h ++ "\\\\" option_latex (DarcsMultipleChoiceOption os) = unlines (map option_latex os) show_short_options :: [Char] -> String show_short_options [] = "&" show_short_options [c] = "\\verb!-"++[c]++"! &" show_short_options (c:cs) = "\\verb!-"++[c]++"!,"++show_short_options cs show_long_options :: [String] -> String show_long_options [] = " &" show_long_options [s] = "\\verb!--" ++ s ++ "! &" show_long_options (s:ss) = "\\verb!--" ++ s ++ "!,"++ show_long_options ss set_scripts_executable :: DarcsOption set_scripts_executable = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["set-scripts-executable"] SetScriptsExecutable "make scripts executable", DarcsNoArgOption [] ["dont-set-scripts-executable"] DontSetScriptsExecutable "don't make scripts executable"] relink, relink_pristine, sibling :: DarcsOption relink = DarcsNoArgOption [] ["relink"] Relink "relink random internal data to a sibling" relink_pristine = DarcsNoArgOption [] ["relink-pristine"] RelinkPristine "relink pristine tree (not recommended)" sibling = DarcsAbsPathOption [] ["sibling"] Sibling "URL" "specify a sibling directory" -- | 'flagsToSiblings' collects the contents of all @Sibling@ flags in a list of flags. flagsToSiblings :: [DarcsFlag] -> [AbsolutePath] flagsToSiblings ((Sibling s) : l) = s : (flagsToSiblings l) flagsToSiblings (_ : l) = flagsToSiblings l flagsToSiblings [] = [] nolinks :: DarcsOption nolinks = DarcsNoArgOption [] ["nolinks"] NoLinks "do not link repository or pristine to sibling" reorder_patches :: DarcsOption reorder_patches = DarcsNoArgOption [] ["reorder-patches"] Reorder "reorder the patches in the repository" \end{code} \begin{options} --sendmail-command \end{options} \darcsEnv{SENDMAIL} \begin{code} sendmail_cmd = DarcsArgOption [] ["sendmail-command"] SendmailCmd "COMMAND" "specify sendmail command" environmentHelpSendmail :: ([String], [String]) environmentHelpSendmail = (["SENDMAIL"], [ "On Unix, the `darcs send' command relies on sendmail(8). The", "`--sendmail-command' or $SENDMAIL environment variable can be used to", "provide an explicit path to this program; otherwise the standard", "locations /usr/sbin/sendmail and /usr/lib/sendmail will be tried."]) -- FIXME: mention the following also: -- * sendmail(8) is not sendmail-specific; -- * nowadays, desktops often have no MTA or an unconfigured MTA -- -- which is awful, because it accepts mail but doesn't relay it; -- * in this case, can be a sendmail(8)-emulating wrapper on top of an -- MUA that sends mail directly to a smarthost; and -- * on a multi-user system without an MTA and on which you haven't -- got root, can be msmtp. -- |'get_sendmail_cmd' takes a list of flags and returns the sendmail command -- to be used by @darcs send@. Looks for a command specified by -- @SendmailCmd \"command\"@ in that list of flags, if any. -- This flag is present if darcs was invoked with @--sendmail-command=COMMAND@ -- Alternatively the user can set @$S@@ENDMAIL@ which will be used as a fallback if present. get_sendmail_cmd :: [DarcsFlag] -> IO String get_sendmail_cmd (SendmailCmd a:_) = return a get_sendmail_cmd (_:flags) = get_sendmail_cmd flags get_sendmail_cmd [] = do easy_sendmail <- firstJustIO [ maybeGetEnv "SENDMAIL" ] case easy_sendmail of Just a -> return a Nothing -> return "" files :: DarcsOption files = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["files"] Files "include files in output [DEFAULT]", DarcsNoArgOption [] ["no-files"] NoFiles "don't include files in output"] directories :: DarcsOption directories = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["directories"] Directories "include directories in output [DEFAULT]", DarcsNoArgOption [] ["no-directories"] NoDirectories "don't include directories in output"] pending :: DarcsOption pending = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["pending"] Pending "reflect pending patches in output [DEFAULT]", DarcsNoArgOption [] ["no-pending"] NoPending "only included recorded patches in output"] nullFlag :: DarcsOption -- "null" is already taken nullFlag = DarcsNoArgOption ['0'] ["null"] NullFlag "separate file names by NUL characters" \end{code} \begin{options} --posthook=COMMAND, --no-posthook \end{options} To provide a command that should be run whenever a darcs command completes successfully, use \verb!--posthook! to specify the command. This is useful for people who want to have a command run whenever a patch is applied. Using \verb!--no-posthook! will disable running the command. \begin{options} --run-posthook, --prompt-posthook \end{options} These options control prompting before running the posthook. Use \verb!--prompt-posthook! to have darcs prompt before running the posthook command. You may use --run-posthook to reenable the default behavior of running user-specified posthooks. Some darcs commands export to the posthook command information about the changes being made. In particular, three environment variables are defined. \verb!DARCS_PATCHES! contains a human-readable summary of the patches being acted upon. The format is the same as "darcs changes". \verb!DARCS_PATCHES_XML! Contains the same details, in the same XML format as "darcs changes". Finally, \verb!DARCS_FILES! contains a list of the files affected, one file per line. If your repository has filenames including newlines, you'll just have to cope. Note, however, that \emph{none} of these environment variables are defined when running under windows. Note also that we refuse to pass environment variables greater in size than 10k, in order to avoid triggering \verb!E2BIG! errors. \begin{code} definePatches :: RepoPatch p => FL (PatchInfoAnd p) C(x y) -> IO () #ifndef WIN32 definePatches ps = do let k = "Defining environment variables" beginTedious k tediousSize k 3 finishedOneIO k "DARCS_PATCHES" setEnvCautiously "DARCS_PATCHES" (renderString $ Darcs.Patch.summary ps) finishedOneIO k "DARCS_PATCHES_XML" setEnvCautiously "DARCS_PATCHES_XML" (renderString $ text "" $$ vcat (mapFL (to_xml . info) ps) $$ text "") finishedOneIO k "DARCS_FILES" setEnvCautiously "DARCS_FILES" (unlines$ list_touched_files ps) endTedious k setEnvCautiously :: String -> String -> IO () setEnvCautiously e v | toobig (10*1024) v = return () | otherwise = setEnv e v True where toobig :: Int -> [a] -> Bool toobig 0 _ = True toobig _ [] = False toobig n (_:xs) = toobig (n-1) xs #else definePatches _ = return () #endif defineChanges :: Patchy p => p C(x y) -> IO () #ifndef WIN32 defineChanges ps = setEnvCautiously "DARCS_FILES" (unlines $ list_touched_files ps) #else defineChanges _ = return () #endif posthook_cmd :: DarcsOption posthook_cmd = DarcsMultipleChoiceOption [DarcsArgOption [] ["posthook"] PosthookCmd "COMMAND" "specify command to run after this darcs command", DarcsNoArgOption [] ["no-posthook"] NoPosthook "don't run posthook command"] posthook_prompt :: DarcsOption posthook_prompt = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["prompt-posthook"] AskPosthook "prompt before running posthook [DEFAULT]", DarcsNoArgOption [] ["run-posthook"] RunPosthook "run posthook command without prompting"] -- | 'get_posthook_cmd' takes a list of flags and returns the posthook command -- specified by @PosthookCmd a@ in that list of flags, if any. get_posthook_cmd :: [DarcsFlag] -> Maybe String get_posthook_cmd (PosthookCmd a:_) = Just a get_posthook_cmd (_:flags) = get_posthook_cmd flags get_posthook_cmd [] = Nothing \end{code} \begin{options} --prehook=COMMAND, --no-prehook \end{options} To provide a command that should be run before a darcs command is executed, use \verb!--prehook! to specify the command. An example use is for people who want to have a command run whenever a patch is to be recorded, such as translating line endings before recording patches. Using \verb!--no-prehook! will disable running the command. \begin{options} --run-prehook, --prompt-prehook \end{options} These options control prompting before running the prehook. See the posthook documentation above for details. \begin{code} prehook_cmd :: DarcsOption prehook_cmd = DarcsMultipleChoiceOption [DarcsArgOption [] ["prehook"] PrehookCmd "COMMAND" "specify command to run before this darcs command", DarcsNoArgOption [] ["no-prehook"] NoPrehook "don't run prehook command"] prehook_prompt :: DarcsOption prehook_prompt = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["prompt-prehook"] AskPrehook "prompt before running prehook [DEFAULT]", DarcsNoArgOption [] ["run-prehook"] RunPrehook "run prehook command without prompting"] -- | 'get_prehook_cmd' takes a list of flags and returns the prehook command -- specified by @PrehookCmd a@ in that list of flags, if any. get_prehook_cmd :: [DarcsFlag] -> Maybe String get_prehook_cmd (PrehookCmd a:_) = Just a get_prehook_cmd (_:flags) = get_prehook_cmd flags get_prehook_cmd [] = Nothing \end{code} \begin{options} --ssh-cm, --no-ssh-cm \end{options} For commands which invoke ssh, darcs will normally multiplex ssh sessions over a single connection as long as your version of ssh has the ControlMaster feature from OpenSSH versions 3.9 and above. This option will avoid darcs trying to use this feature even if your ssh supports it. \begin{options} --http-pipelining, --no-http-pipelining \end{options} When compiled with libcurl (version 7.18.0 and above), darcs can use HTTP pipelining. It is enabled by default for libcurl (version 7.19.1 and above). This option will make darcs enable or disable HTTP pipelining, overwriting default. Note that if HTTP pipelining is really used depends on the server. \begin{options} --no-cache \end{options} Do not use patch caches. \begin{code} network_options :: [DarcsOption] network_options = [DarcsMultipleChoiceOption [DarcsNoArgOption [] ["ssh-cm"] SSHControlMaster "use SSH ControlMaster feature", DarcsNoArgOption [] ["no-ssh-cm"] NoSSHControlMaster "don't use SSH ControlMaster feature [DEFAULT]"], DarcsMultipleChoiceOption [DarcsNoArgOption [] ["http-pipelining"] HTTPPipelining pipelining_description, DarcsNoArgOption [] ["no-http-pipelining"] NoHTTPPipelining no_pipelining_description], no_cache ] where pipelining_description = "enable HTTP pipelining"++ (if pipeliningEnabledByDefault then " [DEFAULT]" else "") no_pipelining_description = "disable HTTP pipelining"++ (if pipeliningEnabledByDefault then "" else " [DEFAULT]") no_cache :: DarcsOption no_cache = DarcsNoArgOption [] ["no-cache"] NoCache "don't use patch caches" \end{code} \begin{options} --umask \end{options} By default, Darcs will use your current umask. The option \verb|--umask| will cause Darcs to switch to a different umask before writing to the repository. \begin{code} umask_option :: DarcsOption umask_option = DarcsArgOption [] ["umask"] UMask "UMASK" "specify umask to use when writing" \end{code} \begin{options} --dont-restrict-paths, --restrict-paths \end{options} By default darcs is only allowed to manage and modify files and directories contained inside the current repository and not being part of any darcs repository's meta data (including the current one). This is mainly for security, to protect you from spoofed patches modifying arbitrary files with sensitive data---say, in your home directory---or tampering with any repository's meta data to switch off this safety guard. But sometimes you may want to manage a group of ``sub'' repositories' preference files with a global repository, or use darcs in some other advanced way. The best way is probably to put \verb!ALL dont-restrict-paths! in \verb!_darcs/prefs/defaults!. This turns off all sanity checking for file paths in patches. Path checking can be temporarily turned on with \verb!--restrict-paths! on the command line, when pulling or applying unknown patches. \begin{code} restrict_paths = DarcsMultipleChoiceOption [DarcsNoArgOption [] ["restrict-paths"] RestrictPaths "don't allow darcs to touch external files or repo metadata", DarcsNoArgOption [] ["dont-restrict-paths"] DontRestrictPaths "allow darcs to modify any file or directory (unsafe)"] \end{code} \begin{options} --allow-unrelated-repos \end{options} By default darcs checks and warns user if repositories are unrelated when doing pull, push and send. This option makes darcs skip this check. \begin{code} allow_unrelated_repos = DarcsNoArgOption [] ["ignore-unrelated-repos"] AllowUnrelatedRepos "do not check if repositories are unrelated" \end{code} \begin{code} just_this_repo :: DarcsOption \end{code} \begin{options} --just-this-repo \end{options} This option limits the check or repair to the current repo and omits any caches or other repos listed as a source of patches. \begin{code} just_this_repo = DarcsNoArgOption [] ["just-this-repo"] JustThisRepo "Limit the check or repair to the current repo" \end{code} \begin{code} check, repair, check_or_repair :: DarcsOption \end{code} \begin{options} --check \end{options} This option specifies checking mode. \begin{code} check = DarcsNoArgOption [] ["check"] Check "Specify checking mode" \end{code} \begin{options} --repair \end{options} This option specifies repair mode. \begin{code} repair = DarcsNoArgOption [] ["repair"] Repair "Specify repair mode" check_or_repair = concat_options [check, repair] -- | @'patch_select_flag' f@ holds whenever @f@ is a way of selecting -- patches such as @PatchName n@. patch_select_flag :: DarcsFlag -> Bool patch_select_flag All = True patch_select_flag (PatchName _) = True patch_select_flag (OnePatch _) = True patch_select_flag (SeveralPatch _) = True patch_select_flag (AfterPatch _) = True patch_select_flag (UpToPatch _) = True patch_select_flag (TagName _) = True patch_select_flag (LastN _) = True patch_select_flag (OneTag _) = True patch_select_flag (AfterTag _) = True patch_select_flag (UpToTag _) = True patch_select_flag (OnePattern _) = True patch_select_flag (SeveralPattern _) = True patch_select_flag (AfterPattern _) = True patch_select_flag (UpToPattern _) = True patch_select_flag _ = False -- | The integer corresponding to a string, if it's only composed of digits. -- Otherwise, -1. number_string :: String -> Int number_string s = if and (map isDigit s) then read s else (-1) \end{code}