-- Copyright (C) 2002-2004 David Roundy
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; see the file COPYING.  If not, write to
-- the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-- Boston, MA 02110-1301, USA.

{-# LANGUAGE OverloadedStrings #-}
-- | Helper functions to access option contents. Some of them are here only to
-- ease the transition from the legacy system where we manually parsed the flag
-- list to the new(er) option system. At some point this module should be
-- renamed and the re-exports from "Darcs.UI.Options.All" removed.
module Darcs.UI.Flags
    ( F.DarcsFlag
    , remoteDarcs
    , diffingOpts
    , diffOpts
    , scanKnown
    , wantGuiPause
    , isInteractive
    , willRemoveLogFile
    , includeBoring
    , lookForAdds
    , lookForMoves
    , lookForReplaces
    , setDefault
    , allowConflicts
    , hasXmlOutput
    , hasLogfile
    , quiet
    , verbose
    , enumeratePatches

    , fixRemoteRepos
    , fixUrl
    , pathsFromArgs
    , pathSetFromArgs
    , getRepourl
    , getAuthor
    , promptAuthor
    , getEasyAuthor
    , getSendmailCmd
    , fileHelpAuthor
    , environmentHelpEmail
    , getSubject
    , getInReplyTo
    , getCc
    , environmentHelpSendmail
    , getOutput
    , getDate
    , workRepo
    , withNewRepo

    -- * Re-exports
    , O.compress
    , O.diffAlgorithm
    , O.reorder
    , O.minimize
    , O.editDescription
    , O.externalMerge
    , 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.runTest
    , O.testChanges
    , O.setScriptsExecutable
    , O.withWorkingDir
    , O.leaveTestDir
    , O.remoteRepos
    , 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 ( unless )
import System.Directory ( doesDirectoryExist, createDirectory )
import System.FilePath.Posix ( (</>) )
import System.Environment ( lookupEnv )

-- Use of RemoteRepo data constructor is harmless here, if not ideal.
-- See haddocks for fixRemoteRepos below for details.
import qualified Darcs.UI.Options.Flags as F ( DarcsFlag(RemoteRepo) )
import Darcs.UI.Options ( Config, (?), (^), oparse, parseFlags, unparseOpt )
import qualified Darcs.UI.Options.All as O

import Darcs.Util.Exception ( catchall )
import Darcs.Util.File ( withCurrentDirectory )
import Darcs.Util.Prompt
    ( askUser
    , askUserListItem
    )
import Darcs.Util.Lock ( writeTextFile )
import Darcs.Repository.Flags ( WorkRepo(..) )
import Darcs.Repository.Prefs
    ( getPreflist
    , getGlobal
    , globalPrefsDirDoc
    , globalPrefsDir
    , prefsDirPath
    )
import Darcs.Util.IsoDate ( getIsoDateTime, cleanLocalDate )
import Darcs.Util.Path
    ( AbsolutePath
    , AbsolutePathOrStd
    , toFilePath
    , makeSubPathOf
    , ioAbsolute
    , makeAbsoluteOrStd
    , AnchoredPath
    , floatSubPath
    , inDarcsdir
    )
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 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 forall a. PrimOptSpec DarcsOptDescr Flag 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 Flag a NetworkOptions)
-> Config -> NetworkOptions
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag 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 Flag a EnumPatches)
-> Config -> EnumPatches
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag 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 UseIndex
use_index LookForAdds
look_for_adds IncludeBoring
include_boring DiffAlgorithm
diff_alg =
    (UseIndex
use_index, LookForAdds -> IncludeBoring -> ScanKnown
scanKnown LookForAdds
look_for_adds IncludeBoring
include_boring, DiffAlgorithm
diff_alg)

-- | Non-trivial interaction between options.
scanKnown :: O.LookForAdds -> O.IncludeBoring -> O.ScanKnown
scanKnown :: LookForAdds -> IncludeBoring -> ScanKnown
scanKnown LookForAdds
O.NoLookForAdds IncludeBoring
_ = ScanKnown
O.ScanKnown
scanKnown LookForAdds
O.YesLookForAdds IncludeBoring
O.NoIncludeBoring = ScanKnown
O.ScanAll
scanKnown LookForAdds
O.YesLookForAdds IncludeBoring
O.YesIncludeBoring = ScanKnown
O.ScanBoring

