{-# LANGUAGE OverloadedStrings #-}
module Darcs.UI.Flags
( F.DarcsFlag
, diffingOpts
, wantGuiPause
, isInteractive
, willRemoveLogFile
, setDefault
, allowConflicts
, hasXmlOutput
, hasLogfile
, quiet
, verbose
, enumeratePatches
, fixUrl
, pathsFromArgs
, pathSetFromArgs
, getRepourl
, getAuthor
, promptAuthor
, getEasyAuthor
, getSendmailCmd
, fileHelpAuthor
, environmentHelpEmail
, getSubject
, getInReplyTo
, getCc
, environmentHelpSendmail
, getOutput
, getDate
, workRepo
, withNewRepo
, O.diffAlgorithm
, O.reorder
, O.minimize
, O.editDescription
, O.maxCount
, O.matchAny
, O.withContext
, O.allowCaseDifferingFilenames
, O.allowWindowsReservedFilenames
, O.changesReverse
, O.usePacks
, O.onlyToFiles
, O.amendUnrecord
, O.verbosity
, O.useCache
, O.useIndex
, O.umask
, O.dryRun
, O.testChanges
, O.setScriptsExecutable
, O.withWorkingDir
, O.leaveTestDir
, O.cloneKind
, O.patchIndexNo
, O.patchIndexYes
, O.xmlOutput
, O.selectDeps
, O.author
, O.patchFormat
, O.charset
, O.siblings
, O.applyAs
, O.enumPatches
) where
import Darcs.Prelude
import Data.List ( intercalate )
import Data.List.Ordered ( nubSort )
import Data.Maybe
( isJust
, maybeToList
, isNothing
, catMaybes
)
import Control.Monad ( void, unless )
import System.Directory ( createDirectory, doesDirectoryExist, withCurrentDirectory )
import System.FilePath.Posix ( (</>) )
import System.Environment ( lookupEnv )
import System.Posix.Files ( getSymbolicLinkStatus )
import qualified Darcs.UI.Options.Flags as F ( DarcsFlag )
import Darcs.UI.Options ( Config, (?), (^), oparse, parseFlags, unparseOpt )
import qualified Darcs.UI.Options.All as O
import Darcs.Util.Exception ( catchall, ifDoesNotExistError )
import Darcs.Util.Prompt
( askUser
, askUserListItem
)
import Darcs.Util.Lock ( writeTextFile )
import Darcs.Repository.Flags ( WorkRepo(..) )
import Darcs.Repository.Prefs
( Pref(Author)
, getPreflist
, getGlobal
, globalPrefsDirDoc
, globalPrefsDir
, prefsDirPath
)
import Darcs.Util.IsoDate ( getIsoDateTime, cleanLocalDate )
import Darcs.Util.Path
( AbsolutePath
, AbsolutePathOrStd
, AnchoredPath
, floatSubPath
, inDarcsdir
, ioAbsolute
, makeAbsolute
, makeAbsoluteOrStd
, makeRelativeTo
, toFilePath
)
import Darcs.Util.Printer ( pathlist, putDocLn, text, ($$), (<+>) )
import Darcs.Util.Printer.Color ( ePutDocLn )
import Darcs.Util.URL ( isValidLocalPath )
verbose :: Config -> Bool
verbose :: Config -> Bool
verbose = (Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
O.Verbose) (Verbosity -> Bool) -> (Config -> Verbosity) -> Config -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr Flag a Verbosity)
-> Config -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a Verbosity
forall a. PrimOptSpec DarcsOptDescr Flag a Verbosity
O.verbosity
quiet :: Config -> Bool
quiet :: Config -> Bool
quiet = (Verbosity -> Verbosity -> Bool
forall a. Eq a => a -> a -> Bool
== Verbosity
O.Quiet) (Verbosity -> Bool) -> (Config -> Verbosity) -> Config -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr Flag a Verbosity)
-> Config -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a Verbosity
forall a. PrimOptSpec DarcsOptDescr Flag a Verbosity
O.verbosity
enumeratePatches :: Config -> Bool
enumeratePatches :: Config -> Bool
enumeratePatches = (EnumPatches -> EnumPatches -> Bool
forall a. Eq a => a -> a -> Bool
== EnumPatches
O.YesEnumPatches) (EnumPatches -> Bool) -> (Config -> EnumPatches) -> Config -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr Flag a EnumPatches)
-> Config -> EnumPatches
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a EnumPatches
forall a. PrimOptSpec DarcsOptDescr Flag a EnumPatches
O.enumPatches
diffingOpts :: Config -> O.DiffOpts
diffingOpts :: Config -> DiffOpts
diffingOpts Config
flags =
UseIndex
-> LookForAdds
-> LookForReplaces
-> LookForMoves
-> DiffAlgorithm
-> DiffOpts
O.DiffOpts
(PrimOptSpec DarcsOptDescr Flag a UseIndex
PrimDarcsOption UseIndex
O.useIndex PrimDarcsOption UseIndex -> Config -> UseIndex
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? Config
flags)
(PrimOptSpec DarcsOptDescr Flag a LookForAdds
PrimDarcsOption LookForAdds
O.lookforadds PrimDarcsOption LookForAdds -> Config -> LookForAdds
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? Config
flags)
(PrimOptSpec DarcsOptDescr Flag a LookForReplaces
PrimDarcsOption LookForReplaces
O.lookforreplaces PrimDarcsOption LookForReplaces -> Config -> LookForReplaces
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? Config
flags)
(PrimOptSpec DarcsOptDescr Flag a LookForMoves
PrimDarcsOption LookForMoves
O.lookformoves PrimDarcsOption LookForMoves -> Config -> LookForMoves
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? Config
flags)
(PrimOptSpec DarcsOptDescr Flag a DiffAlgorithm
PrimDarcsOption DiffAlgorithm
O.diffAlgorithm PrimDarcsOption DiffAlgorithm -> Config -> DiffAlgorithm
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? Config
flags)
wantGuiPause :: Config -> O.WantGuiPause
wantGuiPause :: Config -> WantGuiPause
wantGuiPause Config
fs =
if (Config -> Bool
hasDiffCmd Config
fs Bool -> Bool -> Bool
|| Config -> Bool
hasExternalMerge Config
fs) Bool -> Bool -> Bool
&& Config -> Bool
hasPause Config
fs
then WantGuiPause
O.YesWantGuiPause
else WantGuiPause
O.NoWantGuiPause
where
hasDiffCmd :: Config -> Bool
hasDiffCmd = Maybe [Char] -> Bool
forall a. Maybe a -> Bool
isJust (Maybe [Char] -> Bool)
-> (Config -> Maybe [Char]) -> Config -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExternalDiff -> Maybe [Char]
O.diffCmd (ExternalDiff -> Maybe [Char])
-> (Config -> ExternalDiff) -> Config -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr Flag a ExternalDiff)
-> Config -> ExternalDiff
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a ExternalDiff
forall a. PrimOptSpec DarcsOptDescr Flag a ExternalDiff
O.extDiff
hasExternalMerge :: Config -> Bool
hasExternalMerge Config
flags =
case PrimOptSpec DarcsOptDescr Flag a (Maybe AllowConflicts)
PrimDarcsOption (Maybe AllowConflicts)
O.conflictsNo PrimDarcsOption (Maybe AllowConflicts)
-> Config -> Maybe AllowConflicts
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? Config
flags of
Just (O.YesAllowConflicts (O.ExternalMerge [Char]
_)) -> Bool
True
Maybe AllowConflicts
_ -> Bool
False
hasPause :: Config -> Bool
hasPause = (WantGuiPause -> WantGuiPause -> Bool
forall a. Eq a => a -> a -> Bool
== WantGuiPause
O.YesWantGuiPause) (WantGuiPause -> Bool)
-> (Config -> WantGuiPause) -> Config -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr Flag a WantGuiPause)
-> Config -> WantGuiPause
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a WantGuiPause
forall a. PrimOptSpec DarcsOptDescr Flag a WantGuiPause
O.pauseForGui
isInteractive :: Bool -> Config -> Bool
isInteractive :: Bool -> Config -> Bool
isInteractive Bool
def = OptSpec
DarcsOptDescr
Flag
Bool
(DryRun -> XmlOutput -> Maybe ChangesFormat -> Maybe Bool -> Bool)
-> (DryRun
-> XmlOutput -> Maybe ChangesFormat -> Maybe Bool -> Bool)
-> Config
-> Bool
forall (d :: * -> *) f a b. OptSpec d f a b -> b -> [f] -> a
oparse (DarcsOption
(Maybe ChangesFormat -> Maybe Bool -> Bool)
(DryRun -> XmlOutput -> Maybe ChangesFormat -> Maybe Bool -> Bool)
forall a. DarcsOption a (DryRun -> XmlOutput -> a)
O.dryRunXml DarcsOption
(Maybe ChangesFormat -> Maybe Bool -> Bool)
(DryRun -> XmlOutput -> Maybe ChangesFormat -> Maybe Bool -> Bool)
-> OptSpec
DarcsOptDescr
Flag
(Maybe Bool -> Bool)
(Maybe ChangesFormat -> Maybe Bool -> Bool)
-> OptSpec
DarcsOptDescr
Flag
(Maybe Bool -> Bool)
(DryRun -> XmlOutput -> Maybe ChangesFormat -> Maybe Bool -> Bool)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec
DarcsOptDescr
Flag
(Maybe Bool -> Bool)
(Maybe ChangesFormat -> Maybe Bool -> Bool)
PrimDarcsOption (Maybe ChangesFormat)
O.changesFormat OptSpec
DarcsOptDescr
Flag
(Maybe Bool -> Bool)
(DryRun -> XmlOutput -> Maybe ChangesFormat -> Maybe Bool -> Bool)
-> OptSpec DarcsOptDescr Flag Bool (Maybe Bool -> Bool)
-> OptSpec
DarcsOptDescr
Flag
Bool
(DryRun -> XmlOutput -> Maybe ChangesFormat -> Maybe Bool -> Bool)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr Flag Bool (Maybe Bool -> Bool)
PrimDarcsOption (Maybe Bool)
O.interactive) DryRun -> XmlOutput -> Maybe ChangesFormat -> Maybe Bool -> Bool
decide
where
decide :: O.DryRun -> O.XmlOutput -> Maybe O.ChangesFormat -> Maybe Bool -> Bool
decide :: DryRun -> XmlOutput -> Maybe ChangesFormat -> Maybe Bool -> Bool
decide DryRun
_ XmlOutput
_ Maybe ChangesFormat
_ (Just Bool
True) = Bool
True
decide DryRun
_ XmlOutput
_ Maybe ChangesFormat
_ (Just Bool
False) = Bool
False
decide DryRun
_ XmlOutput
_ (Just ChangesFormat
O.CountPatches) Maybe Bool
Nothing = Bool
False
decide DryRun
_ XmlOutput
O.YesXml Maybe ChangesFormat
_ Maybe Bool
Nothing = Bool
False
decide DryRun
O.YesDryRun XmlOutput
_ Maybe ChangesFormat
_ Maybe Bool
Nothing = Bool
False
decide DryRun
_ XmlOutput
_ Maybe ChangesFormat
_ Maybe Bool
Nothing = Bool
def
willRemoveLogFile :: Config -> Bool
willRemoveLogFile :: Config -> Bool
willRemoveLogFile = Logfile -> Bool
O._rmlogfile (Logfile -> Bool) -> (Config -> Logfile) -> Config -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr Flag a Logfile)
-> Config -> Logfile
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a Logfile
forall a. PrimOptSpec DarcsOptDescr Flag a Logfile
O.logfile
setDefault :: Bool -> Config -> O.SetDefault
setDefault :: Bool -> Config -> SetDefault
setDefault Bool
defYes = SetDefault -> (Bool -> SetDefault) -> Maybe Bool -> SetDefault
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SetDefault
def Bool -> SetDefault
noDef (Maybe Bool -> SetDefault)
-> (Config -> Maybe Bool) -> Config -> SetDefault
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimDarcsOption (Maybe Bool) -> Config -> Maybe Bool
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a (Maybe Bool)
PrimDarcsOption (Maybe Bool)
O.setDefault where
def :: SetDefault
def = if Bool
defYes then Bool -> SetDefault
O.YesSetDefault Bool
False else Bool -> SetDefault
O.NoSetDefault Bool
False
noDef :: Bool -> SetDefault
noDef Bool
yes = if Bool
yes then Bool -> SetDefault
O.YesSetDefault Bool
True else Bool -> SetDefault
O.NoSetDefault Bool
True
allowConflicts :: Config -> O.AllowConflicts
allowConflicts :: Config -> AllowConflicts
allowConflicts = AllowConflicts
-> (AllowConflicts -> AllowConflicts)
-> Maybe AllowConflicts
-> AllowConflicts
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AllowConflicts
O.NoAllowConflicts AllowConflicts -> AllowConflicts
forall a. a -> a
id (Maybe AllowConflicts -> AllowConflicts)
-> (Config -> Maybe AllowConflicts) -> Config -> AllowConflicts
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrimDarcsOption (Maybe AllowConflicts)
-> Config -> Maybe AllowConflicts
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a (Maybe AllowConflicts)
PrimDarcsOption (Maybe AllowConflicts)
O.conflictsNo
fixUrl :: AbsolutePath -> String -> IO String
fixUrl :: AbsolutePath -> [Char] -> IO [Char]
fixUrl AbsolutePath
d [Char]
f =
if [Char] -> Bool
isValidLocalPath [Char]
f
then [Char] -> IO [Char] -> IO [Char]
forall a. [Char] -> IO a -> IO a
withCurrentDirectory (AbsolutePath -> [Char]
forall a. FilePathLike a => a -> [Char]
toFilePath AbsolutePath
d) (AbsolutePath -> [Char]
forall a. FilePathLike a => a -> [Char]
toFilePath (AbsolutePath -> [Char]) -> IO AbsolutePath -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> IO AbsolutePath
ioAbsolute [Char]
f)
else [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
f
pathsFromArgs :: (AbsolutePath, AbsolutePath) -> [String] -> IO [AnchoredPath]
pathsFromArgs :: (AbsolutePath, AbsolutePath) -> [[Char]] -> IO [AnchoredPath]
pathsFromArgs (AbsolutePath, AbsolutePath)
fps [[Char]]
args = [Maybe AnchoredPath] -> [AnchoredPath]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe AnchoredPath] -> [AnchoredPath])
-> IO [Maybe AnchoredPath] -> IO [AnchoredPath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AbsolutePath, AbsolutePath) -> [[Char]] -> IO [Maybe AnchoredPath]
maybeFixSubPaths (AbsolutePath, AbsolutePath)
fps [[Char]]
args
pathSetFromArgs :: (AbsolutePath, AbsolutePath)
-> [String]
-> IO (Maybe [AnchoredPath])
pathSetFromArgs :: (AbsolutePath, AbsolutePath)
-> [[Char]] -> IO (Maybe [AnchoredPath])
pathSetFromArgs (AbsolutePath, AbsolutePath)
_ [] = Maybe [AnchoredPath] -> IO (Maybe [AnchoredPath])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [AnchoredPath]
forall a. Maybe a
Nothing
pathSetFromArgs (AbsolutePath, AbsolutePath)
fps [[Char]]
args = do
[AnchoredPath]
pathSet <- [AnchoredPath] -> [AnchoredPath]
forall a. Ord a => [a] -> [a]
nubSort ([AnchoredPath] -> [AnchoredPath])
-> ([Maybe AnchoredPath] -> [AnchoredPath])
-> [Maybe AnchoredPath]
-> [AnchoredPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe AnchoredPath] -> [AnchoredPath]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe AnchoredPath] -> [AnchoredPath])
-> IO [Maybe AnchoredPath] -> IO [AnchoredPath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AbsolutePath, AbsolutePath) -> [[Char]] -> IO [Maybe AnchoredPath]
maybeFixSubPaths (AbsolutePath, AbsolutePath)
fps [[Char]]
args
case [AnchoredPath]
pathSet of
[] -> [Char] -> IO (Maybe [AnchoredPath])
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"No valid arguments were given."
[AnchoredPath]
_ -> Maybe [AnchoredPath] -> IO (Maybe [AnchoredPath])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe [AnchoredPath] -> IO (Maybe [AnchoredPath]))
-> Maybe [AnchoredPath] -> IO (Maybe [AnchoredPath])
forall a b. (a -> b) -> a -> b
$ [AnchoredPath] -> Maybe [AnchoredPath]
forall a. a -> Maybe a
Just [AnchoredPath]
pathSet
maybeFixSubPaths :: (AbsolutePath, AbsolutePath)
-> [String]
-> IO [Maybe AnchoredPath]
maybeFixSubPaths :: (AbsolutePath, AbsolutePath) -> [[Char]] -> IO [Maybe AnchoredPath]
maybeFixSubPaths (AbsolutePath
r, AbsolutePath
o) [[Char]]
fs = do
[Maybe AnchoredPath]
fixedFs <- ([Char] -> IO (Maybe AnchoredPath))
-> [[Char]] -> IO [Maybe AnchoredPath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Maybe AnchoredPath -> Maybe AnchoredPath)
-> IO (Maybe AnchoredPath) -> IO (Maybe AnchoredPath)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe AnchoredPath -> Maybe AnchoredPath
dropInDarcsdir (IO (Maybe AnchoredPath) -> IO (Maybe AnchoredPath))
-> ([Char] -> IO (Maybe AnchoredPath))
-> [Char]
-> IO (Maybe AnchoredPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> IO (Maybe AnchoredPath)
fixit) [[Char]]
fs
let bads :: [[Char]]
bads = ([Maybe AnchoredPath], [[Char]]) -> [[Char]]
forall a b. (a, b) -> b
snd (([Maybe AnchoredPath], [[Char]]) -> [[Char]])
-> ([(Maybe AnchoredPath, [Char])]
-> ([Maybe AnchoredPath], [[Char]]))
-> [(Maybe AnchoredPath, [Char])]
-> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Maybe AnchoredPath, [Char])] -> ([Maybe AnchoredPath], [[Char]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Maybe AnchoredPath, [Char])]
-> ([Maybe AnchoredPath], [[Char]]))
-> ([(Maybe AnchoredPath, [Char])]
-> [(Maybe AnchoredPath, [Char])])
-> [(Maybe AnchoredPath, [Char])]
-> ([Maybe AnchoredPath], [[Char]])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe AnchoredPath, [Char]) -> Bool)
-> [(Maybe AnchoredPath, [Char])] -> [(Maybe AnchoredPath, [Char])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe AnchoredPath -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe AnchoredPath -> Bool)
-> ((Maybe AnchoredPath, [Char]) -> Maybe AnchoredPath)
-> (Maybe AnchoredPath, [Char])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AnchoredPath, [Char]) -> Maybe AnchoredPath
forall a b. (a, b) -> a
fst) ([(Maybe AnchoredPath, [Char])] -> [[Char]])
-> [(Maybe AnchoredPath, [Char])] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Maybe AnchoredPath] -> [[Char]] -> [(Maybe AnchoredPath, [Char])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe AnchoredPath]
fixedFs [[Char]]
fs
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([[Char]] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Char]]
bads) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Doc -> IO ()
ePutDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"Ignoring invalid repository paths:" Doc -> Doc -> Doc
<+> [[Char]] -> Doc
pathlist [[Char]]
bads
[Maybe AnchoredPath] -> IO [Maybe AnchoredPath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe AnchoredPath]
fixedFs
where
dropInDarcsdir :: Maybe AnchoredPath -> Maybe AnchoredPath
dropInDarcsdir (Just AnchoredPath
p) | AnchoredPath -> Bool
inDarcsdir AnchoredPath
p = Maybe AnchoredPath
forall a. Maybe a
Nothing
dropInDarcsdir Maybe AnchoredPath
mp = Maybe AnchoredPath
mp
fixit :: [Char] -> IO (Maybe AnchoredPath)
fixit [Char]
"" = Maybe AnchoredPath -> IO (Maybe AnchoredPath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AnchoredPath
forall a. Maybe a
Nothing
fixit [Char]
p = do
() -> IO () -> IO ()
forall a. a -> IO a -> IO a
ifDoesNotExistError () (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO FileStatus -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Char] -> IO FileStatus
getSymbolicLinkStatus [Char]
p)
Maybe SubPath
msp <- HasCallStack => AbsolutePath -> AbsolutePath -> IO (Maybe SubPath)
AbsolutePath -> AbsolutePath -> IO (Maybe SubPath)
makeRelativeTo AbsolutePath
r (AbsolutePath -> [Char] -> AbsolutePath
makeAbsolute AbsolutePath
o [Char]
p)
case Maybe SubPath
msp of
Just SubPath
sp -> Maybe AnchoredPath -> IO (Maybe AnchoredPath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AnchoredPath -> IO (Maybe AnchoredPath))
-> Maybe AnchoredPath -> IO (Maybe AnchoredPath)
forall a b. (a -> b) -> a -> b
$ SubPath -> Maybe AnchoredPath
floatIt SubPath
sp
Maybe SubPath
Nothing -> do
Maybe SubPath
msp' <- HasCallStack => AbsolutePath -> AbsolutePath -> IO (Maybe SubPath)
AbsolutePath -> AbsolutePath -> IO (Maybe SubPath)
makeRelativeTo AbsolutePath
r (AbsolutePath -> [Char] -> AbsolutePath
makeAbsolute AbsolutePath
r [Char]
p)
case Maybe SubPath
msp' of
Maybe SubPath
Nothing -> Maybe AnchoredPath -> IO (Maybe AnchoredPath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AnchoredPath
forall a. Maybe a
Nothing
Just SubPath
sp' -> Maybe AnchoredPath -> IO (Maybe AnchoredPath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AnchoredPath -> IO (Maybe AnchoredPath))
-> Maybe AnchoredPath -> IO (Maybe AnchoredPath)
forall a b. (a -> b) -> a -> b
$ SubPath -> Maybe AnchoredPath
floatIt SubPath
sp'
floatIt :: SubPath -> Maybe AnchoredPath
floatIt = ([Char] -> Maybe AnchoredPath)
-> (AnchoredPath -> Maybe AnchoredPath)
-> Either [Char] AnchoredPath
-> Maybe AnchoredPath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe AnchoredPath -> [Char] -> Maybe AnchoredPath
forall a b. a -> b -> a
const Maybe AnchoredPath
forall a. Maybe a
Nothing) AnchoredPath -> Maybe AnchoredPath
forall a. a -> Maybe a
Just (Either [Char] AnchoredPath -> Maybe AnchoredPath)
-> (SubPath -> Either [Char] AnchoredPath)
-> SubPath
-> Maybe AnchoredPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SubPath -> Either [Char] AnchoredPath
floatSubPath
getRepourl :: Config -> Maybe String
getRepourl :: Config -> Maybe [Char]
getRepourl Config
fs = case (forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe [Char]))
-> Config -> Maybe [Char]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a (Maybe [Char])
forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe [Char])
O.possiblyRemoteRepo Config
fs of
Maybe [Char]
Nothing -> Maybe [Char]
forall a. Maybe a
Nothing
Just [Char]
d -> if Bool -> Bool
not ([Char] -> Bool
isValidLocalPath [Char]
d) then [Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
d else Maybe [Char]
forall a. Maybe a
Nothing
fileHelpAuthor :: [String]
fileHelpAuthor :: [[Char]]
fileHelpAuthor = [
[Char]
"Each patch is attributed to its author, usually by email address (for",
[Char]
"example, `Fred Bloggs <fred@example.net>`). Darcs looks in several",
[Char]
"places for this author string: the `--author` option, the files",
[Char]
"`_darcs/prefs/author` (in the repository) and `" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
globalPrefsDirDoc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"author` (in your",
[Char]
"home directory), and the environment variables `$DARCS_EMAIL` and",
[Char]
"`$EMAIL`. If none of those exist, Darcs will prompt you for an author",
[Char]
"string and write it to `" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
globalPrefsDirDoc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"author`. Note that if you have more",
[Char]
"than one email address, you can put them all in `" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
globalPrefsDirDoc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"author`,",
[Char]
"one author per line. Darcs will still prompt you for an author, but it",
[Char]
"allows you to select from the list, or to type in an alternative."
]
environmentHelpEmail :: ([String], [String])
environmentHelpEmail :: ([[Char]], [[Char]])
environmentHelpEmail = ([[Char]
"DARCS_EMAIL",[Char]
"EMAIL"], [[Char]]
fileHelpAuthor)
getAuthor :: Maybe String -> Bool -> IO String
getAuthor :: Maybe [Char] -> Bool -> IO [Char]
getAuthor (Just [Char]
author) Bool
_ = [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
author
getAuthor Maybe [Char]
Nothing Bool
pipe =
if Bool
pipe
then [Char] -> IO [Char]
askUser [Char]
"Who is the author? "
else Bool -> Bool -> IO [Char]
promptAuthor Bool
True Bool
False
promptAuthor :: Bool
-> Bool
-> IO String
promptAuthor :: Bool -> Bool -> IO [Char]
promptAuthor Bool
store Bool
alwaysAsk = do
[[Char]]
as <- IO [[Char]]
getEasyAuthor
case [[Char]]
as of
[[Char]
a] -> if Bool
alwaysAsk then
Bool -> IO [Char] -> IO [Char] -> IO [Char]
askForAuthor Bool
False ([[Char]] -> IO [Char]
fancyPrompt [[Char]]
as) ([[Char]] -> IO [Char]
fancyPrompt [[Char]]
as)
else [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
a
[] -> Bool -> IO [Char] -> IO [Char] -> IO [Char]
askForAuthor Bool
True IO [Char]
shortPrompt IO [Char]
longPrompt
[[Char]]
_ -> Bool -> IO [Char] -> IO [Char] -> IO [Char]
askForAuthor Bool
False ([[Char]] -> IO [Char]
fancyPrompt [[Char]]
as) ([[Char]] -> IO [Char]
fancyPrompt [[Char]]
as)
where
shortPrompt :: IO [Char]
shortPrompt = [Char] -> IO [Char]
askUser [Char]
"What is your email address? "
longPrompt :: IO [Char]
longPrompt = [Char] -> IO [Char]
askUser [Char]
"What is your email address (e.g. Fred Bloggs <fred@example.net>)? "
fancyPrompt :: [[Char]] -> IO [Char]
fancyPrompt [[Char]]
xs =
do Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> Doc
text [Char]
"" Doc -> Doc -> Doc
$$
[Char] -> Doc
text [Char]
"You have saved the following email addresses to your global settings:"
[Char]
str <- [Char] -> [[Char]] -> IO [Char]
askUserListItem [Char]
"Please select an email address for this repository: " ([[Char]]
xs [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"Other"])
if [Char]
str [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"Other"
then IO [Char]
longPrompt
else [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
str
askForAuthor :: Bool -> IO [Char] -> IO [Char] -> IO [Char]
askForAuthor Bool
storeGlobal IO [Char]
askfn1 IO [Char]
askfn2 = do
Bool
aminrepo <- [Char] -> IO Bool
doesDirectoryExist [Char]
prefsDirPath
if Bool
aminrepo Bool -> Bool -> Bool
&& Bool
store then do
[Char]
prefsdir <- if Bool
storeGlobal
then IO [Char]
tryGlobalPrefsDir
else [Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
prefsDirPath
Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> Doc
text [Char]
"Each patch is attributed to its author, usually by email address (for" Doc -> Doc -> Doc
$$
[Char] -> Doc
text [Char]
"example, `Fred Bloggs <fred@example.net>'). Darcs could not determine" Doc -> Doc -> Doc
$$
[Char] -> Doc
text [Char]
"your email address, so you will be prompted for it." Doc -> Doc -> Doc
$$
[Char] -> Doc
text [Char]
"" Doc -> Doc -> Doc
$$
[Char] -> Doc
text ([Char]
"Your address will be stored in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
prefsdir)
if [Char]
prefsdir [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Char]
prefsDirPath then
Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> Doc
text [Char]
"It will be used for all patches you record in ALL repositories." Doc -> Doc -> Doc
$$
[Char] -> Doc
text ([Char]
"If you move that file to " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
prefsDirPath [Char] -> [Char] -> [Char]
</> [Char]
"author" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
", it will") Doc -> Doc -> Doc
$$
[Char] -> Doc
text [Char]
"be used for patches recorded in this repository only."
else
Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char] -> Doc
text [Char]
"It will be used for all patches you record in this repository only." Doc -> Doc -> Doc
$$
[Char] -> Doc
text ([Char]
"If you move that file to " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
globalPrefsDirDoc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"author, it will") Doc -> Doc -> Doc
$$
[Char] -> Doc
text [Char]
"be used for all patches recorded in ALL repositories."
[Char]
add <- IO [Char]
askfn1
[Char] -> [Char] -> IO ()
forall p. FilePathLike p => p -> [Char] -> IO ()
writeTextFile ([Char]
prefsdir [Char] -> [Char] -> [Char]
</> [Char]
"author") ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
[[Char]] -> [Char]
unlines [[Char]
"# " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
line | [Char]
line <- [[Char]]
fileHelpAuthor] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
add
[Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
add
else IO [Char]
askfn2
tryGlobalPrefsDir :: IO [Char]
tryGlobalPrefsDir = do
Maybe [Char]
maybeprefsdir <- IO (Maybe [Char])
globalPrefsDir
case Maybe [Char]
maybeprefsdir of
Maybe [Char]
Nothing -> do
[Char] -> IO ()
putStrLn [Char]
"WARNING: Global preference directory could not be found."
[Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
prefsDirPath
Just [Char]
dir -> do Bool
exists <- [Char] -> IO Bool
doesDirectoryExist [Char]
dir
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
createDirectory [Char]
dir
[Char] -> IO [Char]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Char]
dir
getEasyAuthor :: IO [String]
getEasyAuthor :: IO [[Char]]
getEasyAuthor =
[IO [[Char]]] -> IO [[Char]]
forall {a}. [IO [a]] -> IO [a]
firstNotNullIO [ (Int -> [[Char]] -> [[Char]]
forall a. Int -> [a] -> [a]
take Int
1 ([[Char]] -> [[Char]])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall {a}. [[a]] -> [[a]]
nonblank) ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Pref -> IO [[Char]]
getPreflist Pref
Author
, [[Char]] -> [[Char]]
forall {a}. [[a]] -> [[a]]
nonblank ([[Char]] -> [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Pref -> IO [[Char]]
getGlobal Pref
Author
, Maybe [Char] -> [[Char]]
forall a. Maybe a -> [a]
maybeToList (Maybe [Char] -> [[Char]]) -> IO (Maybe [Char]) -> IO [[Char]]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"DARCS_EMAIL"
, Maybe [Char] -> [[Char]]
forall a. Maybe a -> [a]
maybeToList (Maybe [Char] -> [[Char]]) -> IO (Maybe [Char]) -> IO [[Char]]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"EMAIL"
]
where
nonblank :: [[a]] -> [[a]]
nonblank = ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([a] -> Bool) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
firstNotNullIO :: [IO [a]] -> IO [a]
firstNotNullIO [] = [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
firstNotNullIO (IO [a]
e:[IO [a]]
es) = do
[a]
v <- IO [a]
e IO [a] -> IO [a] -> IO [a]
forall a. IO a -> IO a -> IO a
`catchall` [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
if [a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
v then [IO [a]] -> IO [a]
firstNotNullIO [IO [a]]
es else [a] -> IO [a]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
v
getDate :: Bool -> IO String
getDate :: Bool -> IO [Char]
getDate Bool
hasPipe = if Bool
hasPipe then [Char] -> IO [Char]
cleanLocalDate ([Char] -> IO [Char]) -> IO [Char] -> IO [Char]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> IO [Char]
askUser [Char]
"What is the date? "
else IO [Char]
getIsoDateTime
environmentHelpSendmail :: ([String], [String])
environmentHelpSendmail :: ([[Char]], [[Char]])
environmentHelpSendmail = ([[Char]
"SENDMAIL"], [
[Char]
"On Unix, the `darcs send` command relies on sendmail(8). The",
[Char]
"`--sendmail-command` or $SENDMAIL environment variable can be used to",
[Char]
"provide an explicit path to this program; otherwise the standard",
[Char]
"locations /usr/sbin/sendmail and /usr/lib/sendmail will be tried."])
getSendmailCmd :: Config -> IO (Maybe String)
getSendmailCmd :: Config -> IO (Maybe [Char])
getSendmailCmd Config
fs =
case (forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe [Char]))
-> Config -> Maybe [Char]
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a (Maybe [Char])
forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe [Char])
O.sendmailCmd Config
fs of
Maybe [Char]
Nothing -> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"SENDMAIL"
Maybe [Char]
justcmd -> Maybe [Char] -> IO (Maybe [Char])
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Char]
justcmd
getOutput :: Config -> IO FilePath -> Maybe (IO AbsolutePathOrStd)
getOutput :: Config -> IO [Char] -> Maybe (IO AbsolutePathOrStd)
getOutput Config
fs IO [Char]
fp = (Output -> IO AbsolutePathOrStd)
-> Maybe Output -> Maybe (IO AbsolutePathOrStd)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Output -> IO AbsolutePathOrStd
go ((forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe Output))
-> Config -> Maybe Output
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a (Maybe Output)
forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe Output)
O.output Config
fs) where
go :: Output -> IO AbsolutePathOrStd
go (O.Output AbsolutePathOrStd
ap) = AbsolutePathOrStd -> IO AbsolutePathOrStd
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return AbsolutePathOrStd
ap
go (O.OutputAutoName AbsolutePath
ap) = AbsolutePath -> [Char] -> AbsolutePathOrStd
makeAbsoluteOrStd AbsolutePath
ap ([Char] -> AbsolutePathOrStd) -> IO [Char] -> IO AbsolutePathOrStd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Char]
fp
getSubject :: Config -> Maybe String
getSubject :: Config -> Maybe [Char]
getSubject = HeaderFields -> Maybe [Char]
O._subject (HeaderFields -> Maybe [Char])
-> (Config -> HeaderFields) -> Config -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr Flag a HeaderFields)
-> Config -> HeaderFields
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a HeaderFields
forall a. PrimOptSpec DarcsOptDescr Flag a HeaderFields
O.headerFields
getCc :: Config -> String
getCc :: Config -> [Char]
getCc = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
" , " ([[Char]] -> [Char]) -> (Config -> [[Char]]) -> Config -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderFields -> [[Char]]
O._cc (HeaderFields -> [[Char]])
-> (Config -> HeaderFields) -> Config -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr Flag a HeaderFields)
-> Config -> HeaderFields
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a HeaderFields
forall a. PrimOptSpec DarcsOptDescr Flag a HeaderFields
O.headerFields
getInReplyTo :: Config -> Maybe String
getInReplyTo :: Config -> Maybe [Char]
getInReplyTo = HeaderFields -> Maybe [Char]
O._inReplyTo (HeaderFields -> Maybe [Char])
-> (Config -> HeaderFields) -> Config -> Maybe [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr Flag a HeaderFields)
-> Config -> HeaderFields
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a HeaderFields
forall a. PrimOptSpec DarcsOptDescr Flag a HeaderFields
O.headerFields
hasXmlOutput :: Config -> Bool
hasXmlOutput :: Config -> Bool
hasXmlOutput = (XmlOutput -> XmlOutput -> Bool
forall a. Eq a => a -> a -> Bool
== XmlOutput
O.YesXml) (XmlOutput -> Bool) -> (Config -> XmlOutput) -> Config -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr Flag a XmlOutput)
-> Config -> XmlOutput
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a XmlOutput
forall a. PrimOptSpec DarcsOptDescr Flag a XmlOutput
O.xmlOutput
hasLogfile :: Config -> Maybe AbsolutePath
hasLogfile :: Config -> Maybe AbsolutePath
hasLogfile = Logfile -> Maybe AbsolutePath
O._logfile (Logfile -> Maybe AbsolutePath)
-> (Config -> Logfile) -> Config -> Maybe AbsolutePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr Flag a Logfile)
-> Config -> Logfile
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags PrimOptSpec DarcsOptDescr Flag a Logfile
forall a. PrimOptSpec DarcsOptDescr Flag a Logfile
O.logfile
workRepo :: Config -> WorkRepo
workRepo :: Config -> WorkRepo
workRepo = OptSpec
DarcsOptDescr
Flag
WorkRepo
(Maybe [Char] -> Maybe [Char] -> WorkRepo)
-> (Maybe [Char] -> Maybe [Char] -> WorkRepo) -> Config -> WorkRepo
forall (d :: * -> *) f a b. OptSpec d f a b -> b -> [f] -> a
oparse (PrimOptSpec
DarcsOptDescr Flag (Maybe [Char] -> WorkRepo) (Maybe [Char])
forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe [Char])
O.repoDir PrimOptSpec
DarcsOptDescr Flag (Maybe [Char] -> WorkRepo) (Maybe [Char])
-> OptSpec DarcsOptDescr Flag WorkRepo (Maybe [Char] -> WorkRepo)
-> OptSpec
DarcsOptDescr
Flag
WorkRepo
(Maybe [Char] -> Maybe [Char] -> WorkRepo)
forall (d :: * -> *) f b c a.
OptSpec d f b c -> OptSpec d f a b -> OptSpec d f a c
^ OptSpec DarcsOptDescr Flag WorkRepo (Maybe [Char] -> WorkRepo)
forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe [Char])
O.possiblyRemoteRepo) Maybe [Char] -> Maybe [Char] -> WorkRepo
go
where
go :: Maybe [Char] -> Maybe [Char] -> WorkRepo
go (Just [Char]
s) Maybe [Char]
_ = [Char] -> WorkRepo
WorkRepoDir [Char]
s
go Maybe [Char]
Nothing (Just [Char]
s) = [Char] -> WorkRepo
WorkRepoPossibleURL [Char]
s
go Maybe [Char]
Nothing Maybe [Char]
Nothing = WorkRepo
WorkRepoCurrentDir
withNewRepo :: String -> Config -> Config
withNewRepo :: [Char] -> Config -> Config
withNewRepo [Char]
dir = (forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe [Char]))
-> Maybe [Char] -> Config -> Config
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> v -> [f] -> [f]
unparseOpt PrimOptSpec DarcsOptDescr Flag a (Maybe [Char])
forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe [Char])
O.newRepo ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
dir)