module Darcs.UI.Defaults ( applyDefaults ) where
import Prelude ()
import Darcs.Prelude
import Control.Monad.Writer
import Data.Char ( isSpace )
import Data.Functor.Compose ( Compose(..) )
import Data.List ( nub )
import Data.Maybe ( catMaybes )
import qualified Data.Map as M
import System.Console.GetOpt
import Text.Regex.Applicative
( (<|>)
, match, many, some
, psym, anySym, string )
import Darcs.UI.Flags ( DarcsFlag )
import Darcs.UI.Options ( DarcsOptDescr )
import Darcs.UI.Commands
( DarcsCommand(..), commandAlloptions, extractAllCommands
, WrappedCommand(..)
)
import Darcs.UI.TheCommands ( commandControlList )
import Darcs.Util.Path ( AbsolutePath )
applyDefaults :: Maybe String
-> DarcsCommand pf
-> AbsolutePath
-> [String]
-> [String]
-> [DarcsFlag]
-> ([DarcsFlag], [String])
applyDefaults :: Maybe String
-> DarcsCommand pf
-> AbsolutePath
-> [String]
-> [String]
-> [DarcsFlag]
-> ([DarcsFlag], [String])
applyDefaults msuper :: Maybe String
msuper cmd :: DarcsCommand pf
cmd cwd :: AbsolutePath
cwd user :: [String]
user repo :: [String]
repo flags :: [DarcsFlag]
flags = Writer [String] [DarcsFlag] -> ([DarcsFlag], [String])
forall w a. Writer w a -> (a, w)
runWriter (Writer [String] [DarcsFlag] -> ([DarcsFlag], [String]))
-> Writer [String] [DarcsFlag] -> ([DarcsFlag], [String])
forall a b. (a -> b) -> a -> b
$ do
[DarcsFlag]
cl_flags <- String
-> ([DarcsFlag] -> [String])
-> [DarcsFlag]
-> Writer [String] [DarcsFlag]
runChecks "Command line" [DarcsFlag] -> [String]
check_opts [DarcsFlag]
flags
[DarcsFlag]
user_defs <- String -> [String] -> Writer [String] [DarcsFlag]
get_flags "User defaults" [String]
user
[DarcsFlag]
repo_defs <- String -> [String] -> Writer [String] [DarcsFlag]
get_flags "Repo defaults" [String]
repo
[DarcsFlag] -> Writer [String] [DarcsFlag]
forall (m :: * -> *) a. Monad m => a -> m a
return ([DarcsFlag] -> Writer [String] [DarcsFlag])
-> [DarcsFlag] -> Writer [String] [DarcsFlag]
forall a b. (a -> b) -> a -> b
$ [DarcsFlag]
cl_flags [DarcsFlag] -> [DarcsFlag] -> [DarcsFlag]
forall a. [a] -> [a] -> [a]
++ [DarcsFlag]
repo_defs [DarcsFlag] -> [DarcsFlag] -> [DarcsFlag]
forall a. [a] -> [a] -> [a]
++ [DarcsFlag]
user_defs [DarcsFlag] -> [DarcsFlag] -> [DarcsFlag]
forall a. [a] -> [a] -> [a]
++ [DarcsFlag]
builtin_defs
where
cmd_name :: CmdName
cmd_name = Maybe String -> String -> CmdName
mkCmdName Maybe String
msuper (DarcsCommand pf -> String
forall parsedFlags. DarcsCommand parsedFlags -> String
commandName DarcsCommand pf
cmd)
builtin_defs :: [DarcsFlag]
builtin_defs = DarcsCommand pf -> [DarcsFlag]
forall parsedFlags. DarcsCommand parsedFlags -> [DarcsFlag]
commandDefaults DarcsCommand pf
cmd
check_opts :: [DarcsFlag] -> [String]
check_opts = DarcsCommand pf -> [DarcsFlag] -> [String]
forall parsedFlags.
DarcsCommand parsedFlags -> [DarcsFlag] -> [String]
commandCheckOptions DarcsCommand pf
cmd
opts :: [DarcsOptDescr DarcsFlag]
opts = ([DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag] -> [DarcsOptDescr DarcsFlag])
-> ([DarcsOptDescr DarcsFlag], [DarcsOptDescr DarcsFlag])
-> [DarcsOptDescr DarcsFlag]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag] -> [DarcsOptDescr DarcsFlag]
forall a. [a] -> [a] -> [a]
(++) (([DarcsOptDescr DarcsFlag], [DarcsOptDescr DarcsFlag])
-> [DarcsOptDescr DarcsFlag])
-> ([DarcsOptDescr DarcsFlag], [DarcsOptDescr DarcsFlag])
-> [DarcsOptDescr DarcsFlag]
forall a b. (a -> b) -> a -> b
$ DarcsCommand pf
-> ([DarcsOptDescr DarcsFlag], [DarcsOptDescr DarcsFlag])
forall pf.
DarcsCommand pf
-> ([DarcsOptDescr DarcsFlag], [DarcsOptDescr DarcsFlag])
commandAlloptions DarcsCommand pf
cmd
get_flags :: String -> [String] -> Writer [String] [DarcsFlag]
get_flags source :: String
source = String
-> AbsolutePath
-> CmdName
-> [DarcsOptDescr DarcsFlag]
-> ([DarcsFlag] -> [String])
-> [String]
-> Writer [String] [DarcsFlag]
parseDefaults String
source AbsolutePath
cwd CmdName
cmd_name [DarcsOptDescr DarcsFlag]
opts [DarcsFlag] -> [String]
check_opts
data CmdName = NormalCmd String | SuperCmd String String
mkCmdName :: Maybe String -> String -> CmdName
mkCmdName :: Maybe String -> String -> CmdName
mkCmdName Nothing cmd :: String
cmd = String -> CmdName
NormalCmd String
cmd
mkCmdName (Just super :: String
super) sub :: String
sub = String -> String -> CmdName
SuperCmd String
super String
sub
showCmdName :: CmdName -> String
showCmdName :: CmdName -> String
showCmdName (SuperCmd super :: String
super sub :: String
sub) = [String] -> String
unwords [String
super,String
sub]
showCmdName (NormalCmd name :: String
name) = String
name
runChecks :: String -> ([DarcsFlag] -> [String]) -> [DarcsFlag] -> Writer [String] [DarcsFlag]
runChecks :: String
-> ([DarcsFlag] -> [String])
-> [DarcsFlag]
-> Writer [String] [DarcsFlag]
runChecks source :: String
source check :: [DarcsFlag] -> [String]
check fs :: [DarcsFlag]
fs = do
[String] -> WriterT [String] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([String] -> WriterT [String] Identity ())
-> [String] -> WriterT [String] Identity ()
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((String
sourceString -> String -> String
forall a. [a] -> [a] -> [a]
++": ")String -> String -> String
forall a. [a] -> [a] -> [a]
++) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [DarcsFlag] -> [String]
check [DarcsFlag]
fs
[DarcsFlag] -> Writer [String] [DarcsFlag]
forall (m :: * -> *) a. Monad m => a -> m a
return [DarcsFlag]
fs
parseDefaults :: String
-> AbsolutePath
-> CmdName
-> [DarcsOptDescr DarcsFlag]
-> ([DarcsFlag] -> [String])
-> [String]
-> Writer [String] [DarcsFlag]
parseDefaults :: String
-> AbsolutePath
-> CmdName
-> [DarcsOptDescr DarcsFlag]
-> ([DarcsFlag] -> [String])
-> [String]
-> Writer [String] [DarcsFlag]
parseDefaults source :: String
source cwd :: AbsolutePath
cwd cmd :: CmdName
cmd opts :: [DarcsOptDescr DarcsFlag]
opts check_opts :: [DarcsFlag] -> [String]
check_opts def_lines :: [String]
def_lines = do
[DarcsFlag]
cmd_flags <- [String] -> [(String, String)] -> Writer [String] [DarcsFlag]
forall (t :: * -> *).
Foldable t =>
t String -> [(String, String)] -> Writer [String] [DarcsFlag]
flags_for (Map String (DarcsOptDescr DarcsFlag) -> [String]
forall k a. Map k a -> [k]
M.keys Map String (DarcsOptDescr DarcsFlag)
opt_map) [(String, String)]
cmd_defs Writer [String] [DarcsFlag]
-> ([DarcsFlag] -> Writer [String] [DarcsFlag])
-> Writer [String] [DarcsFlag]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
String
-> ([DarcsFlag] -> [String])
-> [DarcsFlag]
-> Writer [String] [DarcsFlag]
runChecks (String
sourceString -> String -> String
forall a. [a] -> [a] -> [a]
++" for command '"String -> String -> String
forall a. [a] -> [a] -> [a]
++CmdName -> String
showCmdName CmdName
cmdString -> String -> String
forall a. [a] -> [a] -> [a]
++"'") [DarcsFlag] -> [String]
check_opts
[DarcsFlag]
all_flags <- [String] -> [(String, String)] -> Writer [String] [DarcsFlag]
forall (t :: * -> *).
Foldable t =>
t String -> [(String, String)] -> Writer [String] [DarcsFlag]
flags_for [String]
allOptionSwitches [(String, String)]
all_defs Writer [String] [DarcsFlag]
-> ([DarcsFlag] -> Writer [String] [DarcsFlag])
-> Writer [String] [DarcsFlag]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
String
-> ([DarcsFlag] -> [String])
-> [DarcsFlag]
-> Writer [String] [DarcsFlag]
runChecks (String
sourceString -> String -> String
forall a. [a] -> [a] -> [a]
++" for ALL commands") [DarcsFlag] -> [String]
check_opts
[DarcsFlag] -> Writer [String] [DarcsFlag]
forall (m :: * -> *) a. Monad m => a -> m a
return ([DarcsFlag] -> Writer [String] [DarcsFlag])
-> [DarcsFlag] -> Writer [String] [DarcsFlag]
forall a b. (a -> b) -> a -> b
$ [DarcsFlag]
cmd_flags [DarcsFlag] -> [DarcsFlag] -> [DarcsFlag]
forall a. [a] -> [a] -> [a]
++ [DarcsFlag]
all_flags
where
opt_map :: Map String (DarcsOptDescr DarcsFlag)
opt_map = [DarcsOptDescr DarcsFlag] -> Map String (DarcsOptDescr DarcsFlag)
optionMap [DarcsOptDescr DarcsFlag]
opts
cmd_defs :: [(String, String)]
cmd_defs = CmdName -> [String] -> [(String, String)]
parseDefaultsLines CmdName
cmd [String]
def_lines
all_defs :: [(String, String)]
all_defs = CmdName -> [String] -> [(String, String)]
parseDefaultsLines (String -> CmdName
NormalCmd "ALL") [String]
def_lines
to_flag :: t String
-> (String, String) -> WriterT [String] Identity (Maybe DarcsFlag)
to_flag all_switches :: t String
all_switches (switch :: String
switch,arg :: String
arg) =
if String
switch String -> t String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` t String
all_switches then do
[String] -> WriterT [String] Identity ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell [String
sourceString -> String -> String
forall a. [a] -> [a] -> [a]
++": command '"String -> String -> String
forall a. [a] -> [a] -> [a]
++CmdName -> String
showCmdName CmdName
cmd
String -> String -> String
forall a. [a] -> [a] -> [a]
++"' has no option '"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
switchString -> String -> String
forall a. [a] -> [a] -> [a]
++"'."]
Maybe DarcsFlag -> WriterT [String] Identity (Maybe DarcsFlag)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DarcsFlag
forall a. Maybe a
Nothing
else
([String] -> [String])
-> WriterT [String] Identity (Maybe DarcsFlag)
-> WriterT [String] Identity (Maybe DarcsFlag)
forall (t :: * -> *) a a b.
Foldable t =>
(t a -> [a]) -> Writer (t a) b -> Writer [a] b
mapErrors ((String
sourceString -> String -> String
forall a. [a] -> [a] -> [a]
++" for command '"String -> String -> String
forall a. [a] -> [a] -> [a]
++CmdName -> String
showCmdName CmdName
cmdString -> String -> String
forall a. [a] -> [a] -> [a]
++"':")String -> [String] -> [String]
forall a. a -> [a] -> [a]
:)
(WriterT [String] Identity (Maybe DarcsFlag)
-> WriterT [String] Identity (Maybe DarcsFlag))
-> WriterT [String] Identity (Maybe DarcsFlag)
-> WriterT [String] Identity (Maybe DarcsFlag)
forall a b. (a -> b) -> a -> b
$ AbsolutePath
-> Map String (DarcsOptDescr DarcsFlag)
-> (String, String)
-> WriterT [String] Identity (Maybe DarcsFlag)
defaultToFlag AbsolutePath
cwd Map String (DarcsOptDescr DarcsFlag)
opt_map (String
switch,String
arg)
flags_for :: t String -> [(String, String)] -> Writer [String] [DarcsFlag]
flags_for all_switches :: t String
all_switches = ([Maybe DarcsFlag] -> [DarcsFlag])
-> WriterT [String] Identity [Maybe DarcsFlag]
-> Writer [String] [DarcsFlag]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe DarcsFlag] -> [DarcsFlag]
forall a. [Maybe a] -> [a]
catMaybes (WriterT [String] Identity [Maybe DarcsFlag]
-> Writer [String] [DarcsFlag])
-> ([(String, String)]
-> WriterT [String] Identity [Maybe DarcsFlag])
-> [(String, String)]
-> Writer [String] [DarcsFlag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> WriterT [String] Identity (Maybe DarcsFlag))
-> [(String, String)]
-> WriterT [String] Identity [Maybe DarcsFlag]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (t String
-> (String, String) -> WriterT [String] Identity (Maybe DarcsFlag)
forall (t :: * -> *).
Foldable t =>
t String
-> (String, String) -> WriterT [String] Identity (Maybe DarcsFlag)
to_flag t String
all_switches)
mapErrors :: (t a -> [a]) -> Writer (t a) b -> Writer [a] b
mapErrors f :: t a -> [a]
f = ((b, t a) -> (b, [a])) -> Writer (t a) b -> Writer [a] b
forall a w b w'. ((a, w) -> (b, w')) -> Writer w a -> Writer w' b
mapWriter (\(r :: b
r, es :: t a
es) -> (b
r, if t a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
es then [] else t a -> [a]
f t a
es))
type Default = (String, String)
parseDefaultsLines :: CmdName -> [String] -> [Default]
parseDefaultsLines :: CmdName -> [String] -> [(String, String)]
parseDefaultsLines cmd :: CmdName
cmd = [Maybe (String, String)] -> [(String, String)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (String, String)] -> [(String, String)])
-> ([String] -> [Maybe (String, String)])
-> [String]
-> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe (String, String))
-> [String] -> [Maybe (String, String)]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe (String, String)
matchLine
where
matchLine :: String -> Maybe (String, String)
matchLine = RE Char (String, String) -> String -> Maybe (String, String)
forall s a. RE s a -> [s] -> Maybe a
match (RE Char (String, String) -> String -> Maybe (String, String))
-> RE Char (String, String) -> String -> Maybe (String, String)
forall a b. (a -> b) -> a -> b
$ (,) (String -> String -> (String, String))
-> RE Char String -> RE Char (String -> (String, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (CmdName -> RE Char String
match_cmd CmdName
cmd RE Char String -> RE Char String -> RE Char String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RE Char String
spaces RE Char String -> RE Char String -> RE Char String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RE Char String
opt_dashes RE Char String -> RE Char String -> RE Char String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RE Char String
word) RE Char (String -> (String, String))
-> RE Char String -> RE Char (String, String)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RE Char String
rest
match_cmd :: CmdName -> RE Char String
match_cmd (NormalCmd name :: String
name) = String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
string String
name
match_cmd (SuperCmd super :: String
super sub :: String
sub) = String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
string String
super RE Char String -> RE Char String -> RE Char String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RE Char String
spaces RE Char String -> RE Char String -> RE Char String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
string String
sub
opt_dashes :: RE Char String
opt_dashes = String -> RE Char String
forall a. Eq a => [a] -> RE a [a]
string "--" RE Char String -> RE Char String -> RE Char String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> RE Char String
forall (f :: * -> *) a. Applicative f => a -> f a
pure ""
word :: RE Char String
word = RE Char Char -> RE Char String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (RE Char Char -> RE Char String) -> RE Char Char -> RE Char String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> RE Char Char
forall s. (s -> Bool) -> RE s s
psym (Bool -> Bool
not(Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Char -> Bool
isSpace)
spaces :: RE Char String
spaces = RE Char Char -> RE Char String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (RE Char Char -> RE Char String) -> RE Char Char -> RE Char String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> RE Char Char
forall s. (s -> Bool) -> RE s s
psym Char -> Bool
isSpace
rest :: RE Char String
rest = RE Char String
spaces RE Char String -> RE Char String -> RE Char String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> RE Char Char -> RE Char String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many RE Char Char
forall s. RE s s
anySym RE Char String -> RE Char String -> RE Char String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> RE Char String
forall (f :: * -> *) a. Applicative f => a -> f a
pure ""
defaultToFlag :: AbsolutePath
-> OptionMap
-> Default
-> Writer [String] (Maybe DarcsFlag)
defaultToFlag :: AbsolutePath
-> Map String (DarcsOptDescr DarcsFlag)
-> (String, String)
-> WriterT [String] Identity (Maybe DarcsFlag)
defaultToFlag cwd :: AbsolutePath
cwd opts :: Map String (DarcsOptDescr DarcsFlag)
opts (switch :: String
switch, arg :: String
arg) = case String
-> Map String (DarcsOptDescr DarcsFlag)
-> Maybe (DarcsOptDescr DarcsFlag)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
switch Map String (DarcsOptDescr DarcsFlag)
opts of
Nothing -> Maybe DarcsFlag -> WriterT [String] Identity (Maybe DarcsFlag)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe DarcsFlag
forall a. Maybe a
Nothing
Just opt :: DarcsOptDescr DarcsFlag
opt -> ArgDescr (AbsolutePath -> DarcsFlag)
-> WriterT [String] Identity (Maybe DarcsFlag)
forall (m :: * -> *) a.
MonadWriter [String] m =>
ArgDescr (AbsolutePath -> a) -> m (Maybe a)
flag_from (ArgDescr (AbsolutePath -> DarcsFlag)
-> WriterT [String] Identity (Maybe DarcsFlag))
-> ArgDescr (AbsolutePath -> DarcsFlag)
-> WriterT [String] Identity (Maybe DarcsFlag)
forall a b. (a -> b) -> a -> b
$ OptDescr (AbsolutePath -> DarcsFlag)
-> ArgDescr (AbsolutePath -> DarcsFlag)
forall a. OptDescr a -> ArgDescr a
getArgDescr (OptDescr (AbsolutePath -> DarcsFlag)
-> ArgDescr (AbsolutePath -> DarcsFlag))
-> OptDescr (AbsolutePath -> DarcsFlag)
-> ArgDescr (AbsolutePath -> DarcsFlag)
forall a b. (a -> b) -> a -> b
$ DarcsOptDescr DarcsFlag -> OptDescr (AbsolutePath -> DarcsFlag)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose DarcsOptDescr DarcsFlag
opt
where
getArgDescr :: OptDescr a -> ArgDescr a
getArgDescr (Option _ _ a :: ArgDescr a
a _) = ArgDescr a
a
flag_from :: ArgDescr (AbsolutePath -> a) -> m (Maybe a)
flag_from (NoArg mkFlag :: AbsolutePath -> a
mkFlag) = do
if Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
arg) then do
[String] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ["'"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
switchString -> String -> String
forall a. [a] -> [a] -> [a]
++"' takes no argument, but '"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
argString -> String -> String
forall a. [a] -> [a] -> [a]
++"' argument given."]
Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
else
Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ AbsolutePath -> a
mkFlag AbsolutePath
cwd
flag_from (OptArg mkFlag :: Maybe String -> AbsolutePath -> a
mkFlag _) =
Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ Maybe String -> AbsolutePath -> a
mkFlag (if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
arg then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
arg) AbsolutePath
cwd
flag_from (ReqArg mkFlag :: String -> AbsolutePath -> a
mkFlag _) = do
if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
arg then do
[String] -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ["'"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
switchString -> String -> String
forall a. [a] -> [a] -> [a]
++"' requires an argument, but no "String -> String -> String
forall a. [a] -> [a] -> [a]
++"argument given."]
Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
else
Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ String -> AbsolutePath -> a
mkFlag String
arg AbsolutePath
cwd
optionSwitches :: [DarcsOptDescr DarcsFlag] -> [String]
optionSwitches :: [DarcsOptDescr DarcsFlag] -> [String]
optionSwitches = (DarcsOptDescr DarcsFlag -> [String])
-> [DarcsOptDescr DarcsFlag] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DarcsOptDescr DarcsFlag -> [String]
forall (g :: * -> *) a. Compose OptDescr g a -> [String]
sel where
sel :: Compose OptDescr g a -> [String]
sel (Compose (Option _ switches :: [String]
switches _ _)) = [String]
switches
type OptionMap = M.Map String (DarcsOptDescr DarcsFlag)
optionMap :: [DarcsOptDescr DarcsFlag] -> OptionMap
optionMap :: [DarcsOptDescr DarcsFlag] -> Map String (DarcsOptDescr DarcsFlag)
optionMap = [(String, DarcsOptDescr DarcsFlag)]
-> Map String (DarcsOptDescr DarcsFlag)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(String, DarcsOptDescr DarcsFlag)]
-> Map String (DarcsOptDescr DarcsFlag))
-> ([DarcsOptDescr DarcsFlag]
-> [(String, DarcsOptDescr DarcsFlag)])
-> [DarcsOptDescr DarcsFlag]
-> Map String (DarcsOptDescr DarcsFlag)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DarcsOptDescr DarcsFlag -> [(String, DarcsOptDescr DarcsFlag)])
-> [DarcsOptDescr DarcsFlag] -> [(String, DarcsOptDescr DarcsFlag)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap DarcsOptDescr DarcsFlag -> [(String, DarcsOptDescr DarcsFlag)]
forall (g :: * -> *) a.
Compose OptDescr g a -> [(String, Compose OptDescr g a)]
sel where
add_option :: b -> a -> (a, b)
add_option opt :: b
opt switch :: a
switch = (a
switch, b
opt)
sel :: Compose OptDescr g a -> [(String, Compose OptDescr g a)]
sel o :: Compose OptDescr g a
o@(Compose (Option _ switches :: [String]
switches _ _)) = (String -> (String, Compose OptDescr g a))
-> [String] -> [(String, Compose OptDescr g a)]
forall a b. (a -> b) -> [a] -> [b]
map (Compose OptDescr g a -> String -> (String, Compose OptDescr g a)
forall b a. b -> a -> (a, b)
add_option Compose OptDescr g a
o) [String]
switches
allOptionSwitches :: [String]
allOptionSwitches :: [String]
allOptionSwitches = [String] -> [String]
forall a. Eq a => [a] -> [a]
nub ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [DarcsOptDescr DarcsFlag] -> [String]
optionSwitches ([DarcsOptDescr DarcsFlag] -> [String])
-> [DarcsOptDescr DarcsFlag] -> [String]
forall a b. (a -> b) -> a -> b
$
(WrappedCommand -> [DarcsOptDescr DarcsFlag])
-> [WrappedCommand] -> [DarcsOptDescr DarcsFlag]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(WrappedCommand c :: DarcsCommand parsedFlags
c) -> ([DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag] -> [DarcsOptDescr DarcsFlag])
-> ([DarcsOptDescr DarcsFlag], [DarcsOptDescr DarcsFlag])
-> [DarcsOptDescr DarcsFlag]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [DarcsOptDescr DarcsFlag]
-> [DarcsOptDescr DarcsFlag] -> [DarcsOptDescr DarcsFlag]
forall a. [a] -> [a] -> [a]
(++) (([DarcsOptDescr DarcsFlag], [DarcsOptDescr DarcsFlag])
-> [DarcsOptDescr DarcsFlag])
-> (DarcsCommand parsedFlags
-> ([DarcsOptDescr DarcsFlag], [DarcsOptDescr DarcsFlag]))
-> DarcsCommand parsedFlags
-> [DarcsOptDescr DarcsFlag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DarcsCommand parsedFlags
-> ([DarcsOptDescr DarcsFlag], [DarcsOptDescr DarcsFlag])
forall pf.
DarcsCommand pf
-> ([DarcsOptDescr DarcsFlag], [DarcsOptDescr DarcsFlag])
commandAlloptions (DarcsCommand parsedFlags -> [DarcsOptDescr DarcsFlag])
-> DarcsCommand parsedFlags -> [DarcsOptDescr DarcsFlag]
forall a b. (a -> b) -> a -> b
$ DarcsCommand parsedFlags
c) ([WrappedCommand] -> [DarcsOptDescr DarcsFlag])
-> [WrappedCommand] -> [DarcsOptDescr DarcsFlag]
forall a b. (a -> b) -> a -> b
$
[CommandControl] -> [WrappedCommand]
extractAllCommands [CommandControl]
commandControlList