1{- | All the concrete options.
2
3Notes:
4
5  * The term \"option\" refers to a flag or combination of flags that
6    together form a part of a command's configuration. Ideally, options
7    should be orthogonal to each other, so we can freely combine them.
8
9  * A primitive (indivisible) option has an associate value type.
10
11  * An option named \"xyzActions\" represents a set of flags that act as
12    mutually exclusive sub-commands. They typically have a dedicated value
13    type named \"XyzAction\".
14
15  * This module is probably best imported qualified. This is in contrast to
16    the current practice of using subtly differing names to avoid name
17    clashes for closely related items. For instance, the data constructors
18    for an option's value type and the corresponding data constructors in
19    'F.DarcsFlag' may coincide. This is also why we import "Darcs.UI.Flags"
20    qualified here.
21
22  * When the new options system is finally in place, no code other than the
23    one for constructing options should directly refer to 'F.DarcsFlag'
24    constructors.
25
26-}
27module Darcs.UI.Options.All
28    ( DarcsOption
29
30    -- conversion to 'Bool'
31    , YesNo (..)
32
33    -- root
34    , RootAction (..)
35    , rootActions
36
37    -- all commands
38    , StdCmdAction (..)
39    , stdCmdActions
40    , debug
41    , Verbosity (..) -- re-export
42    , verbosity
43    , timings
44    , debugging
45    , HooksConfig (..) -- re-export
46    , HookConfig (..) -- re-export
47    , preHook
48    , postHook
49    , hooks
50    , UseCache (..) -- re-export
51    , useCache
52
53    -- interactivity
54    , XmlOutput (..)
55    , xmlOutput
56    , DryRun (..) -- re-export
57    , dryRun
58    , dryRunXml
59    , interactive
60    , pipe
61    , WantGuiPause (..) -- re-export
62    , pauseForGui
63    , askDeps
64
65    -- patch selection
66    , module Darcs.UI.Options.Matching -- re-export
67    , SelectDeps (..)
68    , selectDeps
69    , changesReverse
70    , maxCount
71
72    -- local or remote repo(s)
73    , repoDir
74    , RemoteRepos (..) -- re-export
75    , remoteRepos
76    , possiblyRemoteRepo
77    , newRepo
78    , NotInRemote (..)
79    , notInRemote
80    , notInRemoteFlagName
81    , RepoCombinator (..)
82    , repoCombinator
83    , allowUnrelatedRepos
84    , justThisRepo
85    , WithWorkingDir (..) -- re-export
86    , withWorkingDir
87    , SetDefault (..) -- re-export
88    , setDefault
89    , InheritDefault (..) -- re-export
90    , inheritDefault
91
92    -- patch meta-data
93    , patchname
94    , author
95    , AskLongComment (..)
96    , askLongComment
97    , keepDate
98    , Logfile (..)
99    , logfile
100
101    -- looking for changes
102    , LookFor (..)
103    , LookForAdds (..) -- re-export
104    , LookForMoves (..) -- re-export
105    , LookForReplaces (..) -- re-export
106    , lookfor
107    , lookforadds
108    , lookforreplaces
109    , lookformoves
110
111    -- files to consider
112    , UseIndex (..) -- re-export
113    , ScanKnown (..) -- re-export
114    , IncludeBoring (..)
115    , includeBoring
116    , allowProblematicFilenames
117    , allowCaseDifferingFilenames
118    , allowWindowsReservedFilenames
119    , onlyToFiles
120    , useIndex
121    , recursive
122
123    -- differences
124    , DiffAlgorithm (..) -- re-export
125    , diffAlgorithm
126    , WithContext (..)
127    , withContext
128    , ExternalDiff (..)
129    , extDiff
130
131    -- tests
132    , TestChanges (..)
133    , testChanges
134    , RunTest (..) -- re-export
135    , runTest
136    , LeaveTestDir (..) -- re-export
137    , leaveTestDir
138
139    -- mail related
140    , HeaderFields (..)
141    , headerFields
142    , sendToContext
143    , sendmail
144    , sendmailCmd
145    , charset
146    , editDescription
147
148    -- patch bundles
149    , applyAs
150    , Sign (..)
151    , sign
152    , Verify (..)
153    , verify
154
155    -- merging patches
156    , AllowConflicts (..) -- re-export
157    , conflictsNo
158    , conflictsYes
159    , ExternalMerge (..) -- re-export
160    , externalMerge
161    , reorder
162
163    -- optimizations
164    , Compression (..) -- re-export
165    , compress
166    , usePacks
167    , WithPatchIndex (..) -- re-export
168    , patchIndexNo
169    , patchIndexYes
170    , Reorder (..) -- re-export
171    , minimize
172    , storeInMemory
173
174    -- miscellaneous
175    , Output (..)
176    , output
177    , WithSummary (..)
178    , withSummary
179    , maybeSummary
180    , RemoteDarcs (..) -- re-export
181    , NetworkOptions (..)
182    , network
183    , UMask (..) -- re-export
184    , umask
185    , SetScriptsExecutable (..) -- re-export
186    , setScriptsExecutable
187
188    -- command specific
189
190    -- amend
191    , amendUnrecord
192    , selectAuthor
193
194    -- annotate
195    , machineReadable
196
197    -- clone
198    , CloneKind (..)
199    , cloneKind
200
201    -- dist
202    , distname
203    , distzip
204
205    -- convert import/export, init
206    , marks
207    , readMarks
208    , writeMarks
209    , PatchFormat (..)
210    , patchFormat
211    , hashed
212
213    -- log
214    , ChangesFormat (..)
215    , changesFormat
216
217    -- replace
218    , tokens
219    , forceReplace
220
221    -- test
222    , TestStrategy (..)
223    , testStrategy
224
225    -- show files/index
226    , files
227    , directories
228    , pending
229    , nullFlag
230
231    -- show repo
232    , EnumPatches (..)
233    , enumPatches
234
235    -- gzcrcs
236    , GzcrcsAction (..)
237    , gzcrcsActions
238
239    -- optimize
240    , siblings
241    ) where
242
243import Darcs.Prelude
244
245import Darcs.Repository.Flags
246    ( Compression (..)
247    , RemoteDarcs (..)
248    , Reorder (..)
249    , Verbosity (..)
250    , UseCache (..)
251    , UMask (..)
252    , DryRun (..)
253    , LookForAdds (..)
254    , LookForMoves (..)
255    , LookForReplaces (..)
256    , DiffAlgorithm (..)
257    , RunTest (..)
258    , SetScriptsExecutable (..)
259    , LeaveTestDir (..)
260    , RemoteRepos (..)
261    , SetDefault (..)
262    , InheritDefault (..)
263    , UseIndex (..)
264    , ScanKnown (..)
265    , CloneKind (..)
266    , ExternalMerge (..)
267    , AllowConflicts (..)
268    , WantGuiPause (..)
269    , WithPatchIndex (..)
270    , WithWorkingDir (..)
271    , PatchFormat (..)
272    , IncludeBoring (..)
273    , HooksConfig (..)
274    , HookConfig (..)
275    )
276
277import qualified Darcs.UI.Options.Flags as F ( DarcsFlag(..) )
278import Darcs.UI.Options.Core
279import Darcs.UI.Options.Iso
280import Darcs.UI.Options.Util
281import Darcs.UI.Options.Matching
282
283-- * Type instantiations
284
285-- | 'DarcsOption' instantiates the first two type parameters of 'OptSpec' to
286-- what we need in darcs. The first parameter is instantiated to
287-- The flag type is instantiate to 'Flag'.
288type DarcsOption = OptSpec DarcsOptDescr Flag
289
290type RawDarcsOption = forall v. v -> RawOptSpec Flag v
291
292-- * Conversion to 'Bool'
293
294class YesNo a where
295  yes :: a -> Bool
296  no :: a -> Bool
297  no = not . yes
298
299instance YesNo Compression where
300  yes NoCompression = False
301  yes GzipCompression = True
302
303instance YesNo WithPatchIndex where
304  yes NoPatchIndex = False
305  yes YesPatchIndex = True
306
307instance YesNo Reorder where
308  yes NoReorder = False
309  yes Reorder = True
310
311instance YesNo UseCache where
312  yes NoUseCache = False
313  yes YesUseCache = True
314
315instance YesNo DryRun where
316  yes NoDryRun = False
317  yes YesDryRun = True
318
319instance YesNo LookForAdds where
320  yes NoLookForAdds = False
321  yes YesLookForAdds = True
322
323instance YesNo LookForReplaces where
324  yes NoLookForReplaces = False
325  yes YesLookForReplaces = True
326
327instance YesNo LookForMoves where
328  yes NoLookForMoves = False
329  yes YesLookForMoves = True
330
331instance YesNo IncludeBoring where
332  yes NoIncludeBoring = False
333  yes YesIncludeBoring = True
334
335instance YesNo RunTest where
336  yes NoRunTest = False
337  yes YesRunTest = True
338
339instance YesNo SetScriptsExecutable where
340  yes NoSetScriptsExecutable = False
341  yes YesSetScriptsExecutable = True
342
343instance YesNo LeaveTestDir where
344  yes NoLeaveTestDir = False
345  yes YesLeaveTestDir = True
346
347instance YesNo UseIndex where
348  yes IgnoreIndex = False
349  yes UseIndex = True
350
351instance YesNo WantGuiPause where
352  yes NoWantGuiPause = False
353  yes YesWantGuiPause = True
354
355instance YesNo WithWorkingDir where
356  yes NoWorkingDir = False
357  yes WithWorkingDir = True
358
359data EnumPatches = NoEnumPatches | YesEnumPatches deriving (Eq, Show)
360
361instance YesNo EnumPatches where
362  yes NoEnumPatches = False
363  yes YesEnumPatches = True
364
365instance YesNo InheritDefault where
366  yes NoInheritDefault = False
367  yes YesInheritDefault = True
368
369-- * Root command
370
371-- | Options for darcs iself that act like sub-commands.
372data RootAction = RootHelp | Version | ExactVersion | ListCommands deriving (Eq, Show)
373
374rootActions :: PrimDarcsOption (Maybe RootAction)
375rootActions = withDefault Nothing
376  [ RawNoArg ['h'] ["help"] F.Help (Just RootHelp)
377    "show a brief description of all darcs commands and top-level options"
378  , RawNoArg ['v','V'] ["version"] F.Version  (Just Version) "show the darcs version"
379  , RawNoArg [] ["exact-version"] F.ExactVersion (Just ExactVersion)
380    "show the exact darcs version"
381    -- the switch --commands is here for compatibility only
382  , RawNoArg [] ["commands"] F.ListCommands (Just ListCommands)
383    "show plain list of available options and commands, for auto-completion"
384  ]
385
386-- * Common to all commands
387
388-- ** Standard command actions
389
390data StdCmdAction = Help | ListOptions | Disable deriving (Eq, Show)
391
392stdCmdActions :: PrimDarcsOption (Maybe StdCmdAction)
393stdCmdActions = withDefault Nothing
394  [ RawNoArg [] ["help"] F.Help (Just Help)
395    "show a description of the command and its options"
396  , RawNoArg [] ["list-options"] F.ListOptions (Just ListOptions)
397    "show plain list of available options and commands, for auto-completion"
398  , RawNoArg [] ["disable"] F.Disable (Just Disable) "disable this command" ]
399
400-- ** Verbosity related
401
402debug :: PrimDarcsOption Bool
403debug = singleNoArg [] ["debug"] F.Debug "enable general debug output"
404
405debugHttp :: PrimDarcsOption Bool
406debugHttp = singleNoArg [] ["debug-http"] F.DebugHTTP "debug output from libcurl"
407
408verbosity :: PrimDarcsOption Verbosity
409verbosity = withDefault NormalVerbosity
410  [ RawNoArg ['q'] ["quiet"] F.Quiet Quiet "suppress informational output"
411  , RawNoArg [] ["standard-verbosity"] F.NormalVerbosity NormalVerbosity
412      "neither verbose nor quiet output"
413  , RawNoArg ['v'] ["verbose"] F.Verbose Verbose "enable verbose output" ]
414
415timings :: PrimDarcsOption Bool
416timings = singleNoArg [] ["timings"] F.Timings "provide debugging timings information"
417
418debugging :: DarcsOption a (Bool -> Bool -> Bool -> a)
419debugging = debug ^ debugHttp ^ timings
420
421-- ** Hooks
422
423hooks :: DarcsOption a (HooksConfig -> a)
424hooks = imap (Iso fw bw) $ preHook ^ postHook where
425  fw k (HooksConfig pr po) = k pr po
426  bw k pr po = k (HooksConfig pr po)
427
428hookIso :: Iso (Maybe String -> Bool -> a) (HookConfig -> a)
429hookIso = (Iso fw bw) where
430    fw k (HookConfig c p) = k c p
431    bw k c p = k (HookConfig c p)
432
433preHook :: DarcsOption a (HookConfig -> a)
434preHook = imap hookIso $ prehookCmd ^ hookPrompt "prehook" F.AskPrehook F.RunPrehook
435
436postHook :: DarcsOption a (HookConfig -> a)
437postHook = imap hookIso $ posthookCmd ^ hookPrompt "posthook" F.AskPosthook F.RunPosthook
438
439prehookCmd :: PrimDarcsOption (Maybe String)
440prehookCmd = withDefault Nothing
441    [ RawStrArg [] ["prehook"] F.PrehookCmd unF Just unV
442      "COMMAND" "specify command to run before this darcs command"
443    , RawNoArg [] ["no-prehook"] F.NoPrehook Nothing
444      "don't run prehook command" ]
445  where unF f = [ s | F.PrehookCmd s <- [f] ]
446        unV v = [ s | Just s <- [v] ]
447
448posthookCmd :: PrimDarcsOption (Maybe String)
449posthookCmd = withDefault Nothing
450    [ RawStrArg [] ["posthook"] F.PosthookCmd unF Just unV "COMMAND"
451      "specify command to run after this darcs command"
452    , RawNoArg [] ["no-posthook"] F.NoPosthook Nothing
453      "don't run posthook command" ]
454  where unF f = [ s | F.PosthookCmd s <- [f] ]
455        unV v = [ s | Just s <- [v] ]
456
457hookPrompt :: String -> Flag -> Flag -> PrimDarcsOption Bool
458hookPrompt name fask frun = withDefault False
459  [ RawNoArg [] ["prompt-"++name] fask True
460    ("prompt before running "++name)
461  , RawNoArg [] ["run-"++name] frun False
462    ("run "++name++" command without prompting") ]
463
464-- ** Misc
465
466useCache :: PrimDarcsOption UseCache
467useCache = (imap . cps) (Iso fw bw) $ singleNoArg [] ["no-cache"] F.NoCache "don't use patch caches"
468  where
469    fw True = NoUseCache
470    fw False = YesUseCache
471    bw NoUseCache = True
472    bw YesUseCache = False
473
474-- * Interactivity related
475
476{- TODO: These options interact (no pun intended) in complex ways that are
477very hard to figure out for users as well as maintainers. I think the only
478solution here is a more radical (and probably incompatible) re-design
479involving all interactivity related options. -}
480
481data XmlOutput = NoXml | YesXml deriving (Eq, Show)
482
483instance YesNo XmlOutput where
484  yes NoXml = False
485  yes YesXml = True
486
487xmlOutput :: PrimDarcsOption XmlOutput
488xmlOutput = withDefault NoXml [__xmloutput YesXml]
489
490__xmloutput :: RawDarcsOption
491__xmloutput val = RawNoArg [] ["xml-output"] F.XMLOutput val "generate XML formatted output"
492
493-- | TODO someone wrote here long ago that any time --dry-run is a possibility
494-- automated users should be able to examine the results more
495-- easily with --xml. See also issue2397.
496-- dryRun w/o xml is currently used in add, pull, and repair.
497
498dryRun :: PrimDarcsOption DryRun
499dryRun = withDefault NoDryRun
500  [ RawNoArg [] ["dry-run"] F.DryRun YesDryRun "don't actually take the action" ]
501
502dryRunXml :: DarcsOption a (DryRun -> XmlOutput -> a)
503dryRunXml = dryRun ^ xmlOutput
504
505pipe :: PrimDarcsOption Bool
506pipe = singleNoArg [] ["pipe"] F.Pipe "ask user interactively for the patch metadata"
507
508interactive :: PrimDarcsOption (Maybe Bool)
509interactive = withDefault Nothing
510  [ RawNoArg ['a'] ["all","no-interactive"] F.All (Just False) "answer yes to all patches"
511  , RawNoArg ['i'] ["interactive"] F.Interactive (Just True) "prompt user interactively" ]
512
513pauseForGui :: PrimDarcsOption WantGuiPause
514pauseForGui = withDefault YesWantGuiPause
515  [ RawNoArg [] ["pause-for-gui"] F.PauseForGui YesWantGuiPause
516    "pause for an external diff or merge command to finish"
517  , RawNoArg [] ["no-pause-for-gui"] F.NoPauseForGui NoWantGuiPause
518    "return immediately after external diff or merge command finishes" ]
519
520askDeps :: PrimDarcsOption Bool
521askDeps = withDefault False
522  [ RawNoArg [] ["ask-deps"] F.AskDeps True "manually select dependencies"
523  , RawNoArg [] ["no-ask-deps"] F.NoAskDeps False "automatically select dependencies" ]
524
525-- * Patch selection related
526
527data SelectDeps = NoDeps | AutoDeps | PromptDeps deriving (Eq, Show)
528
529selectDeps :: PrimDarcsOption SelectDeps
530selectDeps = withDefault PromptDeps
531  [ RawNoArg [] ["no-deps"] F.DontGrabDeps NoDeps
532    "don't automatically fulfill dependencies"
533  , RawNoArg [] ["auto-deps","dont-prompt-for-dependencies"] F.DontPromptForDependencies AutoDeps
534    "don't ask about patches that are depended on by matched patches (with --match or --patch)"
535  , RawNoArg [] ["prompt-deps","prompt-for-dependencies"] F.PromptForDependencies PromptDeps
536    "prompt about patches that are depended on by matched patches" ]
537
538changesReverse :: PrimDarcsOption Bool
539changesReverse = withDefault False
540  [ RawNoArg [] ["reverse"] F.Reverse True "show/consider changes in reverse order"
541  , RawNoArg [] ["no-reverse"] F.Forward False "show/consider changes in the usual order" ]
542
543maxCount :: PrimDarcsOption (Maybe Int)
544maxCount = withDefault Nothing
545  [ RawStrArg [] ["max-count"] F.MaxCount unF toV unV "NUMBER" "return only NUMBER results" ]
546  where
547    unF f = [ s | F.MaxCount s <- [f] ]
548    unV x = [ showIntArg n | Just n <- [x] ]
549    toV = Just . parseIntArg "count" (>=0)
550
551-- * Local or remote repo
552
553repoDir :: PrimDarcsOption (Maybe String)
554repoDir = singleStrArg [] ["repodir"] F.WorkRepoDir arg "DIRECTORY"
555    "specify the repository directory in which to run"
556  where arg (F.WorkRepoDir s) = Just s
557        arg _ = Nothing
558
559-- | This option is for when a new repo gets created. Used for clone, convert
560-- import, convert darcs-2, and initialize. For clone and initialize it has the
561-- same effect as giving the name as a normal argument.
562--
563-- The @--repodir@ alias is there for compatibility, should be removed eventually.
564--
565-- TODO We need a way to deprecate options / option names.
566newRepo :: PrimDarcsOption (Maybe String)
567newRepo = singleStrArg [] ["repo-name","repodir"] F.NewRepo arg "DIRECTORY" "path of output directory"
568  where arg (F.NewRepo s) = Just s; arg _ = Nothing
569
570possiblyRemoteRepo :: PrimDarcsOption (Maybe String)
571possiblyRemoteRepo = singleStrArg [] ["repo"] F.WorkRepoUrl arg "URL"
572    "specify the repository URL"
573  where arg (F.WorkRepoUrl s) = Just s
574        arg _ = Nothing
575
576remoteRepos :: PrimDarcsOption RemoteRepos
577remoteRepos = (imap . cps) (Iso fw bw) $ multiStrArg [] ["remote-repo"] F.RemoteRepo mkV "URL"
578    "specify the remote repository URL to work with"
579  where mkV fs = [ s | F.RemoteRepo s <- fs ]
580        fw ss = RemoteRepos ss
581        bw (RemoteRepos ss) = ss
582
583notInRemoteFlagName :: String
584notInRemoteFlagName = "not-in-remote"
585
586data NotInRemote
587  = NotInDefaultRepo
588  | NotInRemotePath String
589
590notInRemote :: PrimDarcsOption [NotInRemote]
591notInRemote = (imap . cps) (Iso (map fw) (map bw)) $
592    multiOptStrArg [] [notInRemoteFlagName] F.NotInRemote args "URL/PATH" $
593        "select all patches not in the default push/pull repository or at "
594        ++ "location URL/PATH"
595  where
596    args fs = [s | F.NotInRemote s <- fs]
597    fw (Just s) = NotInRemotePath s
598    fw Nothing = NotInDefaultRepo
599    bw (NotInRemotePath s) = Just s
600    bw NotInDefaultRepo = Nothing
601
602data RepoCombinator = Intersection | Union | Complement deriving (Eq, Show)
603
604repoCombinator :: PrimDarcsOption RepoCombinator
605repoCombinator = withDefault Union
606  [ RawNoArg [] ["intersection"] F.Intersection Intersection
607    "take intersection of all repositories"
608  , RawNoArg [] ["union"] F.Union Union
609    "take union of all repositories"
610  , RawNoArg [] ["complement"] F.Complement Complement
611    "take complement of repositories (in order listed)" ]
612
613allowUnrelatedRepos :: PrimDarcsOption Bool
614allowUnrelatedRepos = singleNoArg [] ["ignore-unrelated-repos"] F.AllowUnrelatedRepos
615  "do not check if repositories are unrelated"
616
617justThisRepo :: PrimDarcsOption Bool
618justThisRepo = singleNoArg [] ["just-this-repo"] F.JustThisRepo
619  "Limit the check or repair to the current repo"
620
621-- | convert, clone, init
622withWorkingDir :: PrimDarcsOption WithWorkingDir
623withWorkingDir = withDefault WithWorkingDir
624  [ RawNoArg [] ["with-working-dir"] F.UseWorkingDir WithWorkingDir
625    "Create a working tree (normal repository)"
626  , RawNoArg [] ["no-working-dir"] F.UseNoWorkingDir NoWorkingDir
627    "Do not create a working tree (bare repository)" ]
628
629setDefault :: PrimDarcsOption (Maybe Bool)
630setDefault = withDefault Nothing
631  [ RawNoArg [] ["set-default"] F.SetDefault (Just True) "set default repository"
632  , RawNoArg [] ["no-set-default"] F.NoSetDefault (Just False) "don't set default repository" ]
633
634inheritDefault :: PrimDarcsOption InheritDefault
635inheritDefault = withDefault NoInheritDefault
636  [ RawNoArg [] ["inherit-default"] F.InheritDefault YesInheritDefault "inherit default repository"
637  , RawNoArg [] ["no-inherit-default"] F.NoInheritDefault NoInheritDefault "don't inherit default repository" ]
638
639-- * Specifying patch meta-data
640
641patchname :: PrimDarcsOption (Maybe String)
642patchname = singleStrArg ['m'] ["name"] F.PatchName arg "PATCHNAME"
643    "name of patch"
644  where arg (F.PatchName s) = Just s
645        arg _ = Nothing
646
647author :: PrimDarcsOption (Maybe String)
648author = singleStrArg ['A'] ["author"] F.Author arg
649    "EMAIL" "specify author id"
650  where arg (F.Author s) = Just s
651        arg _ = Nothing
652
653data AskLongComment = NoEditLongComment | YesEditLongComment | PromptLongComment
654  deriving (Eq, Show)
655
656askLongComment :: PrimDarcsOption (Maybe AskLongComment)
657askLongComment = withDefault Nothing
658  [ RawNoArg [] ["edit-long-comment"] F.EditLongComment (Just YesEditLongComment)
659    "edit the long comment by default"
660  , RawNoArg [] ["skip-long-comment"] F.NoEditLongComment (Just NoEditLongComment)
661    "don't give a long comment"
662  , RawNoArg [] ["prompt-long-comment"] F.PromptLongComment (Just PromptLongComment)
663    "prompt for whether to edit the long comment" ]
664
665keepDate :: PrimDarcsOption Bool
666keepDate = withDefault False
667  [ RawNoArg [] ["keep-date"] F.KeepDate True
668   "keep the date of the original patch"
669  , RawNoArg [] ["no-keep-date"] F.NoKeepDate False
670   "use the current date for the amended patch" ]
671
672-- record, send
673data Logfile = Logfile
674  { _logfile :: Maybe AbsolutePath
675  , _rmlogfile :: Bool
676  }
677
678logfile :: PrimDarcsOption Logfile
679logfile = imap (Iso fw bw) (__logfile ^ __rmlogfile) where
680  fw k (Logfile x y) = k x y
681  bw k x y = k (Logfile x y)
682
683__logfile :: PrimDarcsOption (Maybe AbsolutePath)
684__logfile = singleAbsPathArg [] ["logfile"] F.LogFile arg "FILE"
685    "give patch name and comment in file"
686  where arg (F.LogFile s) = Just s
687        arg _ = Nothing
688
689__rmlogfile :: PrimDarcsOption Bool
690__rmlogfile = withDefault False
691  [ RawNoArg [] ["delete-logfile"] F.RmLogFile True
692    "delete the logfile when done"
693  , RawNoArg [] ["no-delete-logfile"] F.DontRmLogFile False
694    "keep the logfile when done" ]
695
696-- * Looking for changes
697
698data LookFor = LookFor
699  { adds :: LookForAdds
700  , replaces :: LookForReplaces
701  , moves :: LookForMoves
702  }
703
704lookfor :: PrimDarcsOption LookFor
705lookfor = imap (Iso fw bw) (lookforadds NoLookForAdds ^ lookforreplaces ^ lookformoves) where
706  fw k (LookFor a r m) = k a r m
707  bw k a r m = k (LookFor a r m)
708
709lookforadds :: LookForAdds -> PrimDarcsOption LookForAdds
710lookforadds def = withDefault def
711  [ RawNoArg ['l'] ["look-for-adds"] F.LookForAdds YesLookForAdds
712    "look for (non-boring) files that could be added"
713  , RawNoArg [] ["dont-look-for-adds","no-look-for-adds"] F.NoLookForAdds NoLookForAdds
714    "don't look for any files that could be added" ]
715
716lookforreplaces :: PrimDarcsOption LookForReplaces
717lookforreplaces = withDefault NoLookForReplaces
718  [ RawNoArg [] ["look-for-replaces"] F.LookForReplaces YesLookForReplaces
719    "look for replaces that could be marked"
720  , RawNoArg [] ["dont-look-for-replaces","no-look-for-replaces"]
721    F.NoLookForReplaces NoLookForReplaces
722    "don't look for any replaces" ]
723
724lookformoves :: PrimDarcsOption LookForMoves
725lookformoves = withDefault NoLookForMoves
726  [ RawNoArg [] ["look-for-moves"] F.LookForMoves YesLookForMoves
727   "look for files that may be moved/renamed"
728  , RawNoArg [] ["dont-look-for-moves","no-look-for-moves"]
729    F.NoLookForMoves NoLookForMoves
730   "don't look for any files that could be moved/renamed" ]
731
732-- * Files to consider
733
734useIndex :: PrimDarcsOption UseIndex
735useIndex = (imap . cps) (Iso fw bw) ignoreTimes where
736  fw False = UseIndex
737  fw True = IgnoreIndex
738  bw UseIndex = False
739  bw IgnoreIndex = True
740
741includeBoring :: PrimDarcsOption IncludeBoring
742includeBoring = withDefault NoIncludeBoring
743  [ RawNoArg [] ["boring"] F.Boring YesIncludeBoring "don't skip boring files"
744  , RawNoArg [] ["no-boring"] F.SkipBoring NoIncludeBoring "skip boring files" ]
745
746allowProblematicFilenames :: DarcsOption a (Bool -> Bool -> a)
747allowProblematicFilenames = allowCaseDifferingFilenames ^ allowWindowsReservedFilenames
748
749allowCaseDifferingFilenames :: PrimDarcsOption Bool
750allowCaseDifferingFilenames = withDefault False
751  [ RawNoArg [] ["case-ok"] F.AllowCaseOnly True
752    "don't refuse to add files differing only in case"
753  , RawNoArg [] ["no-case-ok"] F.DontAllowCaseOnly False
754    "refuse to add files whose name differ only in case" ]
755
756allowWindowsReservedFilenames :: PrimDarcsOption Bool
757allowWindowsReservedFilenames = withDefault False
758  [ RawNoArg [] ["reserved-ok"] F.AllowWindowsReserved True
759    "don't refuse to add files with Windows-reserved names"
760  , RawNoArg [] ["no-reserved-ok"] F.DontAllowWindowsReserved False
761    "refuse to add files with Windows-reserved names" ]
762
763-- | TODO: see issue2395
764onlyToFiles :: PrimDarcsOption Bool
765onlyToFiles = withDefault False
766  [ RawNoArg [] ["only-to-files"] F.OnlyChangesToFiles True
767    "show only changes to specified files"
768  , RawNoArg [] ["no-only-to-files"] F.ChangesToAllFiles False
769    "show changes to all files" ]
770
771ignoreTimes :: PrimDarcsOption Bool
772ignoreTimes = withDefault False
773  [ RawNoArg [] ["ignore-times"] F.IgnoreTimes True
774    "don't trust the file modification times"
775  , RawNoArg [] ["no-ignore-times"] F.DontIgnoreTimes False
776    "trust modification times to find modified files" ]
777
778recursive :: PrimDarcsOption Bool
779recursive = withDefault False
780  [ RawNoArg ['r'] ["recursive"] F.Recursive True "recurse into subdirectories"
781  , RawNoArg [] ["not-recursive","no-recursive"] F.NoRecursive False ("don't recurse into subdirectories") ]
782
783-- * Differences
784
785diffAlgorithm :: PrimDarcsOption DiffAlgorithm
786diffAlgorithm = withDefault PatienceDiff
787  [ RawNoArg [] ["myers"] F.UseMyersDiff MyersDiff
788    "use myers diff algorithm"
789  , RawNoArg [] ["patience"] F.UsePatienceDiff PatienceDiff
790    "use patience diff algorithm" ]
791
792data WithContext = NoContext | YesContext deriving (Eq, Show)
793
794instance YesNo WithContext where
795  yes NoContext = False
796  yes YesContext = True
797
798withContext :: PrimDarcsOption WithContext
799withContext = (imap . cps) (Iso fw bw) $ withDefault False
800  [ RawNoArg ['u'] ["unified"] F.Unified True
801    "output changes in a darcs-specific format similar to diff -u"
802  , RawNoArg  [] ["no-unified"] F.NonUnified False
803    "output changes in darcs' usual format" ]
804  where fw False = NoContext
805        fw True = YesContext
806        bw NoContext = False
807        bw YesContext = True
808
809data ExternalDiff = ExternalDiff
810  { diffCmd :: Maybe String
811  , diffOpts :: [String]
812  , diffUnified :: Bool
813  } deriving (Eq, Show)
814
815extDiff :: PrimDarcsOption ExternalDiff
816extDiff = imap (Iso fw bw) $ __extDiffCmd ^ __extDiffOpts ^ __unidiff where
817  fw k (ExternalDiff cmd opts uni) = k cmd opts uni
818  bw k cmd opts uni = k (ExternalDiff cmd opts uni)
819
820__extDiffCmd :: PrimDarcsOption (Maybe String)
821__extDiffCmd = singleStrArg [] ["diff-command"] F.DiffCmd arg "COMMAND"
822    "specify diff command (ignores --diff-opts)"
823  where arg (F.DiffCmd s) = Just s
824        arg _ = Nothing
825
826__extDiffOpts :: PrimDarcsOption [String]
827__extDiffOpts = multiStrArg [] ["diff-opts"] F.DiffFlags mkV "OPTIONS"
828    "options to pass to diff"
829  where mkV fs = [ s | F.DiffFlags s <- fs ]
830
831__unidiff :: PrimDarcsOption Bool
832__unidiff = withDefault True
833  [ RawNoArg ['u'] ["unified"] F.Unified True "pass -u option to diff"
834  , RawNoArg  [] ["no-unified"] F.NonUnified False "output patch in diff's dumb format" ]
835
836-- * Runnign tests
837
838data TestChanges = NoTestChanges | YesTestChanges LeaveTestDir deriving (Eq)
839
840testChanges :: PrimDarcsOption TestChanges
841testChanges = imap (Iso fw bw) $ runTest ^ leaveTestDir where
842  fw k NoTestChanges = k NoRunTest NoLeaveTestDir
843  fw k (YesTestChanges ltd) = k YesRunTest ltd
844  bw k NoRunTest _ = k NoTestChanges
845  bw k YesRunTest ltd = k (YesTestChanges ltd)
846
847runTest :: PrimDarcsOption RunTest
848runTest = withDefault NoRunTest
849  [ RawNoArg [] ["test"] F.Test YesRunTest "run the test script"
850  , RawNoArg [] ["no-test"] F.NoTest NoRunTest "don't run the test script" ]
851
852leaveTestDir :: PrimDarcsOption LeaveTestDir
853leaveTestDir = withDefault NoLeaveTestDir
854  [ RawNoArg [] ["leave-test-directory"]
855    F.LeaveTestDir YesLeaveTestDir "don't remove the test directory"
856  , RawNoArg [] ["remove-test-directory"]
857    F.NoLeaveTestDir NoLeaveTestDir "remove the test directory" ]
858
859-- * Mail related
860
861data HeaderFields = HeaderFields
862  { _to, _cc :: [String]
863  , _from, _subject, _inReplyTo :: Maybe String
864  }
865
866headerFields :: PrimDarcsOption HeaderFields
867headerFields = imap (Iso fw bw) $ to ^ cc ^ from ^ subject ^ inReplyTo where
868  fw k (HeaderFields t f c s i) = k t f c s i
869  bw k t f c s i = k (HeaderFields t f c s i)
870
871from :: PrimDarcsOption (Maybe String)
872from = singleStrArg [] ["from"] F.Author arg
873    "EMAIL" "specify email address"
874  where arg (F.Author s) = Just s
875        arg _ = Nothing
876
877to :: PrimDarcsOption [String]
878to = multiStrArg [] ["to"] F.To mkV "EMAIL" "specify destination email"
879  where mkV fs = [ s | F.To s <- fs ]
880
881cc :: PrimDarcsOption [String]
882cc = multiStrArg [] ["cc"] F.Cc mkV "EMAIL" "mail results to additional EMAIL(s)"
883  where mkV fs = [ s | F.Cc s <- fs ]
884
885subject :: PrimDarcsOption (Maybe String)
886subject = singleStrArg [] ["subject"] F.Subject arg
887    "SUBJECT" "specify mail subject"
888  where arg (F.Subject s) = Just s
889        arg _ = Nothing
890
891inReplyTo :: PrimDarcsOption (Maybe String)
892inReplyTo = singleStrArg [] ["in-reply-to"] F.InReplyTo arg
893    "EMAIL" "specify in-reply-to header"
894  where arg (F.InReplyTo s) = Just s
895        arg _ = Nothing
896
897sendToContext :: PrimDarcsOption (Maybe AbsolutePath)
898sendToContext = singleAbsPathArg [] ["context"] F.Context arg "FILENAME"
899    "send to context stored in FILENAME"
900  where arg (F.Context s) = Just s
901        arg _ = Nothing
902
903-- TODO: do something about the nonsensical case (False, Just s)
904--
905-- Some of the tests actually do this (pass --sendmail-command without
906-- passing --mail) and it's unclear if it's deliberate or just a historical
907-- accident after the issue2204 changes. We should untangle that and
908-- perhaps turn this into a single option with an optional argument.
909-- The other question to resolve is the interaction with the 'output'
910-- options to darcs send.
911sendmailIso :: Iso (Bool -> Maybe String -> a) ((Bool, Maybe String) -> a)
912sendmailIso = Iso uncurry curry
913
914sendmail :: PrimDarcsOption (Bool, Maybe String)
915sendmail = imap sendmailIso $ mail ^ sendmailCmd
916
917mail :: PrimDarcsOption Bool
918mail = singleNoArg [] ["mail"] F.Mail "send patch using sendmail"
919
920sendmailCmd :: PrimDarcsOption (Maybe String)
921sendmailCmd = singleStrArg [] ["sendmail-command"] F.SendmailCmd arg "COMMAND"
922    "specify sendmail command"
923  where arg (F.SendmailCmd s) = Just s
924        arg _ = Nothing
925
926minimize :: PrimDarcsOption Bool
927minimize = withDefault True
928  [ RawNoArg [] ["minimize"] F.Minimize True "minimize context of patch bundle"
929  , RawNoArg [] ["no-minimize"] F.NoMinimize False ("don't minimize context of patch bundle") ]
930
931charset :: PrimDarcsOption (Maybe String)
932charset = singleStrArg [] ["charset"] F.Charset arg
933    "CHARSET" "specify mail charset"
934  where arg (F.Charset s) = Just s
935        arg _ = Nothing
936
937editDescription :: PrimDarcsOption Bool
938editDescription = withDefault True
939  [ RawNoArg [] ["edit-description"] F.EditDescription True
940    "edit the patch bundle description"
941  , RawNoArg [] ["dont-edit-description","no-edit-description"] F.NoEditDescription False
942    "don't edit the patch bundle description" ]
943
944-- * Patch bundle related
945
946applyAs :: PrimDarcsOption (Maybe String)
947applyAs = withDefault Nothing
948  [ RawStrArg [] ["apply-as"] F.ApplyAs unF Just unV "USERNAME"
949    "apply patch as another user using sudo"
950  , RawNoArg [] ["no-apply-as"] F.NonApply Nothing
951    "don't use sudo to apply as another user" ]
952  where
953    unF f = [ s | F.ApplyAs s <- [f] ]
954    unV x = [ s | Just s <- [x] ]
955
956data Sign = NoSign | Sign | SignAs String | SignSSL String deriving (Eq, Show)
957
958sign :: PrimDarcsOption Sign
959sign = withDefault NoSign
960  [ RawNoArg [] ["sign"] F.Sign Sign "sign the patch with your gpg key"
961  , RawStrArg [] ["sign-as"] F.SignAs unFSignAs SignAs unSignAs "KEYID"
962    "sign the patch with a given keyid"
963  , RawStrArg [] ["sign-ssl"] F.SignSSL  unFSignSSL SignSSL unSignSSL "IDFILE"
964    "sign the patch using openssl with a given private key"
965  , RawNoArg [] ["dont-sign","no-sign"] F.NoSign NoSign "don't sign the patch" ]
966  where unFSignAs f = [ s | F.SignAs s <- [f] ]
967        unSignAs v = [ s | SignAs s <- [v] ]
968        unFSignSSL f = [ s | F.SignSSL s <- [f] ]
969        unSignSSL v = [ s | SignSSL s <- [v] ]
970
971data Verify = NoVerify | VerifyKeyring AbsolutePath | VerifySSL AbsolutePath deriving (Eq, Show)
972
973verify :: PrimDarcsOption Verify
974verify = withDefault NoVerify
975  [ RawAbsPathArg [] ["verify"] F.Verify unFKeyring VerifyKeyring unVKeyring "PUBRING"
976    "verify that the patch was signed by a key in PUBRING"
977  , RawAbsPathArg [] ["verify-ssl"] F.VerifySSL unFSSL VerifySSL unVSSL "KEYS"
978    "verify using openSSL with authorized keys from file KEYS"
979  , RawNoArg [] ["no-verify"] F.NonVerify NoVerify
980    "don't verify patch signature" ]
981  where
982    unFKeyring f = [ s | F.Verify s <- [f] ]
983    unVKeyring x = [ s | VerifyKeyring s <- [x] ]
984    unFSSL f = [ s | F.VerifySSL s <- [f] ]
985    unVSSL x = [ s | VerifySSL s <- [x] ]
986
987-- * Merging patches
988
989-- | push, apply, rebase apply: default to 'NoAllowConflicts'
990conflictsNo :: PrimDarcsOption (Maybe AllowConflicts)
991conflictsNo = conflicts NoAllowConflicts
992
993-- | pull, rebase pull: default to 'YesAllowConflictsAndMark'
994conflictsYes :: PrimDarcsOption (Maybe AllowConflicts)
995conflictsYes = conflicts YesAllowConflictsAndMark
996
997conflicts :: AllowConflicts -> PrimDarcsOption (Maybe AllowConflicts)
998conflicts def = withDefault (Just def)
999  [ RawNoArg [] ["mark-conflicts"]
1000      F.MarkConflicts (Just YesAllowConflictsAndMark) "mark conflicts"
1001  , RawNoArg [] ["allow-conflicts"]
1002      F.AllowConflicts (Just YesAllowConflicts) "allow conflicts, but don't mark them"
1003  , RawNoArg [] ["dont-allow-conflicts","no-allow-conflicts","no-resolve-conflicts"]
1004      F.NoAllowConflicts (Just NoAllowConflicts) "fail if there are patches that would create conflicts"
1005  , RawNoArg [] ["skip-conflicts"]
1006      F.SkipConflicts Nothing "filter out any patches that would create conflicts" ]
1007
1008-- Technically not an isomorphism, see 'sendmailIso'.
1009externalMerge :: PrimDarcsOption ExternalMerge
1010externalMerge = imap (Iso fw bw) $ singleStrArg [] ["external-merge"] F.ExternalMerge arg
1011    "COMMAND" "use external tool to merge conflicts"
1012  where
1013    arg (F.ExternalMerge s) = Just s
1014    arg _ = Nothing
1015    bw k (Just s) = k (YesExternalMerge s)
1016    bw k Nothing = k NoExternalMerge
1017    fw k (YesExternalMerge s) = k (Just s)
1018    fw k NoExternalMerge = k Nothing
1019
1020-- | pull, apply, rebase pull, rebase apply
1021reorder :: PrimDarcsOption Reorder
1022reorder = withDefault NoReorder
1023  [ RawNoArg [] ["reorder-patches"] F.Reorder Reorder
1024    "put local-only patches on top of remote ones"
1025  , RawNoArg [] ["no-reorder-patches"] F.NoReorder NoReorder
1026    "put remote-only patches on top of local ones" ]
1027
1028-- * Optimizations
1029
1030compress :: PrimDarcsOption Compression
1031compress = withDefault GzipCompression
1032  [ RawNoArg [] ["compress"] F.Compress GzipCompression "compress patch data"
1033  , RawNoArg [] ["dont-compress","no-compress"] F.NoCompress NoCompression "don't compress patch data" ]
1034
1035usePacks :: PrimDarcsOption Bool
1036usePacks = withDefault True
1037  [ RawNoArg [] ["packs"] F.Packs True "use repository packs"
1038  , RawNoArg [] ["no-packs"] F.NoPacks False "don't use repository packs" ]
1039
1040-- for init, clone and convert: patch index disabled by default
1041patchIndexNo :: PrimDarcsOption WithPatchIndex
1042patchIndexNo = withDefault NoPatchIndex [__patchIndex YesPatchIndex, __noPatchIndex NoPatchIndex]
1043
1044-- for log and annotate: patch index enabled by default
1045patchIndexYes :: PrimDarcsOption WithPatchIndex
1046patchIndexYes = withDefault YesPatchIndex [__patchIndex YesPatchIndex, __noPatchIndex NoPatchIndex]
1047
1048__patchIndex, __noPatchIndex :: RawDarcsOption
1049__patchIndex val = RawNoArg [] ["with-patch-index"] F.PatchIndexFlag val "build patch index"
1050__noPatchIndex val = RawNoArg [] ["no-patch-index"] F.NoPatchIndexFlag val "don't build patch index"
1051
1052-- diff, dist
1053storeInMemory :: PrimDarcsOption Bool
1054storeInMemory = withDefault False
1055  [ RawNoArg [] ["store-in-memory"] F.StoreInMemory True
1056    "do patch application in memory rather than on disk"
1057  , RawNoArg [] ["no-store-in-memory"] F.ApplyOnDisk False
1058    "do patch application on disk" ]
1059
1060-- * Output
1061
1062data Output = Output AbsolutePathOrStd
1063            | OutputAutoName AbsolutePath
1064            deriving (Eq, Show)
1065
1066output :: PrimDarcsOption (Maybe Output)
1067output = withDefault Nothing
1068    [ RawAbsPathOrStdArg ['o'] ["output"]
1069      F.Output unOutputF (Just . Output) unOutput
1070      "FILE" "specify output filename"
1071    , RawOptAbsPathArg ['O'] ["output-auto-name"]
1072      F.OutputAutoName unOutputAutoNameF (Just . OutputAutoName) unOutputAutoName
1073      "." "DIRECTORY"
1074      "output to automatically named file in DIRECTORY, default: current directory"
1075    ]
1076  where
1077    unOutputF f = [ p | F.Output p <- [f] ]
1078    unOutput (Just (Output p)) = [p]
1079    unOutput _ = []
1080    unOutputAutoNameF f = [ p | F.OutputAutoName p <- [f] ]
1081    unOutputAutoName (Just (OutputAutoName p)) = [p]
1082    unOutputAutoName _ = []
1083
1084-- * Miscellaneous
1085
1086data WithSummary = NoSummary | YesSummary deriving (Eq, Show)
1087
1088instance YesNo WithSummary where
1089  yes NoSummary = False
1090  yes YesSummary = True
1091
1092-- all commands except whatsnew
1093withSummary :: PrimDarcsOption WithSummary
1094withSummary = (imap . cps) (Iso fw bw) $ maybeSummary Nothing
1095  where
1096    fw Nothing = NoSummary
1097    fw (Just NoSummary) = NoSummary
1098    fw (Just YesSummary) = YesSummary
1099    bw NoSummary = Nothing
1100    bw YesSummary = Just YesSummary
1101
1102-- needed for whatsnew
1103maybeSummary :: Maybe WithSummary -> PrimDarcsOption (Maybe WithSummary)
1104maybeSummary def = withDefault def
1105  [ RawNoArg ['s'] ["summary"] F.Summary (Just YesSummary) "summarize changes"
1106  , RawNoArg [] ["no-summary"] F.NoSummary (Just NoSummary) "don't summarize changes" ]
1107
1108-- | TODO: reconsider this grouping of options
1109data NetworkOptions = NetworkOptions
1110  { noHttpPipelining :: Bool
1111  , remoteDarcs :: RemoteDarcs }
1112
1113networkIso :: Iso (Bool -> Maybe String -> a) (NetworkOptions -> a)
1114networkIso = Iso fw bw where
1115  fw k (NetworkOptions x (RemoteDarcs y)) = k x (Just y)
1116  fw k (NetworkOptions x DefaultRemoteDarcs) = k x Nothing
1117  bw k x (Just y) = k (NetworkOptions x (RemoteDarcs y))
1118  bw k x Nothing = k (NetworkOptions x DefaultRemoteDarcs)
1119
1120network :: PrimDarcsOption NetworkOptions
1121network = imap networkIso
1122  $ singleNoArg [] ["no-http-pipelining"] F.NoHTTPPipelining "disable HTTP pipelining"
1123  ^ singleStrArg [] ["remote-darcs"] F.RemoteDarcsOpt arg "COMMAND"
1124    "name of the darcs executable on the remote server"
1125  where arg (F.RemoteDarcsOpt s) = Just s
1126        arg _ = Nothing
1127
1128umask :: PrimDarcsOption UMask
1129umask = (imap . cps) (Iso fw bw) $ singleStrArg [] ["umask"] F.UMask arg "UMASK"
1130    "specify umask to use when writing"
1131  where
1132    arg (F.UMask s) = Just s
1133    arg _ = Nothing
1134    fw (Just s) = YesUMask s
1135    fw Nothing = NoUMask
1136    bw (YesUMask s) = Just s
1137    bw NoUMask = Nothing
1138
1139setScriptsExecutable :: PrimDarcsOption SetScriptsExecutable
1140setScriptsExecutable = withDefault NoSetScriptsExecutable
1141  [ RawNoArg [] ["set-scripts-executable"] F.SetScriptsExecutable YesSetScriptsExecutable
1142    "make scripts executable"
1143  , RawNoArg [] ["dont-set-scripts-executable","no-set-scripts-executable"]
1144    F.DontSetScriptsExecutable NoSetScriptsExecutable "don't make scripts executable" ]
1145
1146-- * Specific to a single command
1147
1148-- ** amend
1149
1150amendUnrecord :: PrimDarcsOption Bool
1151amendUnrecord = withDefault False
1152  [ RawNoArg [] ["unrecord"] F.AmendUnrecord True "remove changes from the patch"
1153  , RawNoArg [] ["record"] F.NoAmendUnrecord False "add more changes to the patch" ]
1154
1155selectAuthor :: PrimDarcsOption Bool
1156selectAuthor = singleNoArg [] ["select-author"] F.SelectAuthor
1157  "select author id from a menu"
1158
1159-- ** annotate
1160
1161machineReadable :: PrimDarcsOption Bool
1162machineReadable = withDefault False
1163  [ __humanReadable False
1164  , __machineReadable True ]
1165
1166__humanReadable :: RawDarcsOption
1167__humanReadable val = RawNoArg [] ["human-readable"] F.HumanReadable val "normal human-readable output"
1168
1169__machineReadable :: RawDarcsOption
1170__machineReadable val = RawNoArg [] ["machine-readable"] F.MachineReadable val "machine-readable output"
1171
1172-- ** clone
1173
1174cloneKind :: PrimDarcsOption CloneKind
1175cloneKind = withDefault NormalClone
1176  [ RawNoArg [] ["lazy"] F.Lazy LazyClone "get patch files only as needed"
1177  , RawNoArg [] ["complete"] F.Complete CompleteClone "get a complete copy of the repository" ]
1178
1179-- ** convert import/export
1180
1181marks :: DarcsOption a (Maybe String -> Maybe String -> a)
1182marks = readMarks ^ writeMarks
1183
1184readMarks :: PrimDarcsOption (Maybe String)
1185readMarks = singleStrArg [] ["read-marks"] F.ReadMarks arg
1186    "FILE" "continue conversion, previously checkpointed by --write-marks"
1187  where arg (F.ReadMarks s) = Just s
1188        arg _ = Nothing
1189
1190writeMarks :: PrimDarcsOption (Maybe String)
1191writeMarks = singleStrArg [] ["write-marks"] F.WriteMarks arg
1192    "FILE" "checkpoint conversion to continue it later"
1193  where arg (F.WriteMarks s) = Just s
1194        arg _ = Nothing
1195
1196-- | Deprecated flag, still present to output an error message.
1197hashed :: PrimDarcsOption ()
1198hashed = deprecated
1199  [ "All repositories are now \"hashed\", so this option was removed."
1200  , "Use --darcs-1 to get the effect that --hashed had previously." ] $
1201  [ RawNoArg [] ["hashed"] F.Hashed () "deprecated, use --darcs-1 instead" ]
1202
1203patchFormat :: PrimDarcsOption PatchFormat
1204patchFormat = withDefault PatchFormat2
1205  [ RawNoArg [] ["darcs-3"] F.UseFormat3 PatchFormat3
1206    "New darcs patch format"
1207  , RawNoArg [] ["darcs-2"] F.UseFormat2 PatchFormat2
1208    "Standard darcs patch format"
1209  , RawNoArg [] ["darcs-1"] F.UseFormat1 PatchFormat1
1210    "Older patch format (for compatibility)" ]
1211
1212-- ** dist
1213
1214distname :: PrimDarcsOption (Maybe String)
1215distname = singleStrArg ['d'] ["dist-name"] F.DistName arg "DISTNAME" "name of version"
1216  where arg (F.DistName s) = Just s
1217        arg _ = Nothing
1218
1219distzip :: PrimDarcsOption Bool
1220distzip = singleNoArg [] ["zip"] F.DistZip "generate zip archive instead of gzip'ed tar"
1221
1222-- ** log
1223
1224data ChangesFormat
1225  = HumanReadable
1226  | MachineReadable
1227  | GenContext
1228  | GenXml
1229  | NumberPatches
1230  | CountPatches
1231  deriving (Eq, Show)
1232
1233changesFormat :: PrimDarcsOption (Maybe ChangesFormat)
1234changesFormat = withDefault Nothing
1235  [ RawNoArg [] ["context"] F.GenContext (Just GenContext) "produce output suitable for clone --context"
1236  , __xmloutput (Just GenXml)
1237  , __humanReadable (Just HumanReadable)
1238  , __machineReadable (Just MachineReadable)
1239  , RawNoArg [] ["number"] F.NumberPatches (Just NumberPatches) "number the changes"
1240  , RawNoArg [] ["count"] F.Count (Just CountPatches) "output count of changes" ]
1241
1242-- ** replace
1243
1244tokens :: PrimDarcsOption (Maybe String)
1245tokens = singleStrArg [] ["token-chars"] F.Toks arg "\"[CHARS]\""
1246    "define token to contain these characters"
1247  where arg (F.Toks s) = Just s; arg _ = Nothing
1248
1249forceReplace :: PrimDarcsOption Bool
1250forceReplace = withDefault False
1251  [ RawNoArg ['f'] ["force"] F.ForceReplace True
1252    "proceed with replace even if 'new' token already exists"
1253  , RawNoArg [] ["no-force"] F.NonForce False
1254    "don't force the replace if it looks scary" ]
1255
1256-- ** test
1257
1258data TestStrategy = Once | Linear | Backoff | Bisect deriving (Eq, Show)
1259
1260testStrategy :: PrimDarcsOption TestStrategy
1261testStrategy = withDefault Once
1262  [ RawNoArg [] ["once"] F.Once Once "run test on current version only"
1263  , RawNoArg [] ["linear"] F.Linear Linear "locate the most recent version lacking an error"
1264  , RawNoArg [] ["backoff"] F.Backoff Backoff "exponential backoff search"
1265  , RawNoArg [] ["bisect"] F.Bisect Bisect "binary instead of linear search" ]
1266
1267-- ** show files
1268
1269files :: PrimDarcsOption Bool
1270files = withDefault True
1271  [ RawNoArg [] ["files"] F.Files True "include files in output"
1272  , RawNoArg [] ["no-files"] F.NoFiles False "don't include files in output" ]
1273
1274directories :: PrimDarcsOption Bool
1275directories = withDefault True
1276  [ RawNoArg [] ["directories"] F.Directories True "include directories in output"
1277  , RawNoArg [] ["no-directories"] F.NoDirectories False "don't include directories in output" ]
1278
1279pending :: PrimDarcsOption Bool
1280pending = withDefault True
1281  [ RawNoArg [] ["pending"] F.Pending True "reflect pending patches in output"
1282  , RawNoArg [] ["no-pending"] F.NoPending False "only include recorded patches in output" ]
1283
1284-- "null" is already taken
1285nullFlag :: PrimDarcsOption Bool
1286nullFlag = singleNoArg ['0'] ["null"] F.NullFlag "separate file names by NUL characters"
1287
1288-- ** show repo
1289
1290enumPatches :: PrimDarcsOption EnumPatches
1291enumPatches = withDefault YesEnumPatches
1292  [ RawNoArg [] ["enum-patches"] F.EnumPatches YesEnumPatches
1293    "include statistics requiring enumeration of patches"
1294  , RawNoArg [] ["no-enum-patches"] F.NoEnumPatches NoEnumPatches
1295    "don't include statistics requiring enumeration of patches" ]
1296
1297-- ** gzcrcs
1298
1299data GzcrcsAction = GzcrcsCheck | GzcrcsRepair deriving (Eq, Show)
1300
1301gzcrcsActions :: PrimDarcsOption (Maybe GzcrcsAction)
1302gzcrcsActions = withDefault Nothing
1303  [ RawNoArg [] ["check"] F.Check (Just GzcrcsCheck) "Specify checking mode"
1304  , RawNoArg [] ["repair"] F.Repair (Just GzcrcsRepair) "Specify repair mode" ]
1305
1306-- ** optimize
1307
1308siblings :: PrimDarcsOption [AbsolutePath]
1309siblings = multiAbsPathArg [] ["sibling"] F.Sibling mkV "DIRECTORY"
1310    "specify a sibling directory"
1311  where mkV fs = [ s | F.Sibling s <- fs ]
1312