module Darcs.Flags ( DarcsFlag( .. ), Compression( .. ), compression,
wantExternalMerge, isInteractive,
maxCount, willIgnoreTimes, willRemoveLogFile, isUnified,
willStoreInMemory, doHappyForwarding, includeBoring,
doAllowCaseOnly, doAllowWindowsReserved, doReverse,
showChangesOnlyToFiles,
defaultFlag,
) where
import Data.Maybe( fromMaybe )
import Darcs.Patch.MatchData ( PatchMatch )
import Darcs.RepoPath ( AbsolutePath, AbsolutePathOrStd )
data DarcsFlag = Help | ListOptions | NoTest | Test
| OnlyChangesToFiles | ChangesToAllFiles
| LeaveTestDir | NoLeaveTestDir
| Timings | Debug | DebugVerbose | DebugHTTP
| Verbose | NormalVerbosity | Quiet
| Target String | Cc String
| Output AbsolutePathOrStd | OutputAutoName AbsolutePath
| Subject String | InReplyTo String
| SendmailCmd String | Author String | PatchName String
| OnePatch String | SeveralPatch String
| AfterPatch String | UpToPatch String
| TagName String | LastN Int | MaxCount Int | PatchIndexRange Int Int
| NumberPatches
| OneTag String | AfterTag String | UpToTag String
| Context AbsolutePath | Count
| LogFile AbsolutePath | RmLogFile | DontRmLogFile
| DistName String | All
| Recursive | NoRecursive | Reorder
| RestrictPaths | DontRestrictPaths
| AskDeps | NoAskDeps | IgnoreTimes | DontIgnoreTimes
| LookForAdds | NoLookForAdds
| AnyOrder | CreatorHash String
| Intersection | Union | Complement
| Sign | SignAs String | NoSign | SignSSL String
| HappyForwarding | NoHappyForwarding
| Verify AbsolutePath | VerifySSL AbsolutePath
| SSHControlMaster | NoSSHControlMaster
| RemoteDarcs String
| EditDescription | NoEditDescription
| Toks String
| EditLongComment | NoEditLongComment | PromptLongComment
| KeepDate | NoKeepDate
| AllowConflicts | MarkConflicts | NoAllowConflicts
| SkipConflicts
| Boring | SkipBoring
| AllowCaseOnly | DontAllowCaseOnly
| AllowWindowsReserved | DontAllowWindowsReserved
| DontGrabDeps | DontPromptForDependencies | PromptForDependencies
| Compress | NoCompress | UnCompress
| WorkRepoDir String | WorkRepoUrl String | RemoteRepo String
| NewRepo String
| Reply String | ApplyAs String
| MachineReadable | HumanReadable
| Pipe | Interactive
| DiffCmd String
| ExternalMerge String | Summary | NoSummary
| Unified | NonUnified | Reverse | Forward
| Partial | Complete | Lazy | Ephemeral
| FixFilePath AbsolutePath AbsolutePath | DiffFlags String
| XMLOutput
| ForceReplace
| OnePattern PatchMatch | SeveralPattern PatchMatch
| AfterPattern PatchMatch | UpToPattern PatchMatch
| NonApply | NonVerify | NonForce
| DryRun | SetDefault | NoSetDefault
| FancyMoveAdd | NoFancyMoveAdd
| Disable | SetScriptsExecutable | DontSetScriptsExecutable | Bisect
| UseHashedInventory | UseOldFashionedInventory
| UseFormat2
| PristinePlain | PristineNone | NoUpdateWorking
| Sibling AbsolutePath | Relink | RelinkPristine | NoLinks
| OptimizePristine | OptimizeHTTP
| UpgradeFormat
| Files | NoFiles | Directories | NoDirectories
| Pending | NoPending
| PosthookCmd String | NoPosthook | AskPosthook | RunPosthook
| PrehookCmd String | NoPrehook | AskPrehook | RunPrehook
| UMask String
| StoreInMemory | ApplyOnDisk
| NoHTTPPipelining
| NoCache
| AllowUnrelatedRepos
| Check | Repair | JustThisRepo
| NullFlag
deriving ( Eq, Show )
data Compression = NoCompression | GzipCompression
compression :: [DarcsFlag] -> Compression
compression f | NoCompress `elem` f = NoCompression
| otherwise = GzipCompression
wantExternalMerge :: [DarcsFlag] -> Maybe String
wantExternalMerge [] = Nothing
wantExternalMerge (ExternalMerge c:_) = Just c
wantExternalMerge (_:fs) = wantExternalMerge fs
isInteractive :: [DarcsFlag] -> Bool
isInteractive = isInteractive_ True
where
isInteractive_ def [] = def
isInteractive_ _ (Interactive:_) = True
isInteractive_ _ (All:_) = False
isInteractive_ _ (DryRun:fs) = isInteractive_ False fs
isInteractive_ def (_:fs) = isInteractive_ def fs
maxCount :: [DarcsFlag] -> Maybe Int
maxCount (MaxCount n : _) = Just n
maxCount (_:xs) = maxCount xs
maxCount [] = Nothing
lastWord :: [(DarcsFlag,a)] -> a -> [DarcsFlag] -> a
lastWord known_flags = foldr . flip $ \ def -> fromMaybe def . flip lookup known_flags
getBoolFlag :: DarcsFlag -> DarcsFlag -> [DarcsFlag] -> Bool
getBoolFlag t f = lastWord [(t, True), (f, False)] False
willIgnoreTimes :: [DarcsFlag] -> Bool
willIgnoreTimes = getBoolFlag IgnoreTimes DontIgnoreTimes
willRemoveLogFile :: [DarcsFlag] -> Bool
willRemoveLogFile = getBoolFlag RmLogFile DontRmLogFile
isUnified :: [DarcsFlag] -> Bool
isUnified = getBoolFlag Unified NonUnified
willStoreInMemory :: [DarcsFlag] -> Bool
willStoreInMemory = getBoolFlag Unified NonUnified
doHappyForwarding :: [DarcsFlag] -> Bool
doHappyForwarding = getBoolFlag HappyForwarding NoHappyForwarding
includeBoring :: [DarcsFlag] -> Bool
includeBoring = getBoolFlag Boring SkipBoring
doAllowCaseOnly :: [DarcsFlag] -> Bool
doAllowCaseOnly = getBoolFlag AllowCaseOnly DontAllowCaseOnly
doAllowWindowsReserved :: [DarcsFlag] -> Bool
doAllowWindowsReserved = getBoolFlag AllowWindowsReserved DontAllowWindowsReserved
doReverse :: [DarcsFlag] -> Bool
doReverse = getBoolFlag Reverse Forward
showChangesOnlyToFiles :: [DarcsFlag] -> Bool
showChangesOnlyToFiles = getBoolFlag OnlyChangesToFiles ChangesToAllFiles
defaultFlag :: [DarcsFlag]
-> DarcsFlag
-> [DarcsFlag]
-> [DarcsFlag]
defaultFlag alts def flags =
if any (`elem` flags) alts then flags else def : flags