{-# OPTIONS_GHC -cpp -XPatternGuards #-}
{-# LANGUAGE CPP, PatternGuards #-}

#include "gadts.h"

module Darcs.Arguments ( DarcsFlag( .. ), flagToString,
                         maxCount,
                         isin, arein,
                         definePatches, defineChanges,
                         fixFilePathOrStd, fixUrl,
                         fixSubPaths, areFileArgs,
                         DarcsOption( .. ), optionFromDarcsoption,
                         help, listOptions, listFiles,
                         anyVerbosity, disable, restrictPaths,
                         notest, test, workingRepoDir,
                         testByDefault,
                         remoteRepo,
                         leaveTestDir,
                         possiblyRemoteRepoDir, getRepourl,
                         listRegisteredFiles, listUnregisteredFiles,
                         author, getAuthor, getEasyAuthor, getSendmailCmd,
                         fileHelpAuthor, environmentHelpEmail,
                         patchnameOption, distnameOption,
                         logfile, rmlogfile, fromOpt, subject, getSubject,
                         inReplyTo, getInReplyTo,
                         target, ccSend, ccApply, getCc, output, outputAutoName,
                         recursive, inventoryChoices, getInventoryChoices,
                         upgradeFormat,
                         askdeps, ignoretimes, lookforadds,
                         askLongComment, sendmailCmd,
                         environmentHelpSendmail,
                         sign, verify, editDescription,
                         reponame, creatorhash,
                         applyConflictOptions, reply,
                         pullConflictOptions, useExternalMerge,
                         depsSel, nocompress,
                         uncompressNocompress, repoCombinator,
                         optionsLatex, reorderPatches,
                         noskipBoring, allowProblematicFilenames,
                         applyas, humanReadable,
                         changesReverse, onlyToFiles,
                         changesFormat, matchOneContext, matchOneNontag,
                         matchMaxcount,
                         sendToContext,
                         getContext,
                         pipeInteractive, allInteractive,
                         allPipeInteractive,
                         summary, unified, tokens,
                         partial, partialCheck,
                         diffCmdFlag, diffflags, unidiff, xmloutput,
                         forceReplace, dryRun, dryRunNoxml,
                         printDryRunMessageAndExit, showFriendly,
                         matchOne, matchSeveral, matchRange,
                         matchSeveralOrRange, happyForwarding,
                         matchSeveralOrLast,
                         setDefault,
                         fancyMoveAdd,
                         setScriptsExecutableOption,
                         sibling, flagsToSiblings, relink, relinkPristine, nolinks,
                         files, directories, pending,
                         posthookCmd, posthookPrompt,
                         getPosthookCmd,
                         prehookCmd, prehookPrompt,
                         getPrehookCmd, nullFlag,
                         umaskOption,
                         storeInMemory,
                         patchSelectFlag,
                         networkOptions, noCache,
                         allowUnrelatedRepos,
                         checkOrRepair, justThisRepo, optimizePristine
                      ) where
import System.Console.GetOpt
import System.Directory ( doesDirectoryExist )

import Storage.Hashed.AnchoredPath( anchorPath )
import Storage.Hashed.Plain( readPlainTree )
import Storage.Hashed.Tree( list, expand, emptyTree )

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 Control.Applicative( (<$>) )
import Data.Char ( isDigit )
#ifndef WIN32
import Printer ( renderString )
import System.Posix.Env ( setEnv )
import Darcs.Patch ( listTouchedFiles )
import Progress ( beginTedious, endTedious, tediousSize, finishedOneIO )
#endif

import Darcs.Hopefully ( PatchInfoAnd, info, hopefullyM )
import Darcs.Patch ( RepoPatch, Patchy, showNicely, description, xmlSummary )
import Darcs.Patch.Info ( to_xml )
import Darcs.Witnesses.Ordered ( FL, mapFL )
import qualified Darcs.Patch ( summary )
import Darcs.Utils ( askUser, maybeGetEnv, firstNotBlank, firstJustIO,
                     withCurrentDirectory )
import Darcs.Repository.Prefs ( getPreflist, getGlobal )
import Darcs.Repository.State ( restrictBoring, readRecordedAndPending )
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 ( withRepository )
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)

-- | 'getContentString' 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 ChangesToAllFiles = 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 DontRmLogFile = 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 DontIgnoreTimes = NoContent
getContent LookForAdds = NoContent
getContent NoLookForAdds = NoContent
getContent AnyOrder = NoContent
getContent Intersection = NoContent
getContent Unified = NoContent
getContent NonUnified = NoContent
getContent Union = NoContent
getContent Complement = NoContent
getContent Sign = NoContent
getContent NoSign = NoContent
getContent HappyForwarding = NoContent
getContent NoHappyForwarding = NoContent
getContent SSHControlMaster = NoContent
getContent NoSSHControlMaster = NoContent
getContent (RemoteDarcs s) = StringContent s
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 SkipConflicts = NoContent
getContent Boring = NoContent
getContent SkipBoring = NoContent
getContent AllowCaseOnly = NoContent
getContent DontAllowCaseOnly = NoContent
getContent AllowWindowsReserved = NoContent
getContent DontAllowWindowsReserved = 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 Forward = 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 UpgradeFormat = 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 ApplyOnDisk = 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
getContent OptimizePristine = NoContent

getContentString :: DarcsFlag -> Maybe String
getContentString 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 getContentString 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@.

optionFromDarcsoption :: AbsolutePath -> DarcsOption -> [OptDescr DarcsFlag]
optionFromDarcsoption _ (DarcsNoArgOption a b c h) = [Option a b (NoArg c) h]
optionFromDarcsoption _ (DarcsArgOption a b c n h) = [Option a b (ReqArg c n) h]
optionFromDarcsoption wd (DarcsMultipleChoiceOption os) = concatMap (optionFromDarcsoption wd) os
optionFromDarcsoption wd (DarcsAbsPathOrStdOption a b c n h) = [Option a b (ReqArg (c . makeAbsoluteOrStd wd) n) h]
optionFromDarcsoption wd (DarcsAbsPathOption a b c n h) = [Option a b (ReqArg (c . makeAbsolute wd) n) h]
optionFromDarcsoption 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.
concatOptions :: [DarcsOption] -> DarcsOption
concatOptions os = DarcsMultipleChoiceOption $ concatMap from_option os
 where
  from_option (DarcsMultipleChoiceOption xs) = xs
  from_option x = [x]

extractFixPath :: [DarcsFlag] -> Maybe (AbsolutePath, AbsolutePath)
extractFixPath [] = Nothing
extractFixPath ((FixFilePath repo orig):_)  = Just (repo, orig)
extractFixPath (_:fs) = extractFixPath fs

fixFilePath :: [DarcsFlag] -> FilePath -> IO AbsolutePath
fixFilePath opts f = case extractFixPath 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 extractFixPath 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 extractFixPath 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
listOptions :: DarcsOption
listOptions = 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 <- getContentString 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
depsSel :: DarcsOption
partial :: DarcsOption
partialCheck :: DarcsOption
tokens :: DarcsOption
workingRepoDir :: DarcsOption
possiblyRemoteRepoDir :: DarcsOption
disable :: DarcsOption
restrictPaths :: DarcsOption

pipeInteractive, allPipeInteractive, allInteractive, all_patches, interactive, pipe,
  humanReadable, diffflags, allowProblematicFilenames, noskipBoring,
  askLongComment, matchOneNontag, changesReverse, creatorhash,
  changesFormat, matchOneContext, happyForwarding, sendToContext,
  diffCmdFlag, storeInMemory, useExternalMerge,
  pullConflictOptions, target, ccSend, ccApply, applyConflictOptions, reply, xmloutput,
  distnameOption, patchnameOption, editDescription,
  output, outputAutoName, unidiff, repoCombinator,
  unified, summary, uncompressNocompress, subject, inReplyTo,
  nocompress, matchSeveralOrRange, matchSeveralOrLast,
  author, askdeps, lookforadds, ignoretimes, test, notest, help, forceReplace,
  allowUnrelatedRepos,
  matchOne, matchRange, matchSeveral, fancyMoveAdd, sendmailCmd,
  logfile, rmlogfile, leaveTestDir, fromOpt, setDefault

      :: DarcsOption

recursive :: String -> DarcsOption

sign, applyas, verify :: DarcsOption

help = DarcsNoArgOption ['h'] ["help"] Help
       "shows brief description of command and its arguments"

disable = DarcsNoArgOption [] ["disable"] Disable
        "disable this command"

anyVerbosity :: [DarcsOption]
anyVerbosity =[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"]

workingRepoDir = DarcsArgOption [] ["repodir"] WorkRepoDir "DIRECTORY"
             "specify the repository directory in which to run"
possiblyRemoteRepoDir = DarcsArgOption [] ["repo"] WorkRepoUrl "URL"
             "specify the repository URL"

-- | 'getRepourl' 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@
getRepourl :: [DarcsFlag] -> Maybe String
getRepourl [] = Nothing
getRepourl (WorkRepoUrl d:_) | not (is_file d) = Just d
getRepourl (_:fs) = getRepourl fs

-- | 'remoteRepo' is the option used to specify the URL of the remote
-- repository to work with
remoteRepo :: DarcsOption
remoteRepo = DarcsArgOption [] ["remote-repo"] RemoteRepo "URL"
             "specify the remote repository URL to work with"

patchnameOption = DarcsArgOption ['m'] ["patch-name"] PatchName "PATCHNAME"
                   "name of patch"

sendToContext = DarcsAbsPathOption [] ["context"] Context "FILENAME"
                  "send to context stored in FILENAME"

matchOneContext =
    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)

matchOne = concatOptions [__match, __patch, __tag, __index]
matchOneNontag = concatOptions [__match, __patch, __index]
matchSeveral    = concatOptions [__matches, __patches, __tags]
matchRange            = concatOptions [matchTo, matchFrom, __match, __patch, __last, __indexes]
matchSeveralOrRange = concatOptions [matchTo, matchFrom, __last, __indexes,
                                         __matches, __patches, __tags]
matchSeveralOrLast  = concatOptions [matchFrom, __last, __matches, __patches, __tags]

matchTo, matchFrom :: DarcsOption
matchTo = 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)
matchFrom = 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 . numberString

