module Darcs.Flags ( DarcsFlag( .. ),
Compression( .. ), UseIndex(..), ScanKnown(..), RemoteDarcs(..),
compression, remoteDarcs, diffingOpts,
wantExternalMerge, isInteractive,
maxCount, willIgnoreTimes, willRemoveLogFile, isUnified,
isNotUnified, doHappyForwarding, includeBoring,
doAllowCaseOnly, doAllowWindowsReserved, doReverse,
usePacks,
showChangesOnlyToFiles, rollbackInWorkingDir,
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
| GenContext | 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
| RemoteDarcsOpt 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
| Complete | Lazy
| FixFilePath AbsolutePath AbsolutePath | DiffFlags String
| XMLOutput
| ForceReplace
| OnePattern PatchMatch | SeveralPattern PatchMatch
| AfterPattern PatchMatch | UpToPattern PatchMatch
| NonApply | NonVerify | NonForce
| DryRun
| SetDefault Bool | NoSetDefault Bool
| Disable | SetScriptsExecutable | DontSetScriptsExecutable | Bisect
| UseHashedInventory
| UseFormat2
| NoUpdateWorking
| Sibling AbsolutePath | Relink
| OptimizePristine | OptimizeHTTP
| UpgradeFormat
| Files | NoFiles | Directories | NoDirectories
| Pending | NoPending
| PosthookCmd String | NoPosthook | AskPosthook | RunPosthook
| PrehookCmd String | NoPrehook | AskPrehook | RunPrehook
| UMask String
| StoreInMemory | ApplyOnDisk
| NoHTTPPipelining
| Packs | NoPacks
| NoCache
| AllowUnrelatedRepos
| Check | Repair | JustThisRepo
| NullFlag
| RecordRollback | NoRecordRollback
deriving ( Eq, Show )
data Compression = NoCompression | GzipCompression
compression :: [DarcsFlag] -> Compression
compression f | NoCompress `elem` f = NoCompression
| otherwise = GzipCompression
remoteDarcs :: [DarcsFlag] -> RemoteDarcs
remoteDarcs f | (x:_) <- [ c | RemoteDarcsOpt c <- f ] = RemoteDarcs x
| otherwise = DefaultRemoteDarcs
data UseIndex = UseIndex | IgnoreIndex
data ScanKnown = ScanKnown | ScanAll
diffingOpts :: [DarcsFlag] -> (UseIndex, ScanKnown)
diffingOpts opts = (if willIgnoreTimes opts then IgnoreIndex else UseIndex,
if LookForAdds `elem` opts then ScanAll else ScanKnown)
data RemoteDarcs = RemoteDarcs String | DefaultRemoteDarcs
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
isNotUnified :: [DarcsFlag] -> Bool
isNotUnified = getBoolFlag NonUnified Unified
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
usePacks :: [DarcsFlag] -> Bool
usePacks = not . getBoolFlag NoPacks Packs
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
rollbackInWorkingDir :: [DarcsFlag] -> Bool
rollbackInWorkingDir = getBoolFlag NoRecordRollback RecordRollback