diffingOpts :: Config -> (O.UseIndex, O.ScanKnown, O.DiffAlgorithm)
diffingOpts :: Config -> (UseIndex, ScanKnown, DiffAlgorithm)
diffingOpts 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 Flag a IncludeBoring)
-> Config -> IncludeBoring
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag 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)

-- | This will become dis-entangled as soon as we inline these functions.
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 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 Flag a ExternalDiff)
-> Config -> ExternalDiff
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag 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 Flag a ExternalMerge)
-> Config -> ExternalMerge
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag 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 Flag a WantGuiPause)
-> Config -> WantGuiPause
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag a WantGuiPause
O.pauseForGui

-- | Non-trivial interaction between options. Explicit @-i@ or @-a@ dominates,
-- else @--count@, @--xml@, or @--dry-run@ imply @-a@, else use the def argument.
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 forall a. PrimOptSpec DarcsOptDescr Flag a Logfile
O.logfile

includeBoring :: Config -> Bool
includeBoring :: Config -> Bool
includeBoring Config
cfg = case (forall a. PrimOptSpec DarcsOptDescr Flag a IncludeBoring)
-> Config -> IncludeBoring
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag a IncludeBoring
O.includeBoring Config
cfg of
  IncludeBoring
O.NoIncludeBoring -> Bool
False
  IncludeBoring
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 Flag a LookFor)
-> Config -> LookFor
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag 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 Flag a LookFor)
-> Config -> LookFor
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag 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 Flag a LookFor)
-> Config -> LookFor
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag a LookFor
O.lookfor

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 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
. (forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe AllowConflicts))
-> Config -> Maybe AllowConflicts
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe AllowConflicts)
O.conflictsNo

-- | Ugly. The alternative is to put the remoteRepos accessor into the IO monad,
-- which is hardly better.
-- However, accessing the flag list directly here is benign, as we only map
-- over the list and don't change the order.
fixRemoteRepos :: AbsolutePath -> Config -> IO Config
fixRemoteRepos :: AbsolutePath -> Config -> IO Config
fixRemoteRepos AbsolutePath
d = (Flag -> IO Flag) -> Config -> IO Config
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Flag -> IO Flag
fixRemoteRepo where
  fixRemoteRepo :: Flag -> IO Flag
