module Darcs.ArgumentDefaults ( getDefaultFlags ) where
import Data.Maybe ( listToMaybe, mapMaybe )
import Darcs.Arguments ( DarcsFlag,
atomicOptions, DarcsAtomicOption( .. ), DarcsOption ( .. ),
applyDefaults,
arein )
import Darcs.Commands ( CommandControl( CommandData ),
commandAlloptions )
import Darcs.Commands.Help ( commandControlList )
import Darcs.Repository.Prefs ( getGlobal, getPreflist )
getDefaultFlags :: String -> [DarcsOption] -> [DarcsFlag] -> IO [DarcsFlag]
getDefaultFlags com com_opts already = do
repo_defs <- defaultContent $ getPreflist "defaults"
global_defs <- defaultContent $ getGlobal "defaults"
let repo_flags = getFlagsFrom com com_opts already repo_defs
global_flags = getFlagsFrom com com_opts
(already++repo_flags) global_defs
return $ applyDefaults com_opts
$ repo_flags ++ global_flags
getFlagsFrom :: String -> [DarcsOption] -> [DarcsFlag] -> [(String,String,String)] -> [DarcsFlag]
getFlagsFrom com com_opts already defs =
options_for com_defs com_opts com_opts ++
options_for all_defs com_opts all_opts
where com_defs = filter (\ (c,_,_) -> c == com) defs
all_defs = filter (\ (c,_,_) -> c == "ALL") defs
options_for d o ao = concatMap (findOption o ao already) d
all_opts = concatMap get_opts commandControlList
get_opts (CommandData c) = let (o1, o2) = commandAlloptions c
in o1 ++ o2
get_opts _ = []
findOption :: [DarcsOption] -> [DarcsOption] -> [DarcsFlag] -> (String,String,String) -> [DarcsFlag]
findOption opts all_opts already (c, f, d) =
if null $ mapMaybe choose_option all_opts
then error $ "Bad default option: command '"++c++"' has no option '"++f++"'."
else concat $ mapMaybe choose_option opts
where choose_atomic_option (DarcsNoArgOption _ fls o _)
| f `elem` fls = if null d
then Just [o]
else error $ "Bad default option: '"++f
++"' takes no argument, but '"++d
++"' argument given."
choose_atomic_option (DarcsArgOption _ fls o _ _)
| f `elem` fls = if null d
then error $ "Bad default option: '"++f
++"' requires an argument, but no "
++"argument given."
else Just [o d]
choose_atomic_option _ = Nothing
choose_option o
| o `arein` already = Just []
| otherwise = listToMaybe $ mapMaybe choose_atomic_option $ atomicOptions o
defaultContent :: IO [String] -> IO [(String,String,String)]
defaultContent = fmap (mapMaybe (doline . words))
where doline (c:a:r) = Just (c, drop_dashdash a, unwords r)
doline _ = Nothing
drop_dashdash ('-':'-':a) = a
drop_dashdash a = a