module Darcs.Flags
( DarcsFlag( .. )
, Compression( .. )
, UseIndex(..)
, ScanKnown(..)
, RemoteDarcs(..)
, compression
, remoteDarcs
, diffingOpts
, wantExternalMerge
, wantGuiPause
, isInteractive
, maxCount
, willIgnoreTimes
, willRemoveLogFile
, isUnified
, isNotUnified
, doHappyForwarding
, includeBoring
, doAllowCaseOnly
, doAllowWindowsReserved
, doReverse
, usePacks
, showChangesOnlyToFiles
, rollbackInWorkingDir
, removeFromAmended
, defaultFlag
) where
import Data.List ( find )
import Data.Maybe( fromMaybe, isJust )
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 | Charset 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
| 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
| PauseForGui | NoPauseForGui
| 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 | UseNoWorkingDir | UseWorkingDir
| 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
| NoAmendUnrecord | AmendUnrecord
deriving ( Eq, Show )
data Compression = NoCompression
| GzipCompression
data UseIndex = UseIndex
| IgnoreIndex
data ScanKnown = ScanKnown
| ScanAll
| ScanBoring
data RemoteDarcs = RemoteDarcs String
| DefaultRemoteDarcs
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
diffingOpts :: [DarcsFlag]
-> (UseIndex, ScanKnown)
diffingOpts opts = (index, scan)
where
index = if willIgnoreTimes opts
then IgnoreIndex
else UseIndex
scan =
if LookForAdds `elem` opts
then
if Boring `elem` opts
then ScanBoring
else ScanAll
else ScanKnown
wantExternalMerge :: [DarcsFlag] -> Maybe String
wantExternalMerge [] = Nothing
wantExternalMerge (ExternalMerge c:_) = Just c
wantExternalMerge (_:fs) = wantExternalMerge fs
wantGuiPause :: [DarcsFlag] -> Bool
wantGuiPause fs = (hasDiffCmd || hasExternalMerge) && hasPause
where
hasDiffCmd = any isDiffCmd fs
hasExternalMerge = isJust $ wantExternalMerge fs
isDiffCmd (DiffCmd _) = True
isDiffCmd _ = False
hasPause = maybe True (==PauseForGui) $ find isPauseFlag $ reverse fs
isPauseFlag f = (f==PauseForGui) || (f==NoPauseForGui)
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 = getBoolFlag Packs NoPacks
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
removeFromAmended :: [DarcsFlag] -> Bool
removeFromAmended = getBoolFlag AmendUnrecord NoAmendUnrecord