fixRemoteRepo (F.RemoteRepo String
p) = String -> Flag
F.RemoteRepo (String -> Flag) -> IO String -> IO Flag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` AbsolutePath -> String -> IO String
fixUrl AbsolutePath
d String
p
  fixRemoteRepo Flag
f = Flag -> IO Flag
forall (m :: * -> *) a. Monad m => a -> m a
return Flag
f

-- | 'fixUrl' takes a String that may be a file path or a URL.
-- It returns either the URL, or an absolute version of the path.
fixUrl :: AbsolutePath -> String -> IO String
fixUrl :: AbsolutePath -> String -> IO String
fixUrl AbsolutePath
d 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

-- TODO move the following four functions somewhere else,
-- they have nothing to do with flags

-- | Used by commands that expect arguments to be paths in the current repo.
-- Invalid paths are dropped and a warning is issued. This may leave no valid
-- paths to return. Although these commands all fail if there are no remaining
-- valid paths, they do so in various different ways, issuing error messages
-- tailored to the command.
pathsFromArgs :: (AbsolutePath, AbsolutePath) -> [String] -> IO [AnchoredPath]
pathsFromArgs :: (AbsolutePath, AbsolutePath) -> [String] -> IO [AnchoredPath]
pathsFromArgs (AbsolutePath, AbsolutePath)
fps [String]
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) -> [String] -> IO [Maybe AnchoredPath]
maybeFixSubPaths (AbsolutePath, AbsolutePath)
fps [String]
args

-- | Used by commands that interpret a set of optional path arguments as
-- "restrict to these paths", which affects patch selection (e.g. in log
-- command) or selection of subtrees (e.g. in record). Because of the special
-- meaning of "no arguments", we must distinguish it from "no valid arguments".
-- A result of 'Nothing' here means "no restriction to the set of paths". If
-- 'Just' is returned, the set is guaranteed to be non-empty.
pathSetFromArgs :: (AbsolutePath, AbsolutePath)
                -> [String]
                -> IO (Maybe [AnchoredPath])
pathSetFromArgs :: (AbsolutePath, AbsolutePath)
-> [String] -> IO (Maybe [AnchoredPath])
pathSetFromArgs (AbsolutePath, AbsolutePath)
_ [] = Maybe [AnchoredPath] -> IO (Maybe [AnchoredPath])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [AnchoredPath]
forall a. Maybe a
Nothing
pathSetFromArgs (AbsolutePath, AbsolutePath)
fps [String]
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) -> [String] -> IO [Maybe AnchoredPath]
maybeFixSubPaths (AbsolutePath, AbsolutePath)
fps [String]
args
  case [AnchoredPath]
pathSet of
    [] -> String -> IO (Maybe [AnchoredPath])
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No valid arguments were given."
    [AnchoredPath]
_ -> Maybe [AnchoredPath] -> IO (Maybe [AnchoredPath])
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 (repo_path, orig_path) file_paths@ tries to turn
-- @file_paths@ into 'SubPath's, taking into account the repository path and
-- the original path from which darcs was invoked.
--
-- A 'SubPath' is a path /under/ (or inside) the repo path. This does /not/
-- mean it must exist as a file or directory, nor that the path has been added
-- to the repository; it merely means that it /could/ be added.
--
-- When converting a relative path to an absolute one, this function first tries
-- to interpret the relative path with respect to the current working directory.
-- If that fails, it tries to interpret it with respect to the repository
-- directory. Only when that fails does it put a @Nothing@ in the result at the
-- position of the path that cannot be converted.
--
-- It is intended for validating file arguments to darcs commands.
maybeFixSubPaths :: (AbsolutePath, AbsolutePath)
                 -> [String]
                 -> IO [Maybe AnchoredPath]
maybeFixSubPaths :: (AbsolutePath, AbsolutePath) -> [String] -> IO [Maybe AnchoredPath]
maybeFixSubPaths (AbsolutePath
r, AbsolutePath
o) [String]
fs = do
  [Maybe AnchoredPath]
fixedFs <- (String -> IO (Maybe AnchoredPath))
-> [String] -> IO [Maybe AnchoredPath]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Maybe AnchoredPath -> Maybe AnchoredPath)
-> IO (Maybe AnchoredPath) -> IO (Maybe AnchoredPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe AnchoredPath -> Maybe AnchoredPath
dropInDarcsdir (IO (Maybe AnchoredPath) -> IO (Maybe AnchoredPath))
-> (String -> IO (Maybe AnchoredPath))
-> String
-> IO (Maybe AnchoredPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe AnchoredPath)
fixit) [String]
fs
  let bads :: [String]
bads = ([Maybe AnchoredPath], [String]) -> [String]
forall a b. (a, b) -> b
snd (([Maybe AnchoredPath], [String]) -> [String])
-> ([(Maybe AnchoredPath, String)]
    -> ([Maybe AnchoredPath], [String]))
-> [(Maybe AnchoredPath, String)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Maybe AnchoredPath, String)] -> ([Maybe AnchoredPath], [String])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(Maybe AnchoredPath, String)]
 -> ([Maybe AnchoredPath], [String]))
-> ([(Maybe AnchoredPath, String)]
    -> [(Maybe AnchoredPath, String)])
-> [(Maybe AnchoredPath, String)]
-> ([Maybe AnchoredPath], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe AnchoredPath, String) -> Bool)
-> [(Maybe AnchoredPath, String)] -> [(Maybe AnchoredPath, String)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Maybe AnchoredPath -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe AnchoredPath -> Bool)
-> ((Maybe AnchoredPath, String) -> Maybe AnchoredPath)
-> (Maybe AnchoredPath, String)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe AnchoredPath, String) -> Maybe AnchoredPath
forall a b. (a, b) -> a
fst) ([(Maybe AnchoredPath, String)] -> [String])
-> [(Maybe AnchoredPath, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ [Maybe AnchoredPath] -> [String] -> [(Maybe AnchoredPath, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe AnchoredPath]
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 String
"Ignoring invalid repository paths:" Doc -> Doc -> Doc
<+> [String] -> Doc
pathlist [String]
bads
  [Maybe AnchoredPath] -> IO [Maybe AnchoredPath]
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
    -- special case here because fixit otherwise converts
    -- "" to (SubPath "."), which is a valid path
    fixit :: String -> IO (Maybe AnchoredPath)
fixit String
"" = Maybe AnchoredPath -> IO (Maybe AnchoredPath)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AnchoredPath
forall a. Maybe a
Nothing
    fixit 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 SubPath
sp -> Maybe AnchoredPath -> IO (Maybe AnchoredPath)
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 -> Maybe AnchoredPath)
-> AnchoredPath -> Maybe AnchoredPath
forall a b. (a -> b) -> a -> b
$ SubPath -> AnchoredPath
floatSubPath SubPath
sp
                   Maybe SubPath
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 AnchoredPath -> IO (Maybe AnchoredPath)
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 -> AnchoredPath
floatSubPath (SubPath -> AnchoredPath) -> Maybe SubPath -> Maybe AnchoredPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsolutePath -> AbsolutePath -> Maybe SubPath
makeSubPathOf AbsolutePath
r AbsolutePath
absolutePathByRepodir

-- | 'getRepourl' takes a list of flags and returns the url of the
-- repository specified by @Repodir \"directory\"@ in that list of flags, if any.
-- This flag is present if darcs was invoked with @--repodir=DIRECTORY@
getRepourl :: Config -> Maybe String
getRepourl :: Config -> Maybe String
getRepourl Config
fs = case (forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe String))
-> Config -> Maybe String
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe String)
O.possiblyRemoteRepo Config
fs of
  Maybe String
Nothing -> Maybe String
forall a. Maybe a
Nothing
  Just 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 = [
 String
"Each patch is attributed to its author, usually by email address (for",
 String
"example, `Fred Bloggs <fred@example.net>`).  Darcs looks in several",
 String
"places for this author string: the `--author` option, the files",
 String
"`_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]
++ String
"author` (in your",
 String
