{-# LANGUAGE OverloadedStrings #-}
module Darcs.UI.Flags
( F.DarcsFlag
( WorkRepoDir
, NewRepo
, UpToPattern
, UpToPatch
, UpToHash
, OnePattern
, OnePatch
, OneHash
)
, remoteDarcs
, diffingOpts
, diffOpts
, scanKnown
, wantGuiPause
, isInteractive
, willRemoveLogFile
, includeBoring
, lookForAdds
, lookForMoves
, lookForReplaces
, setDefault
, allowConflicts
, hasXmlOutput
, hasLogfile
, quiet
, verbose
, enumeratePatches
, fixRemoteRepos
, fixUrl
, fixSubPaths
, maybeFixSubPaths
, getRepourl
, getAuthor
, promptAuthor
, getEasyAuthor
, getSendmailCmd
, fileHelpAuthor
, environmentHelpEmail
, getSubject
, getInReplyTo
, getCc
, environmentHelpSendmail
, getOutput
, getDate
, O.compress
, O.diffAlgorithm
, O.reorder
, O.minimize
, O.editDescription
, O.externalMerge
, O.maxCount
, O.matchAny
, O.withContext
, O.happyForwarding
, O.allowCaseDifferingFilenames
, O.allowWindowsReservedFilenames
, O.changesReverse
, O.usePacks
, O.onlyToFiles
, O.amendUnrecord
, O.verbosity
, O.useCache
, O.useIndex
, O.umask
, O.dryRun
, O.runTest
, O.testChanges
, O.setScriptsExecutable
, O.withWorkingDir
, O.leaveTestDir
, O.remoteRepos
, O.cloneKind
, O.workRepo
, O.patchIndexNo
, O.patchIndexYes
, O.xmlOutput
, O.selectDeps
, O.author
, O.reply
, O.patchFormat
, O.charset
, O.siblings
, O.applyAs
, O.enumPatches
) where
import Prelude ()
import Darcs.Prelude
import Data.List ( nub, intercalate )
import Data.Maybe
( isJust
, maybeToList
, isNothing
, catMaybes
)
import Control.Monad ( unless )
import System.Directory ( doesDirectoryExist, createDirectory )
import System.FilePath.Posix ( (</>) )
import System.Environment ( lookupEnv )
import Darcs.UI.External
( catchall )
import qualified Darcs.UI.Options.Flags as F ( DarcsFlag( .. ) )
import Darcs.UI.Options.Core
import qualified Darcs.UI.Options.All as O
import Darcs.Util.File ( withCurrentDirectory )
import Darcs.Util.Prompt
( askUser
, askUserListItem
)
import Darcs.Util.Lock ( writeTextFile )
import Darcs.Repository.Prefs
( getPreflist
, getGlobal
, globalPrefsDirDoc
, globalPrefsDir
)
import Darcs.Util.Global ( darcsdir )
import Darcs.Util.IsoDate ( getIsoDateTime, cleanLocalDate )
import Darcs.Util.Path
( AbsolutePath
, AbsolutePathOrStd
, SubPath
, toFilePath
, makeSubPathOf
, ioAbsolute
, makeAbsoluteOrStd
)
import Darcs.Util.Printer ( putDocLn, ePutDocLn, text, ($$), (<+>) )
import Darcs.Util.URL ( isValidLocalPath )
import Darcs.Util.Text ( pathlist )
type Config = [F.DarcsFlag]
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 DarcsFlag a Verbosity)
-> Config -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag 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 DarcsFlag a Verbosity)
-> Config -> Verbosity
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a Verbosity
O.verbosity
remoteDarcs :: Config -> O.RemoteDarcs
remoteDarcs :: Config -> RemoteDarcs
remoteDarcs = NetworkOptions -> RemoteDarcs
O.remoteDarcs (NetworkOptions -> RemoteDarcs)
-> (Config -> NetworkOptions) -> Config -> RemoteDarcs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a NetworkOptions)
-> Config -> NetworkOptions
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a NetworkOptions
O.network
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 DarcsFlag a EnumPatches)
-> Config -> EnumPatches
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a EnumPatches
O.enumPatches
diffOpts :: O.UseIndex -> O.LookForAdds -> O.IncludeBoring -> O.DiffAlgorithm -> (O.UseIndex, O.ScanKnown, O.DiffAlgorithm)
diffOpts :: UseIndex
-> LookForAdds
-> IncludeBoring
-> DiffAlgorithm
-> (UseIndex, ScanKnown, DiffAlgorithm)
diffOpts use_index :: UseIndex
use_index look_for_adds :: LookForAdds
look_for_adds include_boring :: IncludeBoring
include_boring diff_alg :: DiffAlgorithm
diff_alg =
(UseIndex
use_index, LookForAdds -> IncludeBoring -> ScanKnown
scanKnown LookForAdds
look_for_adds IncludeBoring
include_boring, DiffAlgorithm
diff_alg)
scanKnown :: O.LookForAdds -> O.IncludeBoring -> O.ScanKnown
scanKnown :: LookForAdds -> IncludeBoring -> ScanKnown
scanKnown O.NoLookForAdds _ = ScanKnown
O.ScanKnown
scanKnown O.YesLookForAdds O.NoIncludeBoring = ScanKnown
O.ScanAll
scanKnown O.YesLookForAdds O.YesIncludeBoring = ScanKnown
O.ScanBoring
diffingOpts :: Config -> (O.UseIndex, O.ScanKnown, O.DiffAlgorithm)
diffingOpts :: Config -> (UseIndex, ScanKnown, DiffAlgorithm)
diffingOpts flags :: Config
flags = UseIndex
-> LookForAdds
-> IncludeBoring
-> DiffAlgorithm
-> (UseIndex, ScanKnown, DiffAlgorithm)
diffOpts (PrimDarcsOption UseIndex
O.useIndex PrimDarcsOption UseIndex -> Config -> UseIndex
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
? Config
flags) (Config -> LookForAdds
lookForAdds Config
flags)
((forall a. PrimOptSpec DarcsOptDescr DarcsFlag a IncludeBoring)
-> Config -> IncludeBoring
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a IncludeBoring
O.includeBoring Config
flags) (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 fs :: 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 String -> Bool
forall a. Maybe a -> Bool
isJust (Maybe String -> Bool)
-> (Config -> Maybe String) -> Config -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExternalDiff -> Maybe String
O.diffCmd (ExternalDiff -> Maybe String)
-> (Config -> ExternalDiff) -> Config -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a ExternalDiff)
-> Config -> ExternalDiff
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a ExternalDiff
O.extDiff
hasExternalMerge :: Config -> Bool
hasExternalMerge = (ExternalMerge -> ExternalMerge -> Bool
forall a. Eq a => a -> a -> Bool
/= ExternalMerge
O.NoExternalMerge) (ExternalMerge -> Bool)
-> (Config -> ExternalMerge) -> Config -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a ExternalMerge)
-> Config -> ExternalMerge
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a ExternalMerge
O.externalMerge
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 DarcsFlag a WantGuiPause)
-> Config -> WantGuiPause
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a WantGuiPause
O.pauseForGui
isInteractive :: Bool -> Config -> Bool
isInteractive :: Bool -> Config -> Bool
isInteractive def :: Bool
def = OptSpec
DarcsOptDescr
DarcsFlag
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
DarcsFlag
(Maybe Bool -> Bool)
(Maybe ChangesFormat -> Maybe Bool -> Bool)
-> OptSpec
DarcsOptDescr
DarcsFlag
(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
DarcsFlag
(Maybe Bool -> Bool)
(Maybe ChangesFormat -> Maybe Bool -> Bool)
PrimDarcsOption (Maybe ChangesFormat)
O.changesFormat OptSpec
DarcsOptDescr
DarcsFlag
(Maybe Bool -> Bool)
(DryRun -> XmlOutput -> Maybe ChangesFormat -> Maybe Bool -> Bool)
-> OptSpec DarcsOptDescr DarcsFlag Bool (Maybe Bool -> Bool)
-> OptSpec
DarcsOptDescr
DarcsFlag
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 DarcsFlag 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 _ _ _ (Just True) = Bool
True
decide _ _ _ (Just False) = Bool
False
decide _ _ (Just O.CountPatches) Nothing = Bool
False
decide _ O.YesXml _ Nothing = Bool
False
decide O.YesDryRun _ _ Nothing = Bool
False
decide _ _ _ 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 DarcsFlag a Logfile)
-> Config -> Logfile
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a Logfile
O.logfile
includeBoring :: Config -> Bool
includeBoring :: Config -> Bool
includeBoring cfg :: Config
cfg = case (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a IncludeBoring)
-> Config -> IncludeBoring
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a IncludeBoring
O.includeBoring Config
cfg of
O.NoIncludeBoring -> Bool
False
O.YesIncludeBoring -> Bool
True
lookForAdds :: Config -> O.LookForAdds
lookForAdds :: Config -> LookForAdds
lookForAdds = LookFor -> LookForAdds
O.adds (LookFor -> LookForAdds)
-> (Config -> LookFor) -> Config -> LookForAdds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a LookFor)
-> Config -> LookFor
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a LookFor
O.lookfor
lookForReplaces :: Config -> O.LookForReplaces
lookForReplaces :: Config -> LookForReplaces
lookForReplaces = LookFor -> LookForReplaces
O.replaces (LookFor -> LookForReplaces)
-> (Config -> LookFor) -> Config -> LookForReplaces
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a LookFor)
-> Config -> LookFor
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a LookFor
O.lookfor
lookForMoves :: Config -> O.LookForMoves
lookForMoves :: Config -> LookForMoves
lookForMoves = LookFor -> LookForMoves
O.moves (LookFor -> LookForMoves)
-> (Config -> LookFor) -> Config -> LookForMoves
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a LookFor)
-> Config -> LookFor
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a LookFor
O.lookfor
setDefault :: Bool -> Config -> O.SetDefault
setDefault :: Bool -> Config -> SetDefault
setDefault defYes :: 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 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 yes :: 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
. (forall a.
PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe AllowConflicts))
-> Config -> Maybe AllowConflicts
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a.
PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe AllowConflicts)
O.conflictsNo
fixRemoteRepos :: AbsolutePath -> Config -> IO Config
fixRemoteRepos :: AbsolutePath -> Config -> IO Config
fixRemoteRepos d :: AbsolutePath
d = (DarcsFlag -> IO DarcsFlag) -> Config -> IO Config
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM DarcsFlag -> IO DarcsFlag
fixRemoteRepo where
fixRemoteRepo :: DarcsFlag -> IO DarcsFlag
fixRemoteRepo (F.RemoteRepo p :: String
p) = String -> DarcsFlag
F.RemoteRepo (String -> DarcsFlag) -> IO String -> IO DarcsFlag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` AbsolutePath -> String -> IO String
fixUrl AbsolutePath
d String
p
fixRemoteRepo f :: DarcsFlag
f = DarcsFlag -> IO DarcsFlag
forall (m :: * -> *) a. Monad m => a -> m a
return DarcsFlag
f
fixUrl :: AbsolutePath -> String -> IO String
fixUrl :: AbsolutePath -> String -> IO String
fixUrl d :: AbsolutePath
d f :: String
f = if String -> Bool
isValidLocalPath String
f
then AbsolutePath -> String
forall a. FilePathLike a => a -> String
toFilePath (AbsolutePath -> String) -> IO AbsolutePath -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` AbsolutePath -> IO AbsolutePath -> IO AbsolutePath
forall p a. FilePathLike p => p -> IO a -> IO a
withCurrentDirectory AbsolutePath
d (String -> IO AbsolutePath
ioAbsolute String
f)
else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
f
maybeFixSubPaths :: (AbsolutePath, AbsolutePath) -> [FilePath] -> IO [Maybe SubPath]
maybeFixSubPaths :: (AbsolutePath, AbsolutePath) -> [String] -> IO [Maybe SubPath]
maybeFixSubPaths (r :: AbsolutePath
r, o :: AbsolutePath
o) fs :: [String]
fs = do
[Maybe SubPath]
fixedFs <- (String -> IO (Maybe SubPath)) -> [String] -> IO [Maybe SubPath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO (Maybe SubPath)
fixit [String]
fs
let bads :: [String]
bads = ([Maybe SubPath], [String]) -> [String]
forall a b. (a, b) -> b
snd (([Maybe SubPath], [String]) -> [String])
-> ([(Maybe SubPath, String)] -> ([Maybe SubPath], [String]))
-> [(Maybe SubPath, String)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Maybe SubPath, String)] -> ([Maybe SubPath], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Maybe SubPath, String)] -> ([Maybe SubPath], [String]))
-> ([(Maybe SubPath, String)] -> [(Maybe SubPath, String)])
-> [(Maybe SubPath, String)]
-> ([Maybe SubPath], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe SubPath, String) -> Bool)
-> [(Maybe SubPath, String)] -> [(Maybe SubPath, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe SubPath -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe SubPath -> Bool)
-> ((Maybe SubPath, String) -> Maybe SubPath)
-> (Maybe SubPath, String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe SubPath, String) -> Maybe SubPath
forall a b. (a, b) -> a
fst) ([(Maybe SubPath, String)] -> [String])
-> [(Maybe SubPath, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ [Maybe SubPath] -> [String] -> [(Maybe SubPath, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe SubPath]
fixedFs [String]
fs
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
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
$ String -> Doc
text "Ignoring non-repository paths:" Doc -> Doc -> Doc
<+> [String] -> Doc
pathlist [String]
bads
[Maybe SubPath] -> IO [Maybe SubPath]
forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe SubPath]
fixedFs
where
fixit :: String -> IO (Maybe SubPath)
fixit p :: String
p = do AbsolutePath
ap <- AbsolutePath -> IO AbsolutePath -> IO AbsolutePath
forall p a. FilePathLike p => p -> IO a -> IO a
withCurrentDirectory AbsolutePath
o (IO AbsolutePath -> IO AbsolutePath)
-> IO AbsolutePath -> IO AbsolutePath
forall a b. (a -> b) -> a -> b
$ String -> IO AbsolutePath
ioAbsolute String
p
case AbsolutePath -> AbsolutePath -> Maybe SubPath
makeSubPathOf AbsolutePath
r AbsolutePath
ap of
Just sp :: SubPath
sp -> Maybe SubPath -> IO (Maybe SubPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SubPath -> IO (Maybe SubPath))
-> Maybe SubPath -> IO (Maybe SubPath)
forall a b. (a -> b) -> a -> b
$ SubPath -> Maybe SubPath
forall a. a -> Maybe a
Just SubPath
sp
Nothing -> do
AbsolutePath
absolutePathByRepodir <- AbsolutePath -> IO AbsolutePath -> IO AbsolutePath
forall p a. FilePathLike p => p -> IO a -> IO a
withCurrentDirectory AbsolutePath
r (IO AbsolutePath -> IO AbsolutePath)
-> IO AbsolutePath -> IO AbsolutePath
forall a b. (a -> b) -> a -> b
$ String -> IO AbsolutePath
ioAbsolute String
p
Maybe SubPath -> IO (Maybe SubPath)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SubPath -> IO (Maybe SubPath))
-> Maybe SubPath -> IO (Maybe SubPath)
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> AbsolutePath -> Maybe SubPath
makeSubPathOf AbsolutePath
r AbsolutePath
absolutePathByRepodir
fixSubPaths :: (AbsolutePath, AbsolutePath) -> [FilePath] -> IO [SubPath]
fixSubPaths :: (AbsolutePath, AbsolutePath) -> [String] -> IO [SubPath]
fixSubPaths fps :: (AbsolutePath, AbsolutePath)
fps fs :: [String]
fs = [SubPath] -> [SubPath]
forall a. Eq a => [a] -> [a]
nub ([SubPath] -> [SubPath])
-> ([Maybe SubPath] -> [SubPath]) -> [Maybe SubPath] -> [SubPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe SubPath] -> [SubPath]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe SubPath] -> [SubPath])
-> IO [Maybe SubPath] -> IO [SubPath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AbsolutePath, AbsolutePath) -> [String] -> IO [Maybe SubPath]
maybeFixSubPaths (AbsolutePath, AbsolutePath)
fps
((String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [String]
fs)
getRepourl :: Config -> Maybe String
getRepourl :: Config -> Maybe String
getRepourl fs :: Config
fs = case (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe String))
-> Config -> Maybe String
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe String)
O.possiblyRemoteRepo Config
fs of
Nothing -> Maybe String
forall a. Maybe a
Nothing
Just d :: String
d -> if Bool -> Bool
not (String -> Bool
isValidLocalPath String
d) then String -> Maybe String
forall a. a -> Maybe a
Just String
d else Maybe String
forall a. Maybe a
Nothing
fileHelpAuthor :: [String]
fileHelpAuthor :: [String]
fileHelpAuthor = [
"Each patch is attributed to its author, usually by email address (for",
"example, `Fred Bloggs <fred@example.net>`). Darcs looks in several",
"places for this author string: the `--author` option, the files",
"`_darcs/prefs/author` (in the repository) and `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
globalPrefsDirDoc String -> String -> String
forall a. [a] -> [a] -> [a]
++ "author` (in your",
"home directory), and the environment variables `$DARCS_EMAIL` and",
"`$EMAIL`. If none of those exist, Darcs will prompt you for an author",
"string and write it to `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
globalPrefsDirDoc String -> String -> String
forall a. [a] -> [a] -> [a]
++ "author`. Note that if you have more",
"than one email address, you can put them all in `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
globalPrefsDirDoc String -> String -> String
forall a. [a] -> [a] -> [a]
++ "author`,",
"one author per line. Darcs will still prompt you for an author, but it",
"allows you to select from the list, or to type in an alternative."
]
environmentHelpEmail :: ([String], [String])
environmentHelpEmail :: ([String], [String])
environmentHelpEmail = (["DARCS_EMAIL","EMAIL"], [String]
fileHelpAuthor)
getAuthor :: Maybe String -> Bool -> IO String
getAuthor :: Maybe String -> Bool -> IO String
getAuthor (Just author :: String
author) _ = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
author
getAuthor Nothing pipe :: Bool
pipe = if Bool
pipe then String -> IO String
askUser "Who is the author? " else Bool -> Bool -> IO String
promptAuthor Bool
True Bool
False
promptAuthor :: Bool
-> Bool
-> IO String
promptAuthor :: Bool -> Bool -> IO String
promptAuthor store :: Bool
store alwaysAsk :: Bool
alwaysAsk = do
[String]
as <- IO [String]
getEasyAuthor
case [String]
as of
[a :: String
a] -> if Bool
alwaysAsk then
Bool -> IO String -> IO String -> IO String
askForAuthor Bool
False ([String] -> IO String
fancyPrompt [String]
as) ([String] -> IO String
fancyPrompt [String]
as)
else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
a
[] -> Bool -> IO String -> IO String -> IO String
askForAuthor Bool
True IO String
shortPrompt IO String
longPrompt
_ -> Bool -> IO String -> IO String -> IO String
askForAuthor Bool
False ([String] -> IO String
fancyPrompt [String]
as) ([String] -> IO String
fancyPrompt [String]
as)
where
shortPrompt :: IO String
shortPrompt = String -> IO String
askUser "What is your email address? "
longPrompt :: IO String
longPrompt = String -> IO String
askUser "What is your email address (e.g. Fred Bloggs <fred@example.net>)? "
fancyPrompt :: [String] -> IO String
fancyPrompt xs :: [String]
xs =
do Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "" Doc -> Doc -> Doc
$$
String -> Doc
text "You have saved the following email addresses to your global settings:"
String
str <- String -> [String] -> IO String
askUserListItem "Please select an email address for this repository: " ([String]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["Other"])
if String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "Other"
then IO String
longPrompt
else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
str
askForAuthor :: Bool -> IO String -> IO String -> IO String
askForAuthor storeGlobal :: Bool
storeGlobal askfn1 :: IO String
askfn1 askfn2 :: IO String
askfn2 = do
Bool
aminrepo <- String -> IO Bool
doesDirectoryExist (String
darcsdir String -> String -> String
</> "prefs")
if Bool
aminrepo Bool -> Bool -> Bool
&& Bool
store then do
String
prefsdir <- if Bool
storeGlobal
then IO String
tryGlobalPrefsDir
else String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
darcsdir String -> String -> String
</> "prefs"
Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> Doc
text "Each patch is attributed to its author, usually by email address (for" Doc -> Doc -> Doc
$$
String -> Doc
text "example, `Fred Bloggs <fred@example.net>'). Darcs could not determine" Doc -> Doc -> Doc
$$
String -> Doc
text "your email address, so you will be prompted for it." Doc -> Doc -> Doc
$$
String -> Doc
text "" Doc -> Doc -> Doc
$$
String -> Doc
text ("Your address will be stored in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prefsdir)
if String
prefsdir String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
darcsdir String -> String -> String
</> "prefs" then
Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> Doc
text "It will be used for all patches you record in ALL repositories." Doc -> Doc -> Doc
$$
String -> Doc
text ("If you move that file to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
darcsdir String -> String -> String
</> "prefs" String -> String -> String
</> "author" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", it will") Doc -> Doc -> Doc
$$
String -> Doc
text "be used for patches recorded in this repository only."
else
Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> Doc
text "It will be used for all patches you record in this repository only." Doc -> Doc -> Doc
$$
String -> Doc
text ("If you move that file to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
globalPrefsDirDoc String -> String -> String
forall a. [a] -> [a] -> [a]
++ "author, it will") Doc -> Doc -> Doc
$$
String -> Doc
text "be used for all patches recorded in ALL repositories."
String
add <- IO String
askfn1
String -> String -> IO ()
forall p. FilePathLike p => p -> String -> IO ()
writeTextFile (String
prefsdir String -> String -> String
</> "author") (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
[String] -> String
unlines ["# " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
line | String
line <- [String]
fileHelpAuthor] String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
add
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
add
else IO String
askfn2
tryGlobalPrefsDir :: IO String
tryGlobalPrefsDir = do
Maybe String
maybeprefsdir <- IO (Maybe String)
globalPrefsDir
case Maybe String
maybeprefsdir of
Nothing -> do
String -> IO ()
putStrLn "WARNING: Global preference directory could not be found."
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String
darcsdir String -> String -> String
</> "prefs"
Just dir :: String
dir -> do Bool
exists <- String -> IO Bool
doesDirectoryExist String
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
$ String -> IO ()
createDirectory String
dir
String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
dir
getEasyAuthor :: IO [String]
getEasyAuthor :: IO [String]
getEasyAuthor =
[IO [String]] -> IO [String]
forall a. [IO [a]] -> IO [a]
firstNotNullIO [ (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take 1 ([String] -> [String])
-> ([String] -> [String]) -> [String] -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [[a]] -> [[a]]
nonblank) ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO [String]
getPreflist "author"
, [String] -> [String]
forall a. [[a]] -> [[a]]
nonblank ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO [String]
getGlobal "author"
, Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String]) -> IO (Maybe String) -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO (Maybe String)
lookupEnv "DARCS_EMAIL"
, Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList (Maybe String -> [String]) -> IO (Maybe String) -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> IO (Maybe String)
lookupEnv "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 (t :: * -> *) a. Foldable t => t a -> Bool
null)
firstNotNullIO :: [IO [a]] -> IO [a]
firstNotNullIO [] = [a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
firstNotNullIO (e :: IO [a]
e:es :: [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 (m :: * -> *) a. Monad m => a -> m a
return []
if [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 (m :: * -> *) a. Monad m => a -> m a
return [a]
v
getDate :: Bool -> IO String
getDate :: Bool -> IO String
getDate hasPipe :: Bool
hasPipe = if Bool
hasPipe then String -> IO String
cleanLocalDate (String -> IO String) -> IO String -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> IO String
askUser "What is the date? "
else IO String
getIsoDateTime
environmentHelpSendmail :: ([String], [String])
environmentHelpSendmail :: ([String], [String])
environmentHelpSendmail = (["SENDMAIL"], [
"On Unix, the `darcs send` command relies on sendmail(8). The",
"`--sendmail-command` or $SENDMAIL environment variable can be used to",
"provide an explicit path to this program; otherwise the standard",
"locations /usr/sbin/sendmail and /usr/lib/sendmail will be tried."])
getSendmailCmd :: Config -> IO String
getSendmailCmd :: Config -> IO String
getSendmailCmd fs :: Config
fs = case (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe String))
-> Config -> Maybe String
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe String)
O.sendmailCmd Config
fs of
Just cmd :: String
cmd -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
cmd
Nothing -> (Maybe String -> String) -> IO (Maybe String) -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "" String -> String
forall a. a -> a
id) (IO (Maybe String) -> IO String) -> IO (Maybe String) -> IO String
forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
lookupEnv "SENDMAIL"
getOutput :: Config -> FilePath -> Maybe AbsolutePathOrStd
getOutput :: Config -> String -> Maybe AbsolutePathOrStd
getOutput fs :: Config
fs fp :: String
fp = (Output -> AbsolutePathOrStd)
-> Maybe Output -> Maybe AbsolutePathOrStd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Output -> AbsolutePathOrStd
go ((forall a. PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe Output))
-> Config -> Maybe Output
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a (Maybe Output)
O.output Config
fs) where
go :: Output -> AbsolutePathOrStd
go (O.Output ap :: AbsolutePathOrStd
ap) = AbsolutePathOrStd
ap
go (O.OutputAutoName ap :: AbsolutePath
ap) = AbsolutePath -> String -> AbsolutePathOrStd
makeAbsoluteOrStd AbsolutePath
ap String
fp
getSubject :: Config -> Maybe String
getSubject :: Config -> Maybe String
getSubject = HeaderFields -> Maybe String
O._subject (HeaderFields -> Maybe String)
-> (Config -> HeaderFields) -> Config -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a HeaderFields)
-> Config -> HeaderFields
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a HeaderFields
O.headerFields
getCc :: Config -> String
getCc :: Config -> String
getCc = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate " , " ([String] -> String) -> (Config -> [String]) -> Config -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderFields -> [String]
O._cc (HeaderFields -> [String])
-> (Config -> HeaderFields) -> Config -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a HeaderFields)
-> Config -> HeaderFields
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a HeaderFields
O.headerFields
getInReplyTo :: Config -> Maybe String
getInReplyTo :: Config -> Maybe String
getInReplyTo = HeaderFields -> Maybe String
O._inReplyTo (HeaderFields -> Maybe String)
-> (Config -> HeaderFields) -> Config -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. PrimOptSpec DarcsOptDescr DarcsFlag a HeaderFields)
-> Config -> HeaderFields
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag 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 DarcsFlag a XmlOutput)
-> Config -> XmlOutput
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag 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 DarcsFlag a Logfile)
-> Config -> Logfile
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr DarcsFlag a Logfile
O.logfile