__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 == '-'

matchMaxcount :: DarcsOption
matchMaxcount = DarcsArgOption [] ["max-count"] mc "NUMBER"
         "return only NUMBER results"
    where mc = MaxCount . numberString


-- | 'getContext' 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@
getContext :: [DarcsFlag] -> Maybe AbsolutePath
getContext 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"]
leaveTestDir = 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

ignoretimes = 
    DarcsMultipleChoiceOption
    [DarcsNoArgOption [] ["ignore-times"] IgnoreTimes
                         "don't trust the file modification times"
    ,DarcsNoArgOption [] ["no-ignore-times"] DontIgnoreTimes
                      "trust modification times to find modified files [DEFAULT]"
    ]

lookforadds =
    DarcsMultipleChoiceOption
    [DarcsNoArgOption ['l'] ["look-for-adds"] LookForAdds
     "look for (non-boring) files that could be added",
     DarcsNoArgOption [] ["dont-look-for-adds","no-look-for-adds"] NoLookForAdds
     "don't look for any files that could be added [DEFAULT]"]

fancyMoveAdd =
    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"]

askLongComment =
    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"]

logfile = DarcsAbsPathOption [] ["logfile"] LogFile "FILE"
          "give patch name and comment in file"

rmlogfile = DarcsMultipleChoiceOption
            [DarcsNoArgOption [] ["delete-logfile"] RmLogFile
            "delete the logfile when done",
             DarcsNoArgOption [] ["no-delete-logfile"] DontRmLogFile
            "keep the logfile when done [DEFAULT]"]

