File: All.hs

package info (click to toggle)
darcs 2.12.4-2
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 5,748 kB
  • sloc: haskell: 42,936; sh: 11,086; ansic: 837; perl: 129; makefile: 8
file content (1243 lines) | stat: -rw-r--r-- 44,275 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
{-# LANGUAGE RecordWildCards #-}
{- | All the concrete options.

Notes:

  * The term \"option\" refers to a flag or combination of flags that
    together form a part of a command's configuration. Ideally, options
    should be orthogonal to each other, so we can freely combine them.

  * A primitive (indivisible) option has an associate value type.

  * An option named \"xyzActions\" represents a set of flags that act as
    mutually exclusive sub-commands. They typically have a dedicated value
    type named \"XyzAction\".

  * This module is probably best imported qualified. This is in contrast to
    the current practice of using subtly differing names to avoid name
    clashes for closely related items. For instance, the data constructors
    for an option's value type and the corresponding data constructors in
    'F.DarcsFlag' may coincide. This is also why we import "Darcs.UI.Flags"
    qualified here.

  * When the new options system is finally in place, no code other than the
    one for constructing options should directly refer to 'F.DarcsFlag'
    constructors.

-}
module Darcs.UI.Options.All
    ( DarcsOption

    -- root
    , RootAction (..)
    , rootActions

    -- all commands
    , StdCmdAction (..)
    , stdCmdActions
    , debug
    , Verbosity (..) -- re-export
    , verbosity
    , timings
    , anyVerbosity
    , preHook
    , postHook
    , hooks
    , UseCache (..) -- re-export
    , useCache

    -- interactivity
    , XmlOutput (..)
    , xmloutput
    , DryRun (..) -- re-export
    , dryRun
    , dryRunXml
    , interactive
    , pipe
    , WantGuiPause (..) -- re-export
    , pauseForGui
    , askdeps

    -- patch selection
    , module Darcs.UI.Options.Matching -- re-export
    , SelectDeps (..)
    , selectDeps
    , changesReverse
    , matchMaxcount

    -- local or remote repo(s)
    , WorkRepo (..) -- re-export
    , workRepo
    , workingRepoDir
    , RemoteRepos (..) -- re-export
    , remoteRepos
    , possiblyRemoteRepo
    , reponame
    , notInRemote
    , notInRemoteFlagName
    , RepoCombinator (..)
    , repoCombinator
    , allowUnrelatedRepos
    , justThisRepo
    , WithWorkingDir (..) -- re-export
    , useWorkingDir
    , SetDefault (..) -- re-export
    , setDefault

    -- patch meta-data
    , patchname
    , author
    , AskLongComment (..)
    , askLongComment
    , keepDate
    , Logfile (..)
    , logfile

    -- looking for changes
    , LookFor (..)
    , LookForAdds (..) -- re-export
    , LookForMoves (..) -- re-export
    , LookForReplaces (..) -- re-export
    , lookfor

    -- files to consider
    , UseIndex (..) -- re-export
    , ScanKnown (..) -- re-export
    , diffing
    , IncludeBoring (..)
    , includeBoring
    , allowProblematicFilenames
    , allowCaseDifferingFilenames
    , allowWindowsReservedFilenames
    , onlyToFiles
    , useIndex
    , recursive

    -- differences
    , DiffAlgorithm (..) -- re-export
    , diffAlgorithm
    , WithContext (..)
    , withContext
    , unidiff
    , ExternalDiff (..)
    , extDiff

    -- tests
    , TestChanges (..)
    , testChanges
    , RunTest (..) -- re-export
    , test
    , LeaveTestDir (..) -- re-export
    , leaveTestDir

    -- mail related
    , HeaderFields (..)
    , headerFields
    , sendToContext
    , sendmail
    , sendmailCmd
    , charset
    , editDescription
    , ccApply
    , reply
    , happyForwarding

    -- patch bundles
    , applyAs
    , Sign (..)
    , sign
    , Verify (..)
    , verify

    -- merging patches
    , AllowConflicts (..) -- re-export
    , conflicts
    , ExternalMerge (..) -- re-export
    , useExternalMerge

    -- optimizations
    , Compression (..) -- re-export
    , compress
    , usePacks
    , WithPatchIndex (..) -- re-export
    , patchIndex
    , patchIndexYes
    , Reorder (..) -- re-export
    , reorder
    , minimize
    , storeInMemory

    -- miscellaneous
    , Output (..)
    , output
    , Summary (..)
    , summary
    , RemoteDarcs (..) -- re-export
    , NetworkOptions (..)
    , network
    , UMask (..) -- re-export
    , umask
    , SetScriptsExecutable (..) -- re-export
    , setScriptsExecutable
    , restrictPaths

    -- command specific

    -- amend
    , amendUnrecord
    , selectAuthor

    -- annotate
    , humanReadable
    , machineReadable

    -- clone
    , CloneKind (..)
    , partial

    -- dist
    , distname
    , distzip

    -- convert import/export, init
    , marks
    , readMarks
    , writeMarks
    , PatchFormat (..)
    , patchFormat
    , hashed

    -- log
    , ChangesFormat (..)
    , changesFormat

    -- replace
    , tokens
    , forceReplace

    -- test
    , TestStrategy (..)
    , testStrategy

    -- show files/index
    , files
    , directories
    , pending
    , nullFlag

    -- gzcrcs
    , GzcrcsAction (..)
    , gzcrcsActions

    -- optimize
    , siblings
    , reorderPatches
    , optimizePatchIndex
    ) where

import Prelude ()
import Darcs.Prelude

import Prelude hiding ( (^) )
import Data.Char ( isDigit )
import Data.List ( intercalate )
import Data.Maybe ( listToMaybe )

import Darcs.Repository.Flags
    ( Compression (..)
    , RemoteDarcs (..)
    , Reorder (..)
    , Verbosity (..)
    , UseCache (..)
    , UMask (..)
    , DryRun (..)
    , LookForAdds (..)
    , LookForMoves (..)
    , LookForReplaces (..)
    , DiffAlgorithm (..)
    , RunTest (..)
    , SetScriptsExecutable (..)
    , LeaveTestDir (..)
    , RemoteRepos (..)
    , SetDefault (..)
    , UseIndex (..)
    , ScanKnown (..)
    , CloneKind (..)
    , ExternalMerge (..)
    , WorkRepo (..)
    , AllowConflicts (..)
    , WantGuiPause (..)
    , WithPatchIndex (..)
    , WithWorkingDir (..)
    , PatchFormat (..)
    , IncludeBoring (..)
    )

import qualified Darcs.UI.Options.Flags as F ( DarcsFlag(..) )
import Darcs.UI.Options.Core
import Darcs.UI.Options.Iso
import Darcs.UI.Options.Util
import Darcs.UI.Options.Matching

-- * Type instantiations

-- | 'DarcsOption' instantiates the first two type parameters of 'OptSpec' to
-- what we need in darcs. The first parameter is instantiated to
-- The flag type is instantiate to 'Flag'.
type DarcsOption = OptSpec DarcsOptDescr Flag

type RawDarcsOption = forall v. v -> RawOptSpec Flag v

-- * Root command

-- | Options for darcs iself that act like sub-commands.
data RootAction = RootHelp | Version | ExactVersion | ListCommands deriving (Eq, Show)

rootActions :: PrimDarcsOption (Maybe RootAction)
rootActions = withDefault Nothing
  [ RawNoArg ['h'] ["help", "overview"] F.Help (Just RootHelp)
    "show a brief description of all darcs commands and top-level options"
  , RawNoArg ['v'] ["version"] F.Version  (Just Version) "show the darcs version"
  , RawNoArg [] ["exact-version"] F.ExactVersion (Just ExactVersion)
    "show the exact darcs version"
    -- the switch --commands is here for compatibility only
  , RawNoArg [] ["commands","list-options"] F.ListCommands (Just ListCommands)
    "show plain list of available options and commands, for auto-completion"
  ]

-- * Common to all commands

-- ** Standard command actions

data StdCmdAction = Help | ListOptions | Disable deriving (Eq, Show)

stdCmdActions :: PrimDarcsOption (Maybe StdCmdAction)
stdCmdActions = withDefault Nothing
  [ RawNoArg [] ["help"] F.Help (Just Help)
    "show a brief description of the command and its options"
  , RawNoArg [] ["list-options"] F.ListOptions (Just ListOptions)
    "show plain list of available options and commands, for auto-completion"
  , RawNoArg [] ["disable"] F.Disable (Just Disable) "disable this command" ]

-- ** Verbosity related

debug :: PrimDarcsOption Bool
debug = singleNoArg [] ["debug"] F.Debug "give only debug output"

debugHttp :: PrimDarcsOption Bool
debugHttp = singleNoArg [] ["debug-http"] F.DebugHTTP "debug output from libcurl"

verbosity :: PrimDarcsOption Verbosity
verbosity = withDefault NormalVerbosity
  [ RawNoArg ['q'] ["quiet"] F.Quiet Quiet "suppress informational output"
  , RawNoArg [] ["standard-verbosity"] F.NormalVerbosity NormalVerbosity
      "neither verbose nor quiet output"
  , RawNoArg ['v'] ["verbose"] F.Verbose Verbose "give verbose output" ]

timings :: PrimDarcsOption Bool
timings = singleNoArg [] ["timings"] F.Timings "provide debugging timings information"

anyVerbosity :: DarcsOption a (Bool -> Bool -> Verbosity -> Bool -> a)
anyVerbosity = debug ^ debugHttp ^ verbosity ^ timings where

-- ** Hooks

hooks :: DarcsOption a (Maybe String -> Bool -> Maybe String -> Bool -> a)
hooks = preHook ^ postHook

preHook :: DarcsOption a (Maybe String -> Bool -> a)
preHook = prehookCmd ^ hookPrompt "prehook" F.AskPrehook F.RunPrehook

postHook :: DarcsOption a (Maybe String -> Bool -> a)
postHook = posthookCmd ^ hookPrompt "posthook" F.AskPosthook F.RunPosthook

prehookCmd :: PrimDarcsOption (Maybe String)
prehookCmd = withDefault Nothing
    [ RawStrArg [] ["prehook"] F.PrehookCmd unF Just unV
      "COMMAND" "specify command to run before this darcs command"
    , RawNoArg [] ["no-prehook"] F.NoPrehook Nothing
      "don't run prehook command" ]
  where unF f = [ s | F.PrehookCmd s <- [f] ]
        unV v = [ s | Just s <- [v] ]

posthookCmd :: PrimDarcsOption (Maybe String)
posthookCmd = withDefault Nothing
    [ RawStrArg [] ["posthook"] F.PosthookCmd unF Just unV "COMMAND"
      "specify command to run after this darcs command"
    , RawNoArg [] ["no-posthook"] F.NoPosthook Nothing
      "don't run posthook command" ]
  where unF f = [ s | F.PosthookCmd s <- [f] ]
        unV v = [ s | Just s <- [v] ]

hookPrompt :: String -> Flag -> Flag -> PrimDarcsOption Bool
hookPrompt name fask frun = withDefault False
  [ RawNoArg [] ["prompt-"++name] fask True
    ("prompt before running "++name)
  , RawNoArg [] ["run-"++name] frun False
    ("run "++name++" command without prompting") ]

-- ** Misc

useCache :: PrimDarcsOption UseCache
useCache = (imap . cps) (Iso fw bw) $ singleNoArg [] ["no-cache"] F.NoCache "don't use patch caches"
  where
    fw True = NoUseCache
    fw False = YesUseCache
    bw NoUseCache = True
    bw YesUseCache = False

-- * Interactivity related

{- TODO: these options interact (no pun intended) in complex ways that are
very hard to figure out for users as well as maintainers. I think the only
solution here is a more radical (and probably incompatible) re-design
involving all interactivity related options. That is beyond the goals of
this sub-project (which is already large enough).
-}

data XmlOutput = NoXml | YesXml deriving (Eq, Show)

xmloutput :: PrimDarcsOption XmlOutput
xmloutput = withDefault NoXml [__xmloutput YesXml]

__xmloutput :: RawDarcsOption
__xmloutput val = RawNoArg [] ["xml-output"] F.XMLOutput val "generate XML formatted output"

-- | 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.
--
-- See also issue2397.
dryRun :: PrimDarcsOption DryRun
dryRun = (imap . cps) (Iso fw bw) $ singleNoArg [] ["dry-run"] F.DryRun "don't actually take the action"
  where
    fw True = YesDryRun
    fw False = NoDryRun
    bw YesDryRun = True
    bw NoDryRun = False

dryRunXml :: DarcsOption a (DryRun -> XmlOutput -> a)
dryRunXml = dryRun ^ xmloutput

__dryrun :: RawDarcsOption
__dryrun val = RawNoArg [] ["dry-run"] F.DryRun val "don't actually take the action"

pipe :: PrimDarcsOption Bool
pipe = singleNoArg [] ["pipe"] F.Pipe "ask user interactively for the patch metadata"

interactive :: PrimDarcsOption (Maybe Bool)
interactive = withDefault Nothing
  [ RawNoArg ['a'] ["all","no-interactive"] F.All (Just False) "answer yes to all patches"
  , RawNoArg ['i'] ["interactive"] F.Interactive (Just True) "prompt user interactively" ]

pauseForGui :: PrimDarcsOption WantGuiPause
pauseForGui = withDefault YesWantGuiPause
  [ RawNoArg [] ["pause-for-gui"] F.PauseForGui YesWantGuiPause
    "pause for an external diff or merge command to finish"
  , RawNoArg [] ["no-pause-for-gui"] F.NoPauseForGui NoWantGuiPause
    "return immediately after external diff or merge command finishes" ]

askdeps :: PrimDarcsOption Bool
askdeps = withDefault False
  [ RawNoArg [] ["ask-deps"] F.AskDeps True "manually select dependencies"
  , RawNoArg [] ["no-ask-deps"] F.NoAskDeps False "automatically select dependencies" ]

-- * Patch selection related

data SelectDeps = NoDeps | AutoDeps | PromptDeps deriving (Eq, Show)

selectDeps :: PrimDarcsOption SelectDeps
selectDeps = withDefault PromptDeps
  [ RawNoArg [] ["no-deps"] F.DontGrabDeps NoDeps
    "don't automatically fulfill dependencies"
  , RawNoArg [] ["auto-deps","dont-prompt-for-dependencies"] F.DontPromptForDependencies AutoDeps
    "don't ask about patches that are depended on by matched patches (with --match or --patch)"
  , RawNoArg [] ["prompt-deps","prompt-for-dependencies"] F.PromptForDependencies PromptDeps
    "prompt about patches that are depended on by matched patches" ]

changesReverse :: PrimDarcsOption Bool
changesReverse = withDefault False
  [ RawNoArg [] ["reverse"] F.Reverse True "show/consider changes in reverse order"
  , RawNoArg [] ["no-reverse"] F.Forward False "show/consider changes in the usual order" ]

-- | TODO: Returning @-1@ if the argument cannot be parsed as an integer is
-- not something I expected to find in a Haskell program. Instead, the flag
-- should take either a plain 'String' argument (leaving it to a later stage
-- to parse the 'String' to an 'Int'), or else a @'Maybe' 'Int'@, taking
-- the possibility of a failed parse into account.
matchMaxcount :: PrimDarcsOption (Maybe Int)
matchMaxcount = OptSpec {..} where
  ounparse k (Just n) = k [ F.MaxCount n ]
  ounparse k Nothing = k []
  oparse k fs = k $ listToMaybe [ s | F.MaxCount s <- fs ]
  ocheck fs = case [ "--max-count="++show n | F.MaxCount n <- fs ] of
    cfs@(_:_:_) -> ["conflicting flags: " ++ intercalate ", " cfs]
    _ -> []
  odesc = [ strArg [] ["max-count"] (F.MaxCount . toInt) "NUMBER"
    "return only NUMBER results" ]
  toInt s = if not (null s) && all isDigit s then read s else (-1)

-- * Local or remote repo

workRepo :: PrimDarcsOption WorkRepo
workRepo = imap (Iso fw bw) $ workingRepoDir ^ possiblyRemoteRepo where
  fw k (WorkRepoDir s)         = k (Just s) Nothing
  fw k (WorkRepoPossibleURL s) = k Nothing  (Just s)
  fw k WorkRepoCurrentDir      = k Nothing  Nothing
  bw k (Just s) _              = k (WorkRepoDir s)
  bw k Nothing  (Just s)       = k (WorkRepoPossibleURL s)
  bw k Nothing  Nothing        = k WorkRepoCurrentDir

workingRepoDir :: PrimDarcsOption (Maybe String)
workingRepoDir = singleStrArg [] ["repodir"] F.WorkRepoDir arg "DIRECTORY"
    "specify the repository directory in which to run"
  where arg (F.WorkRepoDir s) = Just s
        arg _ = Nothing

-- | @--repodir@ is there for compatibility, should be removed eventually
--
-- IMHO the whole option can disappear; it overlaps with using an extra (non-option)
-- argument, which is how e.g. @darcs get@ is usually invoked.
reponame :: PrimDarcsOption (Maybe String)
reponame = singleStrArg [] ["repo-name","repodir"] F.NewRepo arg "DIRECTORY" "path of output directory"
  where arg (F.NewRepo s) = Just s; arg _ = Nothing

possiblyRemoteRepo :: PrimDarcsOption (Maybe String)
possiblyRemoteRepo = singleStrArg [] ["repo"] F.WorkRepoUrl arg "URL"
    "specify the repository URL"
  where arg (F.WorkRepoUrl s) = Just s
        arg _ = Nothing

remoteRepos :: PrimDarcsOption RemoteRepos
remoteRepos = (imap . cps) (Iso fw bw) $ multiStrArg [] ["remote-repo"] F.RemoteRepo mkV "URL"
    "specify the remote repository URL to work with"
  where mkV fs = [ s | F.RemoteRepo s <- fs ]
        fw ss = RemoteRepos ss
        bw (RemoteRepos ss) = ss

notInRemoteFlagName :: String
notInRemoteFlagName = "not-in-remote"

notInRemote :: PrimDarcsOption [Maybe String]
notInRemote =
    multiOptStrArg [] [notInRemoteFlagName] F.NotInRemote args "URL/PATH" $
        "select all patches not in the default push/pull repository or at "
        ++ "location URL/PATH"
  where
    args fs = [s | F.NotInRemote s <- fs]

data RepoCombinator = Intersection | Union | Complement deriving (Eq, Show)

repoCombinator :: PrimDarcsOption RepoCombinator
repoCombinator = withDefault Union
  [ RawNoArg [] ["intersection"] F.Intersection Intersection
    "take intersection of all repositories"
  , RawNoArg [] ["union"] F.Union Union
    "take union of all repositories"
  , RawNoArg [] ["complement"] F.Complement Complement
    "take complement of repositories (in order listed)" ]

allowUnrelatedRepos :: PrimDarcsOption Bool
allowUnrelatedRepos = singleNoArg [] ["ignore-unrelated-repos"] F.AllowUnrelatedRepos
  "do not check if repositories are unrelated"

justThisRepo :: PrimDarcsOption Bool
justThisRepo = singleNoArg [] ["just-this-repo"] F.JustThisRepo
  "Limit the check or repair to the current repo"

-- | convert, clone, init
useWorkingDir :: PrimDarcsOption WithWorkingDir
useWorkingDir = withDefault WithWorkingDir
  [ RawNoArg [] ["with-working-dir"] F.UseWorkingDir WithWorkingDir
    "Create a working directory (normal repository)"
  , RawNoArg [] ["no-working-dir"] F.UseNoWorkingDir NoWorkingDir
    "Do not create a working directory (bare repository)" ]

setDefault :: PrimDarcsOption (Maybe Bool)
setDefault = withDefault Nothing
  [ RawNoArg [] ["set-default"] F.SetDefault (Just True) "set default repository"
  , RawNoArg [] ["no-set-default"] F.NoSetDefault (Just False) "don't set default repository" ]

-- * Specifying patch meta-data

patchname :: PrimDarcsOption (Maybe String)
patchname = singleStrArg ['m'] ["name"] F.PatchName arg "PATCHNAME"
    "name of patch"
  where arg (F.PatchName s) = Just s
        arg _ = Nothing

author :: PrimDarcsOption (Maybe String)
author = singleStrArg ['A'] ["author"] F.Author arg
    "EMAIL" "specify author id"
  where arg (F.Author s) = Just s
        arg _ = Nothing

data AskLongComment = NoEditLongComment | YesEditLongComment | PromptLongComment
  deriving (Eq, Show)

-- TODO: fix non-default behavior
askLongComment :: PrimDarcsOption (Maybe AskLongComment)
askLongComment = withDefault Nothing
  [ RawNoArg [] ["edit-long-comment"] F.EditLongComment (Just YesEditLongComment)
    "edit the long comment by default"
  , RawNoArg [] ["skip-long-comment"] F.NoEditLongComment (Just NoEditLongComment)
    "don't give a long comment"
  , RawNoArg [] ["prompt-long-comment"] F.PromptLongComment (Just PromptLongComment)
    "prompt for whether to edit the long comment" ]

keepDate :: PrimDarcsOption Bool
keepDate = withDefault False
  [ RawNoArg [] ["keep-date"] F.KeepDate True
   "keep the date of the original patch"
  , RawNoArg [] ["no-keep-date"] F.NoKeepDate False
   "use the current date for the amended patch" ]

-- record, send
data Logfile = Logfile
  { _logfile :: Maybe AbsolutePath
  , _rmlogfile :: Bool
  }

logfile :: PrimDarcsOption Logfile
logfile = imap (Iso fw bw) (__logfile ^ __rmlogfile) where
  fw k (Logfile x y) = k x y
  bw k x y = k (Logfile x y)

__logfile :: PrimDarcsOption (Maybe AbsolutePath)
__logfile = singleAbsPathArg [] ["logfile"] F.LogFile arg "FILE"
    "give patch name and comment in file"
  where arg (F.LogFile s) = Just s
        arg _ = Nothing

__rmlogfile :: PrimDarcsOption Bool
__rmlogfile = withDefault False
  [ RawNoArg [] ["delete-logfile"] F.RmLogFile True
    "delete the logfile when done"
  , RawNoArg [] ["no-delete-logfile"] F.DontRmLogFile False
    "keep the logfile when done" ]

-- * Looking for changes

data LookFor = LookFor
  { adds :: LookForAdds
  , replaces :: LookForReplaces
  , moves :: LookForMoves
  }

lookfor :: PrimDarcsOption LookFor
lookfor = imap (Iso fw bw) (lookforadds ^ lookforreplaces ^ lookformoves) where
  fw k (LookFor a r m) = k a r m
  bw k a r m = k (LookFor a r m)

lookforadds :: PrimDarcsOption LookForAdds
lookforadds = withDefault NoLookForAdds
  [ RawNoArg ['l'] ["look-for-adds"] F.LookForAdds YesLookForAdds
    "look for (non-boring) files that could be added"
  , RawNoArg [] ["dont-look-for-adds","no-look-for-adds"] F.NoLookForAdds NoLookForAdds
    "don't look for any files that could be added" ]

lookforreplaces :: PrimDarcsOption LookForReplaces
lookforreplaces = withDefault NoLookForReplaces
  [ RawNoArg [] ["look-for-replaces"] F.LookForReplaces YesLookForReplaces
    "look for replaces that could be marked"
  , RawNoArg [] ["dont-look-for-replaces","no-look-for-replaces"]
    F.NoLookForReplaces NoLookForReplaces
    "don't look for any replaces" ]

lookformoves :: PrimDarcsOption LookForMoves
lookformoves = withDefault NoLookForMoves
  [ RawNoArg [] ["look-for-moves"] F.LookForMoves YesLookForMoves
   "look for files that may be moved/renamed"
  , RawNoArg [] ["dont-look-for-moves","no-look-for-moves"]
    F.NoLookForMoves NoLookForMoves
   "don't look for any files that could be moved/renamed" ]

-- * Files to consider

diffing :: PrimDarcsOption (UseIndex, ScanKnown, DiffAlgorithm)
diffing = imap (Iso curry3 uncurry3) $ useIndex ^ scanKnown ^ diffAlgorithm
  where
    uncurry3 k x y z = k (x,y,z)
    curry3 k (x,y,z) = k x y z

useIndex :: PrimDarcsOption UseIndex
useIndex = (imap . cps) (Iso fw bw) ignoreTimes where
  fw False = UseIndex
  fw True = IgnoreIndex
  bw UseIndex = False
  bw IgnoreIndex = True

scanKnown :: PrimDarcsOption ScanKnown
scanKnown = imap (Iso fw bw) $ lookforadds ^ includeBoring where
  fw k ScanKnown = k NoLookForAdds NoIncludeBoring
  fw k ScanAll = k YesLookForAdds NoIncludeBoring
  fw k ScanBoring = k YesLookForAdds YesIncludeBoring
  bw k NoLookForAdds _ = k ScanKnown
  bw k YesLookForAdds NoIncludeBoring = k ScanAll
  bw k YesLookForAdds YesIncludeBoring = k ScanBoring

includeBoring :: PrimDarcsOption IncludeBoring
includeBoring = withDefault NoIncludeBoring
  [ RawNoArg [] ["boring"] F.Boring YesIncludeBoring "don't skip boring files"
  , RawNoArg [] ["no-boring"] F.SkipBoring NoIncludeBoring "skip boring files" ]

allowProblematicFilenames :: DarcsOption a (Bool -> Bool -> a)
allowProblematicFilenames = allowCaseDifferingFilenames ^ allowWindowsReservedFilenames

allowCaseDifferingFilenames :: PrimDarcsOption Bool
allowCaseDifferingFilenames = withDefault False
  [ RawNoArg [] ["case-ok"] F.AllowCaseOnly True
    "don't refuse to add files differing only in case"
  , RawNoArg [] ["no-case-ok"] F.DontAllowCaseOnly False
    "refuse to add files whose name differ only in case" ]

allowWindowsReservedFilenames :: PrimDarcsOption Bool
allowWindowsReservedFilenames = withDefault False
  [ RawNoArg [] ["reserved-ok"] F.AllowWindowsReserved True
    "don't refuse to add files with Windows-reserved names"
  , RawNoArg [] ["no-reserved-ok"] F.DontAllowWindowsReserved False
    "refuse to add files with Windows-reserved names" ]

-- | TODO: see issue2395
onlyToFiles :: PrimDarcsOption Bool
onlyToFiles = withDefault False
  [ RawNoArg [] ["only-to-files"] F.OnlyChangesToFiles True
    "show only changes to specified files"
  , RawNoArg [] ["no-only-to-files"] F.ChangesToAllFiles False
    "show changes to all files" ]

ignoreTimes :: PrimDarcsOption Bool
ignoreTimes = withDefault False
  [ RawNoArg [] ["ignore-times"] F.IgnoreTimes True
    "don't trust the file modification times"
  , RawNoArg [] ["no-ignore-times"] F.DontIgnoreTimes False
    "trust modification times to find modified files" ]

recursive :: PrimDarcsOption Bool
recursive = withDefault False
  [ RawNoArg ['r'] ["recursive"] F.Recursive True "recurse into subdirectories"
  , RawNoArg [] ["not-recursive","no-recursive"] F.NoRecursive False ("don't recurse into subdirectories") ]

-- * Differences

diffAlgorithm :: PrimDarcsOption DiffAlgorithm
diffAlgorithm = withDefault PatienceDiff
  [ RawNoArg [] ["myers"] F.UseMyersDiff MyersDiff
    "use myers diff algorithm"
  , RawNoArg [] ["patience"] F.UsePatienceDiff PatienceDiff
    "use patience diff algorithm" ]

data WithContext = NoContext | YesContext deriving (Eq, Show)

withContext :: PrimDarcsOption WithContext
withContext = (imap . cps) (Iso fw bw) $ withDefault False
  [ RawNoArg ['u'] ["unified"] F.Unified True
    "output changes in a darcs-specific format similar to diff -u"
  , RawNoArg  [] ["no-unified"] F.NonUnified False
    "output changes in darcs' usual format" ]
  where fw False = NoContext
        fw True = YesContext
        bw NoContext = False
        bw YesContext = True

unidiff :: PrimDarcsOption Bool
unidiff = withDefault True
  [ RawNoArg ['u'] ["unified"] F.Unified True "pass -u option to diff"
  , RawNoArg  [] ["no-unified"] F.NonUnified False "output patch in diff's dumb format" ]

data ExternalDiff = ExternalDiff { _diffCmd :: Maybe String, _diffOpts :: [String] } deriving (Eq, Show)

extDiff :: PrimDarcsOption ExternalDiff
extDiff = imap (Iso fw bw) $ extDiffCmd ^ extDiffOpts where
  fw k (ExternalDiff cmd opts) = k cmd opts
  bw k cmd opts = k (ExternalDiff cmd opts)

extDiffCmd :: PrimDarcsOption (Maybe String)
extDiffCmd = singleStrArg [] ["diff-command"] F.DiffCmd arg "COMMAND"
    "specify diff command (ignores --diff-opts)"
  where arg (F.DiffCmd s) = Just s
        arg _ = Nothing

extDiffOpts :: PrimDarcsOption [String]
extDiffOpts = multiStrArg [] ["diff-opts"] F.DiffFlags mkV "OPTIONS"
    "options to pass to diff"
  where mkV fs = [ s | F.DiffFlags s <- fs ]

-- * Runnign tests

data TestChanges = NoTestChanges | YesTestChanges LeaveTestDir deriving (Eq)

testChanges :: PrimDarcsOption TestChanges
testChanges = imap (Iso fw bw) $ test ^ leaveTestDir where
  fw k NoTestChanges = k NoRunTest {- undefined -} YesLeaveTestDir
  fw k (YesTestChanges ltd) = k YesRunTest ltd
  bw k NoRunTest _ = k NoTestChanges
  bw k YesRunTest ltd = k (YesTestChanges ltd)

test :: PrimDarcsOption RunTest
test = withDefault NoRunTest
  [ RawNoArg [] ["test"] F.Test YesRunTest "run the test script"
  , RawNoArg [] ["no-test"] F.NoTest NoRunTest "don't run the test script" ]

leaveTestDir :: PrimDarcsOption LeaveTestDir
leaveTestDir = withDefault YesLeaveTestDir
  [ RawNoArg [] ["leave-test-directory"]
    F.LeaveTestDir YesLeaveTestDir "don't remove the test directory"
  , RawNoArg [] ["remove-test-directory"]
    F.NoLeaveTestDir NoLeaveTestDir "remove the test directory" ]

-- * Mail related

data HeaderFields = HeaderFields
  { _to, _cc :: [String]
  , _from, _subject, _inReplyTo :: Maybe String
  }

headerFields :: PrimDarcsOption HeaderFields
headerFields = imap (Iso fw bw) $ to ^ cc ^ from ^ subject ^ inReplyTo where
  fw k (HeaderFields t f c s i) = k t f c s i
  bw k t f c s i = k (HeaderFields t f c s i)

from :: PrimDarcsOption (Maybe String)
from = singleStrArg [] ["from"] F.Author arg
    "EMAIL" "specify email address"
  where arg (F.Author s) = Just s
        arg _ = Nothing

to :: PrimDarcsOption [String]
to = multiStrArg [] ["to"] F.Target mkV "EMAIL" "specify destination email"
  where mkV fs = [ s | F.Target s <- fs ]

cc :: PrimDarcsOption [String]
cc = multiStrArg [] ["cc"] F.Cc mkV "EMAIL" "mail results to additional EMAIL(s)"
  where mkV fs = [ s | F.Cc s <- fs ]

subject :: PrimDarcsOption (Maybe String)
subject = singleStrArg [] ["subject"] F.Subject arg
    "SUBJECT" "specify mail subject"
  where arg (F.Subject s) = Just s
        arg _ = Nothing

inReplyTo :: PrimDarcsOption (Maybe String)
inReplyTo = singleStrArg [] ["in-reply-to"] F.InReplyTo arg
    "EMAIL" "specify in-reply-to header"
  where arg (F.InReplyTo s) = Just s
        arg _ = Nothing

sendToContext :: PrimDarcsOption (Maybe AbsolutePath)
sendToContext = singleAbsPathArg [] ["context"] F.Context arg "FILENAME"
    "send to context stored in FILENAME"
  where arg (F.Context s) = Just s
        arg _ = Nothing

-- TODO: do something about the nonsensical case (False, Just s)
--
-- Some of the tests actually do this (pass --sendmail-command without
-- passing --mail) and it's unclear if it's deliberate or just a historical
-- accident after the issue2204 changes. We should untangle that and
-- perhaps turn this into a single option with an optional argument.
-- The other question to resolve is the interaction with the 'output'
-- options to darcs send.
sendmailIso :: Iso (Bool -> Maybe String -> a) ((Bool, Maybe String) -> a)
sendmailIso = Iso uncurry curry

sendmail :: PrimDarcsOption (Bool, Maybe String)
sendmail = imap sendmailIso $ mail ^ sendmailCmd

mail :: PrimDarcsOption Bool
mail = singleNoArg [] ["mail"] F.Mail "send patch using sendmail"

sendmailCmd :: PrimDarcsOption (Maybe String)
sendmailCmd = singleStrArg [] ["sendmail-command"] F.SendmailCmd arg "COMMAND"
    "specify sendmail command"
  where arg (F.SendmailCmd s) = Just s
        arg _ = Nothing

minimize :: PrimDarcsOption Bool
minimize = withDefault True
  [ RawNoArg [] ["minimize"] F.Minimize True "minimize context of patch bundle"
  , RawNoArg [] ["no-minimize"] F.NoMinimize False ("don't minimize context of patch bundle") ]

charset :: PrimDarcsOption (Maybe String)
charset = singleStrArg [] ["charset"] F.Charset arg
    "CHARSET" "specify mail charset"
  where arg (F.Charset s) = Just s
        arg _ = Nothing

editDescription :: PrimDarcsOption Bool
editDescription = withDefault True
  [ RawNoArg [] ["edit-description"] F.EditDescription True
    "edit the patch bundle description"
  , RawNoArg [] ["dont-edit-description","no-edit-description"] F.NoEditDescription False
    "don't edit the patch bundle description" ]

-- TODO: turn these two into a combined option

ccApply :: PrimDarcsOption (Maybe String)
ccApply = singleStrArg [] ["cc"] F.Cc arg
    "EMAIL" "mail results to additional EMAIL(s). Requires --reply"
  where arg (F.Cc s) = Just s
        arg _ = Nothing

reply :: PrimDarcsOption (Maybe String)
reply = singleStrArg [] ["reply"] F.Reply arg "FROM"
    "reply to email-based patch using FROM address"
  where arg (F.Reply s) = Just s
        arg _ = Nothing

happyForwarding :: PrimDarcsOption Bool
happyForwarding = withDefault False
  [ RawNoArg [] ["happy-forwarding"] F.HappyForwarding True
    "forward unsigned messages without extra header"
  , RawNoArg [] ["no-happy-forwarding"] F.NoHappyForwarding False
    "don't forward unsigned messages without extra header" ]

-- * Patch bundle related

applyAs :: PrimDarcsOption (Maybe String)
applyAs = withDefault Nothing
  [ RawStrArg [] ["apply-as"] F.ApplyAs unF Just unV "USERNAME"
    "apply patch as another user using sudo"
  , RawNoArg [] ["no-apply-as"] F.NonApply Nothing
    "don't use sudo to apply as another user" ]
  where
    unF f = [ s | F.ApplyAs s <- [f] ]
    unV x = [ s | Just s <- [x] ]

data Sign = NoSign | Sign | SignAs String | SignSSL String deriving (Eq, Show)

sign :: PrimDarcsOption Sign
sign = withDefault NoSign
  [ RawNoArg [] ["sign"] F.Sign Sign "sign the patch with your gpg key"
  , RawStrArg [] ["sign-as"] F.SignAs unFSignAs SignAs unSignAs "KEYID"
    "sign the patch with a given keyid"
  , RawStrArg [] ["sign-ssl"] F.SignSSL  unFSignSSL SignSSL unSignSSL "IDFILE"
    "sign the patch using openssl with a given private key"
  , RawNoArg [] ["dont-sign","no-sign"] F.NoSign NoSign "don't sign the patch" ]
  where unFSignAs f = [ s | F.SignAs s <- [f] ]
        unSignAs v = [ s | SignAs s <- [v] ]
        unFSignSSL f = [ s | F.SignSSL s <- [f] ]
        unSignSSL v = [ s | SignSSL s <- [v] ]

data Verify = NoVerify | VerifyKeyring AbsolutePath | VerifySSL AbsolutePath deriving (Eq, Show)

verify :: PrimDarcsOption Verify
verify = withDefault NoVerify
  [ RawAbsPathArg [] ["verify"] F.Verify unFKeyring VerifyKeyring unVKeyring "PUBRING"
    "verify that the patch was signed by a key in PUBRING"
  , RawAbsPathArg [] ["verify-ssl"] F.VerifySSL unFSSL VerifySSL unVSSL "KEYS"
    "verify using openSSL with authorized keys from file KEYS"
  , RawNoArg [] ["no-verify"] F.NonVerify NoVerify
    "don't verify patch signature" ]
  where
    unFKeyring f = [ s | F.Verify s <- [f] ]
    unVKeyring x = [ s | VerifyKeyring s <- [x] ]
    unFSSL f = [ s | F.VerifySSL s <- [f] ]
    unVSSL x = [ s | VerifySSL s <- [x] ]

-- * Merging patches

-- applyConflictOptions = conflicts NoAllowConflicts
-- pullConflictOptions = conflicts YesAllowConflictsAndMark

conflicts :: AllowConflicts -> PrimDarcsOption (Maybe AllowConflicts)
conflicts def = withDefault (Just def)
  [ RawNoArg [] ["mark-conflicts"]
      F.MarkConflicts (Just YesAllowConflictsAndMark) "mark conflicts"
  , RawNoArg [] ["allow-conflicts"]
      F.AllowConflicts (Just YesAllowConflicts) "allow conflicts, but don't mark them"
--   , RawNoArg [] ["no-resolve-conflicts"]
--       NoAllowConflicts "equivalent to --dont-allow-conflicts, for backwards compatibility"
  , RawNoArg [] ["dont-allow-conflicts","no-allow-conflicts","no-resolve-conflicts"]
      F.NoAllowConflicts (Just NoAllowConflicts) "fail if there are patches that would create conflicts"
  , RawNoArg [] ["skip-conflicts"]
      F.SkipConflicts Nothing "filter out any patches that would create conflicts" ]

-- Technically not an isomorphism, see 'sendmailIso'.
useExternalMerge :: PrimDarcsOption ExternalMerge
useExternalMerge = imap (Iso fw bw) $ singleStrArg [] ["external-merge"] F.ExternalMerge arg
    "COMMAND" "use external tool to merge conflicts"
  where
    arg (F.ExternalMerge s) = Just s
    arg _ = Nothing
    bw k (Just s) = k (YesExternalMerge s)
    bw k Nothing = k NoExternalMerge
    fw k (YesExternalMerge s) = k (Just s)
    fw k NoExternalMerge = k Nothing

-- * Optimizations

compress :: PrimDarcsOption Compression
compress = withDefault GzipCompression
  [ RawNoArg [] ["compress"] F.Compress GzipCompression "compress patch data"
  , RawNoArg [] ["dont-compress","no-compress"] F.NoCompress NoCompression "don't compress patch data" ]

usePacks :: PrimDarcsOption Bool
usePacks = withDefault True
  [ RawNoArg [] ["packs"] F.Packs True "use repository packs"
  , RawNoArg [] ["no-packs"] F.NoPacks False "don't use repository packs" ]

-- for init, clone and convert: patch index disabled by default
patchIndex :: PrimDarcsOption WithPatchIndex
patchIndex = withDefault NoPatchIndex [__patchIndex YesPatchIndex, __noPatchIndex NoPatchIndex]

-- for log and annotate: patch index enabled by default
patchIndexYes :: PrimDarcsOption WithPatchIndex
patchIndexYes = withDefault YesPatchIndex [__patchIndex YesPatchIndex, __noPatchIndex NoPatchIndex]

__patchIndex, __noPatchIndex :: RawDarcsOption
__patchIndex val = RawNoArg [] ["with-patch-index"] F.PatchIndexFlag val "build patch index"
__noPatchIndex val = RawNoArg [] ["no-patch-index"] F.NoPatchIndexFlag val "don't build patch index"

-- diff, dist
storeInMemory :: PrimDarcsOption Bool
storeInMemory = withDefault False
  [ RawNoArg [] ["store-in-memory"] F.StoreInMemory True
    "do patch application in memory rather than on disk"
  , RawNoArg [] ["no-store-in-memory"] F.ApplyOnDisk False
    "do patch application on disk" ]

-- * Output

data Output = Output AbsolutePathOrStd
            | OutputAutoName AbsolutePath
            deriving (Eq, Show)

output :: PrimDarcsOption (Maybe Output)
output = withDefault Nothing
    [ RawAbsPathOrStdArg ['o'] ["output"]
      F.Output unOutputF (Just . Output) unOutput
      "FILE" "specify output filename"
    , RawOptAbsPathArg ['O'] ["output-auto-name"]
      F.OutputAutoName unOutputAutoNameF (Just . OutputAutoName) unOutputAutoName
      "." "DIRECTORY"
      "output to automatically named file in DIRECTORY, default: current directory"
    ]
  where
    unOutputF f = [ p | F.Output p <- [f] ]
    unOutput (Just (Output p)) = [p]
    unOutput _ = []
    unOutputAutoNameF f = [ p | F.OutputAutoName p <- [f] ]
    unOutputAutoName (Just (OutputAutoName p)) = [p]
    unOutputAutoName _ = []

-- * Miscellaneous

data Summary = NoSummary | YesSummary deriving (Eq, Show)

summary :: PrimDarcsOption (Maybe Summary)
summary = withDefault Nothing
  [ RawNoArg ['s'] ["summary"] F.Summary (Just YesSummary) "summarize changes"
  , RawNoArg [] ["no-summary"] F.NoSummary (Just NoSummary) "don't summarize changes" ]

-- | TODO: reconsider this grouping of options
data NetworkOptions = NetworkOptions
  { noHttpPipelining :: Bool
  , remoteDarcs :: RemoteDarcs }

networkIso :: Iso (Bool -> Maybe String -> a) (NetworkOptions -> a)
networkIso = Iso fw bw where
  fw k (NetworkOptions x (RemoteDarcs y)) = k x (Just y)
  fw k (NetworkOptions x DefaultRemoteDarcs) = k x Nothing
  bw k x (Just y) = k (NetworkOptions x (RemoteDarcs y))
  bw k x Nothing = k (NetworkOptions x DefaultRemoteDarcs)

network :: PrimDarcsOption NetworkOptions
network = imap networkIso
  $ singleNoArg [] ["no-http-pipelining"] F.NoHTTPPipelining "disable HTTP pipelining"
  ^ singleStrArg [] ["remote-darcs"] F.RemoteDarcsOpt arg "COMMAND"
    "name of the darcs executable on the remote server"
  where arg (F.RemoteDarcsOpt s) = Just s
        arg _ = Nothing

umask :: PrimDarcsOption UMask
umask = (imap . cps) (Iso fw bw) $ singleStrArg [] ["umask"] F.UMask arg "UMASK"
    "specify umask to use when writing"
  where
    arg (F.UMask s) = Just s
    arg _ = Nothing
    fw (Just s) = YesUMask s
    fw Nothing = NoUMask
    bw (YesUMask s) = Just s
    bw NoUMask = Nothing

setScriptsExecutable :: PrimDarcsOption SetScriptsExecutable
setScriptsExecutable = withDefault NoSetScriptsExecutable
  [ RawNoArg [] ["set-scripts-executable"] F.SetScriptsExecutable YesSetScriptsExecutable
    "make scripts executable"
  , RawNoArg [] ["dont-set-scripts-executable","no-set-scripts-executable"]
    F.DontSetScriptsExecutable NoSetScriptsExecutable "don't make scripts executable" ]

restrictPaths :: PrimDarcsOption Bool
restrictPaths = withDefault True
  [ RawNoArg [] ["restrict-paths"] F.RestrictPaths True
    "don't allow darcs to touch external files or repo metadata"
  , RawNoArg [] ["dont-restrict-paths","no-restrict-paths"]
    F.DontRestrictPaths False
    "allow darcs to modify any file or directory (unsafe)" ]

-- * Specific to a single command

-- ** amend

amendUnrecord :: PrimDarcsOption Bool
amendUnrecord = withDefault False
  [ RawNoArg [] ["unrecord"] F.AmendUnrecord True "remove changes from the patch"
  , RawNoArg [] ["record"] F.NoAmendUnrecord False "add more changes to the patch" ]

selectAuthor :: PrimDarcsOption Bool
selectAuthor = singleNoArg [] ["select-author"] F.SelectAuthor
  "select author id from a menu"

-- ** annotate

-- | TODO: These should be mutually exclusive, but are they? The code is almost inscrutable.
humanReadable :: PrimDarcsOption Bool
humanReadable = withDefault False [__humanReadable True]

__humanReadable :: RawDarcsOption
__humanReadable val = RawNoArg [] ["human-readable"] F.HumanReadable val "give human-readable output"

-- | See above.
machineReadable :: PrimDarcsOption Bool
machineReadable = withDefault False [__machineReadable True]

__machineReadable :: RawDarcsOption
__machineReadable val = RawNoArg [] ["machine-readable"] F.MachineReadable val "give machine-readable output"

-- ** clone

partial :: PrimDarcsOption CloneKind
partial = withDefault NormalClone
  [ RawNoArg [] ["lazy"] F.Lazy LazyClone "get patch files only as needed"
  , RawNoArg [] ["complete"] F.Complete CompleteClone "get a complete copy of the repository" ]

-- ** convert import/export

marks :: DarcsOption a (Maybe String -> Maybe String -> a)
marks = readMarks ^ writeMarks

readMarks :: PrimDarcsOption (Maybe String)
readMarks = singleStrArg [] ["read-marks"] F.ReadMarks arg
    "FILE" "continue conversion, previously checkpointed by --write-marks"
  where arg (F.ReadMarks s) = Just s
        arg _ = Nothing

writeMarks :: PrimDarcsOption (Maybe String)
writeMarks = singleStrArg [] ["write-marks"] F.WriteMarks arg
    "FILE" "checkpoint conversion to continue it later"
  where arg (F.WriteMarks s) = Just s
        arg _ = Nothing

-- | Deprecated flag, still present to output an error message.
hashed :: PrimDarcsOption ()
hashed = deprecated
  [ "All repositories are now \"hashed\", so this option was removed."
  , "Use --darcs-1 to get the effect that --hashed had previously." ] $
  [ RawNoArg [] ["hashed"] F.Hashed () "deprecated, use --darcs-1 instead" ]

patchFormat :: PrimDarcsOption PatchFormat
patchFormat = withDefault PatchFormat2
  [ RawNoArg [] ["darcs-2"] F.UseFormat2 PatchFormat2
    "Standard darcs patch format"
  , RawNoArg [] ["darcs-1"] F.UseFormat1 PatchFormat1
    "Older patch format (for compatibility)" ]

-- ** dist

distname :: PrimDarcsOption (Maybe String)
distname = singleStrArg ['d'] ["dist-name"] F.DistName arg "DISTNAME" "name of version"
  where arg (F.DistName s) = Just s
        arg _ = Nothing

distzip :: PrimDarcsOption Bool
distzip = singleNoArg [] ["zip"] F.DistZip "generate zip archive instead of gzip'ed tar"

-- ** log

data ChangesFormat = HumanReadable | MachineReadable | GenContext | GenXml | NumberPatches | CountPatches deriving (Eq, Show)

changesFormat :: PrimDarcsOption (Maybe ChangesFormat)
changesFormat = withDefault Nothing
  [ RawNoArg [] ["context"] F.GenContext (Just GenContext) "give output suitable for get --context"
  , __xmloutput (Just GenXml)
  , __humanReadable (Just HumanReadable)
  , __machineReadable (Just MachineReadable)
  , RawNoArg [] ["number"] F.NumberPatches (Just NumberPatches) "number the changes"
  , RawNoArg [] ["count"] F.Count (Just CountPatches) "output count of changes" ]

-- ** replace

tokens :: PrimDarcsOption (Maybe String)
tokens = singleStrArg [] ["token-chars"] F.Toks arg "\"[CHARS]\""
    "define token to contain these characters"
  where arg (F.Toks s) = Just s; arg _ = Nothing

forceReplace :: PrimDarcsOption Bool
forceReplace = withDefault False
  [ RawNoArg ['f'] ["force"] F.ForceReplace True
    "proceed with replace even if 'new' token already exists"
  , RawNoArg [] ["no-force"] F.NonForce False
    "don't force the replace if it looks scary" ]

-- ** test

data TestStrategy = Once | Linear | Backoff | Bisect deriving (Eq, Show)

testStrategy :: PrimDarcsOption TestStrategy
testStrategy = withDefault Once
  [ RawNoArg [] ["once"] F.Once Once "run test on current version only"
  , RawNoArg [] ["linear"] F.Linear Linear "locate the most recent version lacking an error"
  , RawNoArg [] ["backoff"] F.Backoff Backoff "exponential backoff search"
  , RawNoArg [] ["bisect"] F.Bisect Bisect "binary instead of linear search" ]

-- ** show files/index

files :: PrimDarcsOption Bool
files = withDefault True
  [ RawNoArg [] ["files"] F.Files True "include files in output"
  , RawNoArg [] ["no-files"] F.NoFiles False "don't include files in output" ]

directories :: PrimDarcsOption Bool
directories = withDefault True
  [ RawNoArg [] ["directories"] F.Directories True "include directories in output"
  , RawNoArg [] ["no-directories"] F.NoDirectories False "don't include directories in output" ]

pending :: PrimDarcsOption Bool
pending = withDefault True
  [ RawNoArg [] ["pending"] F.Pending True "reflect pending patches in output"
  , RawNoArg [] ["no-pending"] F.NoPending False "only included recorded patches in output" ]

-- "null" is already taken
nullFlag :: PrimDarcsOption Bool
nullFlag = singleNoArg ['0'] ["null"] F.NullFlag "separate file names by NUL characters"

-- ** gzcrcs

data GzcrcsAction = GzcrcsCheck | GzcrcsRepair deriving (Eq, Show)

gzcrcsActions :: PrimDarcsOption (Maybe GzcrcsAction)
gzcrcsActions = withDefault Nothing
  [ RawNoArg [] ["check"] F.Check (Just GzcrcsCheck) "Specify checking mode"
  , RawNoArg [] ["repair"] F.Repair (Just GzcrcsRepair) "Specify repair mode" ]

-- ** optimize

siblings :: PrimDarcsOption [AbsolutePath]
siblings = multiAbsPathArg [] ["sibling"] F.Sibling mkV "URL" "specify a sibling directory"
  where mkV fs = [ s | F.Sibling s <- fs ]

reorderPatches :: PrimDarcsOption Bool
reorderPatches = singleNoArg [] ["reorder-patches"] F.Reorder "reorder the patches in the repository"

reorder :: PrimDarcsOption Reorder
reorder = withDefault NoReorder
  [ RawNoArg [] ["reorder-patches"] F.Reorder Reorder
    "reorder the patches in the repository"
  , RawNoArg [] ["no-reorder-patches"] F.NoReorder NoReorder
    "don't reorder the patches in the repository" ]

optimizePatchIndex :: PrimDarcsOption (Maybe WithPatchIndex)
optimizePatchIndex = withDefault Nothing
  [ __patchIndex (Just YesPatchIndex)
  , __noPatchIndex (Just NoPatchIndex) ]