"home directory), and the environment variables `$DARCS_EMAIL` and",
 String
"`$EMAIL`.  If none of those exist, Darcs will prompt you for an author",
 String
"string and write it to `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
globalPrefsDirDoc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"author`.  Note that if you have more",
 String
"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]
++ String
"author`,",
 String
"one author per line.  Darcs will still prompt you for an author, but it",
 String
"allows you to select from the list, or to type in an alternative."
 ]

environmentHelpEmail :: ([String], [String])
environmentHelpEmail :: ([String], [String])
environmentHelpEmail = ([String
"DARCS_EMAIL",String
"EMAIL"], [String]
fileHelpAuthor)

-- | 'getAuthor' takes a list of flags and returns the author of the
-- change specified by @Author \"Leo Tolstoy\"@ in that list of flags, if any.
-- Otherwise, if @Pipe@ is present, asks the user who is the author and
-- returns the answer. If neither are present, try to guess the author,
-- from repository or global preference files or environment variables,
-- and if it's not possible, ask the user.
getAuthor :: Maybe String -> Bool -> IO String
getAuthor :: Maybe String -> Bool -> IO String
getAuthor (Just String
author) Bool
_ = String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
author
getAuthor Maybe String
Nothing Bool
pipe =
  if Bool
pipe
    then String -> IO String
askUser String
"Who is the author? "
    else Bool -> Bool -> IO String
promptAuthor Bool
True Bool
False

-- | 'promptAuthor' try to guess the author, from repository or
-- global preference files or environment variables, and
-- if it's not possible or alwaysAsk parameter is true, ask the user.
-- If store parameter is true, the new author is added into
-- @_darcs/prefs@.
promptAuthor :: Bool -- Store the new author
             -> Bool -- Author selection even if already stored
             -> IO String
promptAuthor :: Bool -> Bool -> IO String
promptAuthor Bool
store Bool
alwaysAsk = do
  [String]