author = DarcsArgOption ['A'] ["author"] Author "EMAIL" "specify author id"
fromOpt = DarcsArgOption [] ["from"] Author "EMAIL" "specify email address"

fileHelpAuthor :: [String]
fileHelpAuthor = [
 "Each patch is attributed to its author, usually by email address (for",
 "example, `Fred Bloggs <fred@example.net>').  Darcs looks in several",
 "places for this author string: the --author option, the files",
 "_darcs/prefs/author (in the repository) and ~/.darcs/author (in your",
 "home directory), and the environment variables $DARCS_EMAIL and",
 "$EMAIL.  If none of those exist, Darcs will prompt you for an author",
 "string and write it to _darcs/prefs/author."]

environmentHelpEmail :: ([String], [String])
environmentHelpEmail = (["DARCS_EMAIL","EMAIL"], fileHelpAuthor)

-- | 'getAuthor' 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.
getAuthor :: [DarcsFlag] -> IO String
getAuthor (Author a:_) = return a
getAuthor (Pipe:_) = do askUser "Who is the author? "
getAuthor (_:flags) = getAuthor flags
getAuthor [] = do
  easy_author <- getEasyAuthor
  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 <fred@example.net>').  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") $
                    unlines ["# " ++ line | line <- fileHelpAuthor] ++ "\n" ++ add
          return add
        else askUser "What is your email address (e.g. Fred Bloggs <fred@example.net>)? "

