%  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,
                         isin, arein,
                         definePatches, defineChanges,
                         fixFilePathOrStd, fixUrl,
                         fixSubPaths, areFileArgs,
                         DarcsOption( .. ), option_from_darcsoption,
                         help, list_options, list_files,
                         help_on_match,
                         any_verbosity, disable,
                         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,
                         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,
                         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,
                         allow_unrelated_repos
                      ) 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 )
import Darcs.Patch ( RepoPatch, Patchy, showNicely, description )
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(..) )
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 )
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 HelpOnMatch = 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 (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

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

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,
  help_on_match, 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"

help_on_match = DarcsNoArgOption [] ["match"] HelpOnMatch
       "shows a summary of how to use patch matching rules"
\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 curl and libwww.
\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 curl and libwww",
                 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 s = if and (map isDigit s)
                    then LastN (read s)
                    else LastN (-1)

__index = DarcsArgOption ['n'] ["index"] indexrange "N-M" "select a range of patches"
    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 == '-'

-- | '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 <droundy@abridgegame.org>!.  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!.  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
          putStr "Darcs needs to know what name (conventionally an email "
          putStr "address) to use as the\npatch author, e.g. 'Fred Bloggs "
          putStr "<fred@bloggs.invalid>'.  If you provide one\nnow "
          putStr ("it will be stored in the file '"++darcsdir++"/prefs/author' and ")
          putStr "used as a default\nin the future.  To change your preferred "
          putStr "author address, simply delete or edit\nthis file.\n\n"
          add <- askUser "What is your email address? "
          writeFile (darcsdir++"/prefs/author") add
          return add
        else do askUser "What is your email address (e.g. John Doe <a@b.com>)? "

-- | '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 = if Verbose `elem` opts
                      then showNicely p
                      else if Summary `elem` opts
                           then Darcs.Patch.summary p
                           else 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 "<patches>" $$
                            vcat (mapFL (to_xml . info) patches) $$
                            text "</patches>")
                      else (vsep $ mapFL (showFriendly opts) patches)
           putInfo = if XMLOutput `elem` opts then \_ -> return () else putDocLn

\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}

\label{env:SENDMAIL}

Several commands send email. The user can determine which mta to
use with the \verb!--sendmail-command! switch. For repetitive usage
of a specific sendmail command it is also possible to set the
environment variable \verb!SENDMAIL!. If there is no command line
switch given \verb!SENDMAIL! will be used if present.

\begin{code}
sendmail_cmd = DarcsArgOption [] ["sendmail-command"] SendmailCmd "COMMAND" "specify sendmail command"

-- |'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 @$SENDMAIL@ 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 "<patches>" $$
                                                 vcat (mapFL (to_xml . info) ps) $$
                                                 text "</patches>")
                      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 libwww or curl (version 7.18.0 and above), darcs can
use HTTP pipelining. It is enabled by default for libwww and curl
(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],
     DarcsNoArgOption [] ["no-cache"] NoCache
                          "don't use patch caches"]
    where pipelining_description =
              "enable HTTP pipelining"++
              (if pipeliningEnabledByDefault then " [DEFAULT]" else "")
          no_pipelining_description =
              "disable HTTP pipelining"++
              (if pipeliningEnabledByDefault then "" else " [DEFAULT]")
\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}
--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"

-- | @'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
\end{code}