as <- IO [String]
getEasyAuthor
  case [String]
as of
    [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
    [String]
_   -> 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 String
"What is your email address? "
  longPrompt :: IO String
longPrompt  = String -> IO String
askUser String
"What is your email address (e.g. Fred Bloggs <fred@example.net>)? "
  fancyPrompt :: [String] -> IO String
fancyPrompt [String]
xs =
    do Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"" Doc -> Doc -> Doc
$$
                  String -> Doc
text String
"You have saved the following email addresses to your global settings:"
       String
str <- String -> [String] -> IO String
askUserListItem String
"Please select an email address for this repository: " ([String]
xs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"Other"])
       if String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"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 Bool
storeGlobal IO String
askfn1 IO String
askfn2 = do
      Bool
aminrepo <- String -> IO Bool
doesDirectoryExist String
prefsDirPath
      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
prefsDirPath
          Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
            String -> Doc
text String
"Each patch is attributed to its author, usually by email address (for" Doc -> Doc -> Doc
$$
            String -> Doc
text String
"example, `Fred Bloggs <fred@example.net>').  Darcs could not determine" Doc -> Doc -> Doc
$$
            String -> Doc
text String
"your email address, so you will be prompted for it." Doc -> Doc -> Doc
$$
            String -> Doc
text String
"" Doc -> Doc -> Doc
$$
            String -> Doc
text (String
"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
prefsDirPath then
            Doc -> IO ()
putDocLn (Doc -> IO ()) -> Doc -> IO ()
forall a b. (a -> b) -> a -> b
$
              String -> Doc
text String
"It will be used for all patches you record in ALL repositories." Doc -> Doc -> Doc
$$
              String -> Doc
text (String
"If you move that file to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
prefsDirPath String -> String -> String
</> String
"author" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", it will") Doc -> Doc -> Doc
$$
              String -> Doc
text String
"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 String
"It will be used for all patches you record in this repository only." Doc -> Doc -> Doc
$$
              String -> Doc
text (String
"If you move that file to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
globalPrefsDirDoc String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"author, it will") Doc -> Doc -> Doc
$$
              String -> Doc
text String
"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
</> String
"author") (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
                          [String] -> String
unlines [String
"# " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
line | String
line <- [String]
fileHelpAuthor] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\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
      Maybe String
Nothing -> do
        String -> IO ()
putStrLn String
"WARNING: Global preference directory could not be found."
        String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
prefsDirPath
      Just 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' tries to get the author name first from the repository
-- preferences, then from global preferences, then from environment variables.
-- Returns @[]@ if it could not get it. Note that it may only return multiple
-- possibilities when reading from global preferences.
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 Int
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 String
"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 String
"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 String
"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 String
"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)
  -- this could perhaps be simplified with Control.Monad
  -- but note that we do NOT want to concatenate the results
  firstNotNullIO :: [IO [a]] -> IO [a]
firstNotNullIO [] = [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 (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 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 String
"What is the date? "
                  else IO String
getIsoDateTime

environmentHelpSendmail :: ([String], [String])
environmentHelpSendmail :: ([String], [String])
environmentHelpSendmail = ([String
"SENDMAIL"], [
 String
"On Unix, the `darcs send` command relies on sendmail(8).  The",
 String
"`--sendmail-command` or $SENDMAIL environment variable can be used to",
 String
"provide an explicit path to this program; otherwise the standard",
 String
"locations /usr/sbin/sendmail and /usr/lib/sendmail will be tried."])
-- FIXME: mention the following also:
-- * sendmail(8) is not sendmail-specific;
-- * nowadays, desktops often have no MTA or an unconfigured MTA --
--   which is awful, because it accepts mail but doesn't relay it;
-- * in this case, can be a sendmail(8)-emulating wrapper on top of an
--   MUA that sends mail directly to a smarthost; and
-- * on a multi-user system without an MTA and on which you haven't
--   got root, can be msmtp.

-- |'getSendmailCmd' takes a list of flags and returns the sendmail command
-- to be used by @darcs send@. Looks for a command specified by
-- @SendmailCmd \"command\"@ in that list of flags, if any.
-- This flag is present if darcs was invoked with @--sendmail-command=COMMAND@
-- Alternatively the user can set @$S@@ENDMAIL@ which will be used as a
-- fallback if present.
getSendmailCmd :: Config -> IO String
getSendmailCmd :: Config -> IO String
getSendmailCmd Config
fs = case (forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe String))
-> Config -> Maybe String
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe String)
O.sendmailCmd Config
fs of
  Just String
cmd -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
cmd
  Maybe String
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 -> 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 String
"SENDMAIL"

-- | Accessor for output option
getOutput :: Config -> FilePath -> Maybe AbsolutePathOrStd
getOutput :: Config -> String -> Maybe AbsolutePathOrStd
getOutput Config
fs 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 Flag a (Maybe Output))
-> Config -> Maybe Output
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe Output)
O.output Config
fs) where
  go :: Output -> AbsolutePathOrStd