-- | 'getEasyAuthor' 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.
getEasyAuthor :: IO (Maybe String)
getEasyAuthor = firstJustIO [ firstNotBlank `fmap` getPreflist "author",
                                firstNotBlank `fmap` getGlobal "author",
                                maybeGetEnv "DARCS_EMAIL",
                                maybeGetEnv "EMAIL" ]

nocompress = concatOptions [__compress, __dontCompress]
uncompressNocompress = concatOptions [__compress, __dontCompress, __uncompress]

__compress, __dontCompress, __uncompress :: DarcsOption
__compress = DarcsNoArgOption [] ["compress"] Compress
            "create compressed patches"
__dontCompress = DarcsNoArgOption [] ["dont-compress","no-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 = DarcsMultipleChoiceOption
          [DarcsNoArgOption ['u'] ["unified"] Unified
          "output patch in a darcs-specific format similar to diff -u",
           DarcsNoArgOption  [] ["no-unified"] NonUnified
          "output patch in darcs' usual format"]

unidiff = DarcsMultipleChoiceOption
          [DarcsNoArgOption ['u'] ["unified"] Unified
          "pass -u option to diff",
           DarcsNoArgOption  [] ["no-unified"] NonUnified
          "output patch in diff's dumb format"]

diffCmdFlag = DarcsArgOption [] ["diff-command"]
       DiffCmd "COMMAND" "specify diff command (ignores --diff-opts)"

storeInMemory = DarcsMultipleChoiceOption
    [DarcsNoArgOption [] ["store-in-memory"] StoreInMemory
     "do patch application in memory rather than on disk",
     DarcsNoArgOption [] ["no-store-in-memory"] ApplyOnDisk
     "do patch application on disk [DEFAULT]"]

target = DarcsArgOption [] ["to"] Target "EMAIL" "specify destination email"
ccSend = DarcsArgOption [] ["cc"] Cc "EMAIL" "mail results to additional EMAIL(s)"
ccApply = DarcsArgOption [] ["cc"] Cc "EMAIL" "mail results to additional EMAIL(s). Requires --reply"

-- |'getCc' 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.
getCc :: [DarcsFlag] -> String
getCc 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"

-- |'getSubject' 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@
getSubject :: [DarcsFlag] -> Maybe String
getSubject (Subject s:_) = Just s
getSubject (_:fs) = getSubject fs
getSubject [] = Nothing

inReplyTo = DarcsArgOption [] ["in-reply-to"] InReplyTo "EMAIL" "specify in-reply-to header"
getInReplyTo :: [DarcsFlag] -> Maybe String
getInReplyTo (InReplyTo s:_) = Just s
getInReplyTo (_:fs) = getInReplyTo fs
getInReplyTo [] = Nothing

output = DarcsAbsPathOrStdOption ['o'] ["output"] Output "FILE"
         "specify output filename"

outputAutoName = DarcsOptAbsPathOption ['O'] ["output-auto-name"] "." OutputAutoName "DIRECTORY"
                   "output to automatically named file in DIRECTORY, default: current directory"

editDescription =
    DarcsMultipleChoiceOption
    [DarcsNoArgOption [] ["edit-description"] EditDescription
                          "edit the patch bundle description",
     DarcsNoArgOption [] ["dont-edit-description","no-edit-description"] NoEditDescription
                      "don't edit the patch bundle description"]

distnameOption = DarcsArgOption ['d'] ["dist-name"] DistName "DISTNAME"
                  "name of version"

recursive h
    = DarcsMultipleChoiceOption
      [DarcsNoArgOption ['r'] ["recursive"] Recursive h,
       DarcsNoArgOption [] ["not-recursive","no-recursive"] NoRecursive ("don't "++h)]

inventoryChoices :: DarcsOption
inventoryChoices =
    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."]

getInventoryChoices :: DarcsOption
getInventoryChoices =
    DarcsMultipleChoiceOption
    [DarcsNoArgOption [] ["hashed"] UseHashedInventory
                          "Convert darcs-1 format to hashed format",
     DarcsNoArgOption [] ["old-fashioned-inventory"] UseOldFashionedInventory
                          "Convert from hashed to darcs-1 format"]

upgradeFormat :: DarcsOption
upgradeFormat =
    DarcsNoArgOption [] ["upgrade"] UpgradeFormat
         "upgrade repository to latest compatible 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","no-sign"] NoSign
        "don't sign the patch"]
