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