go (O.Output AbsolutePathOrStd
ap)         = AbsolutePathOrStd
ap
  go (O.OutputAutoName AbsolutePath
ap) = AbsolutePath -> String -> AbsolutePathOrStd
makeAbsoluteOrStd AbsolutePath
ap String
fp

-- |'getSubject' takes a list of flags and returns the subject of the mail
-- to be sent by @darcs send@. Looks for a subject specified by
-- @Subject \"subject\"@ in that list of flags, if any.
-- This flag is present if darcs was invoked with @--subject=SUBJECT@
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 Flag a HeaderFields)
-> Config -> HeaderFields
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag a HeaderFields
O.headerFields

-- |'getCc' takes a list of flags and returns the addresses to send a copy of
-- the patch bundle to when using @darcs send@.
-- looks for a cc address specified by @Cc \"address\"@ in that list of flags.
-- Returns the addresses as a comma separated string.
getCc :: Config -> String
getCc :: Config -> String
getCc = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" , " ([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 Flag a HeaderFields)
-> Config -> HeaderFields
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags forall a. PrimOptSpec DarcsOptDescr Flag 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 Flag a HeaderFields)
-> Config -> HeaderFields
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> [f] -> v
parseFlags 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 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 forall a. PrimOptSpec DarcsOptDescr Flag a Logfile
O.logfile

workRepo :: Config -> WorkRepo
workRepo :: Config -> WorkRepo
workRepo = OptSpec
  DarcsOptDescr
  Flag
  WorkRepo
  (Maybe String -> Maybe String -> WorkRepo)
-> (Maybe String -> Maybe String -> WorkRepo) -> Config -> WorkRepo
forall (d :: * -> *) f a b. OptSpec d f a b -> b -> [f] -> a
oparse (PrimOptSpec
  DarcsOptDescr Flag (Maybe String -> WorkRepo) (Maybe String)
forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe String)
O.repoDir PrimOptSpec
  DarcsOptDescr Flag (Maybe String -> WorkRepo) (Maybe String)
-> OptSpec DarcsOptDescr Flag WorkRepo (Maybe String -> WorkRepo)
-> OptSpec
     DarcsOptDescr
     Flag
     WorkRepo
     (Maybe String -> Maybe String -> 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 String -> WorkRepo)
forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe String)
O.possiblyRemoteRepo) Maybe String -> Maybe String -> WorkRepo
go
  where
    go :: Maybe String -> Maybe String -> WorkRepo
go (Just String
s) Maybe String
_ = String -> WorkRepo
WorkRepoDir String
s
    go Maybe String
Nothing (Just String
s) = String -> WorkRepo
WorkRepoPossibleURL String
s
    go Maybe String
Nothing Maybe String
Nothing = WorkRepo
WorkRepoCurrentDir

withNewRepo :: String -> Config -> Config
withNewRepo :: String -> Config -> Config
withNewRepo String
dir = (forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe String))
-> Maybe String -> Config -> Config
forall (d :: * -> *) f v.
(forall a. PrimOptSpec d f a v) -> v -> [f] -> [f]
unparseOpt forall a. PrimOptSpec DarcsOptDescr Flag a (Maybe String)
O.newRepo (String -> Maybe String
forall a. a -> Maybe a
Just String
dir)