applyas = DarcsMultipleChoiceOption
           [DarcsArgOption [] ["apply-as"] ApplyAs "USERNAME"
            "apply patch as another user using sudo",
            DarcsNoArgOption [] ["no-apply-as"] NonApply
            "don't use sudo to apply as another user [DEFAULT]"]

happyForwarding = DarcsMultipleChoiceOption
                   [DarcsNoArgOption [] ["happy-forwarding"] HappyForwarding
                   "forward unsigned messages without extra header",
                    DarcsNoArgOption [] ["no-happy-forwarding"] NoHappyForwarding
                   "don't forward unsigned messages without extra header [DEFAULT]"]

setDefault = 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
depsSel = 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]"]
tokens = DarcsArgOption [] ["token-chars"] Toks "\"[CHARS]\""
         "define token to contain these characters"

partial       = concatOptions [__partial, __lazy, __ephemeral, __complete]
partialCheck = concatOptions [__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"

forceReplace = 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"
applyConflictOptions
    = 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","no-allow-conflicts"]
       NoAllowConflicts "fail if there are patches that would create conflicts [DEFAULT]",
       DarcsNoArgOption [] ["skip-conflicts"]
       SkipConflicts "filter out any patches that would create conflicts"
      ]
pullConflictOptions
    = DarcsMultipleChoiceOption
      [DarcsNoArgOption [] ["mark-conflicts"]
       MarkConflicts "mark conflicts [DEFAULT]",
       DarcsNoArgOption [] ["allow-conflicts"]
       AllowConflicts "allow conflicts, but don't mark them",
       DarcsNoArgOption [] ["dont-allow-conflicts","no-allow-conflicts"]
       NoAllowConflicts "fail if there patches that would create conflicts",
       DarcsNoArgOption [] ["skip-conflicts"]
       SkipConflicts "filter out any patches that would create conflicts"
      ]
useExternalMerge = DarcsArgOption [] ["external-merge"]
                     ExternalMerge "COMMAND" "use external tool to merge conflicts"

-- NOTE: I'd rather work to have no uses of dryRunNoxml, so that any time
-- --dry-run is a possibility, automated users can examine the results more
-- easily with --xml.
dryRunNoxml :: DarcsOption
dryRunNoxml = DarcsNoArgOption [] ["dry-run"] DryRun
                "don't actually take the action"

dryRun :: [DarcsOption]
dryRun = [dryRunNoxml, 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

-- | @'printDryRunMessageAndExit' 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@.
printDryRunMessageAndExit :: RepoPatch p => String -> [DarcsFlag] -> FL (PatchInfoAnd p) C(x y) -> IO ()
printDryRunMessageAndExit 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 (indent . xml_info) patches) $$
                            text "</patches>")
                      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 $ xmlSummary p)
           xml_with_summary hp = to_xml (info hp)
           indent = prefix "    "

noskipBoring = DarcsMultipleChoiceOption
                [DarcsNoArgOption [] ["boring"]
                 Boring "don't skip boring files",
                 DarcsNoArgOption [] ["no-boring"]
                 SkipBoring "skip borign files [DEFAULT]"]

allowProblematicFilenames = DarcsMultipleChoiceOption
                [DarcsNoArgOption [] ["case-ok"] AllowCaseOnly
                 "don't refuse to add files differing only in case"
                ,DarcsNoArgOption [] ["no-case-ok"] DontAllowCaseOnly
                 "refuse to add files whose name differ only in case [DEFAULT]"
                ,DarcsNoArgOption [] ["reserved-ok"] AllowWindowsReserved
                 "don't refuse to add files with Windows-reserved names"
                ,DarcsNoArgOption [] ["no-reserved-ok"] DontAllowWindowsReserved
                 "refuse to add files with Windows-reserved names [DEFAULT]"]

diffflags = DarcsArgOption [] ["diff-opts"]
            DiffFlags "OPTIONS" "options to pass to diff"

changesFormat = DarcsMultipleChoiceOption
                 [DarcsNoArgOption [] ["context"]
                  (Context rootDirectory) "give output suitable for get --context",
                  xmloutput,
                  humanReadable,
                  DarcsNoArgOption [] ["number"] NumberPatches "number the changes",
                  DarcsNoArgOption [] ["count"] Count "output count of changes"
                 ]
changesReverse = DarcsMultipleChoiceOption
                  [DarcsNoArgOption [] ["reverse"] Reverse
                   "show changes in reverse order"
                  ,DarcsNoArgOption [] ["no-reverse"] Forward
                   "show changes in the usual order [DEFAULT]"]

onlyToFiles :: DarcsOption
onlyToFiles = DarcsMultipleChoiceOption
    [DarcsNoArgOption [] ["only-to-files"] OnlyChangesToFiles
     "show only changes to specified files",
     DarcsNoArgOption [] ["no-only-to-files"] ChangesToAllFiles
     "show changes to all files [DEFAULT]"]


humanReadable = 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"

allInteractive = DarcsMultipleChoiceOption [all_patches, interactive]

allPipeInteractive
    = DarcsMultipleChoiceOption [all_patches,pipe,interactive]

pipeInteractive =
    DarcsMultipleChoiceOption [pipe, interactive]

repoCombinator =
    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)"]

-- | Get a list of all non-boring files and directories in the working copy.
listFiles :: IO [String]
listFiles =  do nonboring <- restrictBoring emptyTree
                working <- expand =<< nonboring <$> readPlainTree "."
                return $ map (anchorPath "" . fst) $ list working

-- | 'listUnregisteredFiles' returns the list of all non-boring unregistered
-- files in the repository.
listUnregisteredFiles :: IO [String]
listUnregisteredFiles =
    do unregd <- listFiles
       regd <- listRegisteredFiles
       return $ unregd \\ regd -- (inefficient)

-- | 'listRegisteredFiles' returns the list of all registered files in the repository.
listRegisteredFiles :: IO [String]
listRegisteredFiles =
    do recorded <- expand =<< withRepository [] readRecordedAndPending
       return $ map (anchorPath "" . fst) $ list recorded

optionsLatex :: [DarcsOption] -> String
optionsLatex opts = "\\begin{tabular}{lll}\n"++
                     unlines (map optionLatex opts)++
                     "\\end{tabular}\n"

latexHelp :: String -> String
latexHelp h
    = "\\begin{minipage}{7cm}\n\\raggedright\n" ++ h ++ "\\end{minipage}\n"

optionLatex :: DarcsOption -> String
optionLatex (DarcsNoArgOption a b _ h) =
    showShortOptions a ++ showLongOptions b ++ latexHelp h ++ "\\\\"
optionLatex (DarcsArgOption a b _ arg h) =
    showShortOptions a ++
    showLongOptions (map (++(" "++arg)) b) ++ latexHelp h ++ "\\\\"
optionLatex (DarcsAbsPathOrStdOption a b _ arg h) =
    showShortOptions a ++
    showLongOptions (map (++(" "++arg)) b) ++ latexHelp h ++ "\\\\"
optionLatex (DarcsAbsPathOption a b _ arg h) =
    showShortOptions a ++
    showLongOptions (map (++(" "++arg)) b) ++ latexHelp h ++ "\\\\"
optionLatex (DarcsOptAbsPathOption a b _ _ arg h) =
    showShortOptions a ++
    showLongOptions (map (++("[="++arg++"]")) b) ++ latexHelp h ++ "\\\\"
optionLatex (DarcsMultipleChoiceOption os) =
    unlines (map optionLatex os)

showShortOptions :: [Char] -> String
showShortOptions [] = "&"
showShortOptions [c] = "\\verb!-"++[c]++"! &"
showShortOptions (c:cs) = "\\verb!-"++[c]++"!,"++showShortOptions cs

showLongOptions :: [String] -> String
showLongOptions [] = " &"
showLongOptions [s] = "\\verb!--" ++ s ++ "! &"
showLongOptions (s:ss)
    = "\\verb!--" ++ s ++ "!,"++ showLongOptions ss

setScriptsExecutableOption :: DarcsOption
setScriptsExecutableOption = DarcsMultipleChoiceOption
                              [DarcsNoArgOption [] ["set-scripts-executable"] SetScriptsExecutable
                               "make scripts executable",
                               DarcsNoArgOption [] ["dont-set-scripts-executable","no-set-scripts-executable"] DontSetScriptsExecutable
                               "don't make scripts executable"]

relink, relinkPristine, sibling :: DarcsOption
relink = DarcsNoArgOption [] ["relink"] Relink
         "relink random internal data to a sibling"

relinkPristine = 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"

reorderPatches :: DarcsOption
reorderPatches = DarcsNoArgOption [] ["reorder-patches"] Reorder
                  "reorder the patches in the repository"

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

-- |'getSendmailCmd' 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.
getSendmailCmd :: [DarcsFlag] -> IO String 
getSendmailCmd (SendmailCmd a:_) = return a
getSendmailCmd (_:flags) = getSendmailCmd flags
getSendmailCmd [] =   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"

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$ listTouchedFiles 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 $ listTouchedFiles ps)
#else
defineChanges _ = return ()
#endif

posthookCmd :: DarcsOption
posthookCmd = DarcsMultipleChoiceOption
               [DarcsArgOption [] ["posthook"] PosthookCmd
                "COMMAND" "specify command to run after this darcs command",
                DarcsNoArgOption [] ["no-posthook"] NoPosthook
                "don't run posthook command"]

posthookPrompt :: DarcsOption
posthookPrompt = DarcsMultipleChoiceOption
                  [DarcsNoArgOption [] ["prompt-posthook"] AskPosthook
                   "prompt before running posthook [DEFAULT]",
                   DarcsNoArgOption [] ["run-posthook"] RunPosthook
                   "run posthook command without prompting"]

-- | 'getPosthookCmd' takes a list of flags and returns the posthook command
--  specified by @PosthookCmd a@ in that list of flags, if any.
getPosthookCmd :: [DarcsFlag] -> Maybe String
getPosthookCmd (PosthookCmd a:_) = Just a
getPosthookCmd (_:flags) = getPosthookCmd flags
getPosthookCmd [] = Nothing

prehookCmd :: DarcsOption
prehookCmd = DarcsMultipleChoiceOption
               [DarcsArgOption [] ["prehook"] PrehookCmd
                "COMMAND" "specify command to run before this darcs command",
                DarcsNoArgOption [] ["no-prehook"] NoPrehook
                "don't run prehook command"]

prehookPrompt :: DarcsOption
prehookPrompt = DarcsMultipleChoiceOption
                  [DarcsNoArgOption [] ["prompt-prehook"] AskPrehook
                   "prompt before running prehook [DEFAULT]",
                   DarcsNoArgOption [] ["run-prehook"] RunPrehook
                   "run prehook command without prompting"]

-- | 'getPrehookCmd' takes a list of flags and returns the prehook command
--  specified by @PrehookCmd a@ in that list of flags, if any.
getPrehookCmd :: [DarcsFlag] -> Maybe String
getPrehookCmd (PrehookCmd a:_) = Just a
getPrehookCmd (_:flags) = getPrehookCmd flags
getPrehookCmd [] = Nothing

networkOptions :: [DarcsOption]
networkOptions =
    [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],
      noCache, remote_darcs
     ]
    where pipelining_description =
              "enable HTTP pipelining"++
              (if pipeliningEnabledByDefault then " [DEFAULT]" else "")
          no_pipelining_description =
              "disable HTTP pipelining"++
              (if pipeliningEnabledByDefault then "" else " [DEFAULT]")

remote_darcs :: DarcsOption
remote_darcs =  DarcsArgOption [] ["remote-darcs"] RemoteDarcs "COMMAND"
                "name of the darcs executable on the remote server"

noCache :: DarcsOption
noCache = DarcsNoArgOption [] ["no-cache"] NoCache
                          "don't use patch caches"

optimizePristine :: DarcsOption
optimizePristine = DarcsNoArgOption [] ["pristine"] OptimizePristine
                          "optimize hashed pristine layout"

umaskOption :: DarcsOption
umaskOption =
    DarcsArgOption [] ["umask"] UMask "UMASK"
        "specify umask to use when writing"

restrictPaths =
    DarcsMultipleChoiceOption
    [DarcsNoArgOption [] ["restrict-paths"] RestrictPaths
     "don't allow darcs to touch external files or repo metadata",
     DarcsNoArgOption [] ["dont-restrict-paths","no-restrict-paths"] DontRestrictPaths
     "allow darcs to modify any file or directory (unsafe)"]

allowUnrelatedRepos =
    DarcsNoArgOption [] ["ignore-unrelated-repos"] AllowUnrelatedRepos
                         "do not check if repositories are unrelated"

justThisRepo :: DarcsOption

justThisRepo =
    DarcsNoArgOption [] ["just-this-repo"] JustThisRepo
                        "Limit the check or repair to the current repo"

check, repair, checkOrRepair :: DarcsOption

check =
    DarcsNoArgOption [] ["check"] Check
                        "Specify checking mode"

repair =
    DarcsNoArgOption [] ["repair"] Repair
                        "Specify repair mode"

checkOrRepair = concatOptions [check, repair]

-- | @'patchSelectFlag' f@ holds whenever @f@ is a way of selecting
-- patches such as @PatchName n@.
patchSelectFlag :: DarcsFlag -> Bool
patchSelectFlag All = True
patchSelectFlag (PatchName _) = True
patchSelectFlag (OnePatch _) = True
patchSelectFlag (SeveralPatch _) = True
patchSelectFlag (AfterPatch _) = True
patchSelectFlag (UpToPatch _) = True
patchSelectFlag (TagName _) = True
patchSelectFlag (LastN _) = True
patchSelectFlag (OneTag _) = True
patchSelectFlag (AfterTag _) = True
patchSelectFlag (UpToTag _) = True
patchSelectFlag (OnePattern _) = True
patchSelectFlag (SeveralPattern _) = True
patchSelectFlag (AfterPattern _) = True
patchSelectFlag (UpToPattern _) = True
patchSelectFlag _ = False

-- | The integer corresponding to a string, if it's only composed of digits.
--   Otherwise, -1.
numberString :: String -> Int
numberString "" = -1
numberString s = if all isDigit s then read s else (-1)