{-# LANGUAGE ScopedTypeVariables #-}
module System.Console.CmdArgs.Explicit(
process, processArgs, processValue,
module System.Console.CmdArgs.Explicit.Type,
flagHelpSimple, flagHelpFormat, flagVersion, flagsVerbosity,
module System.Console.CmdArgs.Explicit.Help,
module System.Console.CmdArgs.Explicit.ExpandArgsAt,
module System.Console.CmdArgs.Explicit.SplitJoin,
Complete(..), complete
) where
import System.Console.CmdArgs.Explicit.Type
import System.Console.CmdArgs.Explicit.Process
import System.Console.CmdArgs.Explicit.Help
import System.Console.CmdArgs.Explicit.ExpandArgsAt
import System.Console.CmdArgs.Explicit.SplitJoin
import System.Console.CmdArgs.Explicit.Complete
import System.Console.CmdArgs.Default
import System.Console.CmdArgs.Helper
import System.Console.CmdArgs.Text
import System.Console.CmdArgs.Verbosity
import Control.Monad
import Data.Char
import Data.Maybe
import System.Environment
import System.Exit
import System.IO
processArgs :: Mode a -> IO a
processArgs m = do
env <- getEnvironment
case lookup "CMDARGS_COMPLETE" env of
Just x -> do
args <- getArgs
let argInd = fromMaybe (length args - 1) $ readMay x
argPos = fromMaybe (if argInd >= 0 && argInd < length args then length (args !! argInd) else 0) $
readMay =<< lookup "CMDARGS_COMPLETE_POS" env
print $ complete m (concatMap words args) (argInd,argPos)
exitWith ExitSuccess
Nothing -> do
nam <- getProgName
let var = mplus (lookup ("CMDARGS_HELPER_" ++ show (map toUpper $ head $ modeNames m ++ [nam])) env)
(lookup "CMDARGS_HELPER" env)
case var of
Nothing -> run =<< (if modeExpandAt m then expandArgsAt else return) =<< getArgs
Just cmd -> do
res <- execute cmd m []
case res of
Left err -> do
hPutStrLn stderr $ "Error when running helper " ++ cmd
hPutStrLn stderr err
exitFailure
Right args -> run args
where
run args = case process m args of
Left x -> do hPutStrLn stderr x; exitFailure
Right x -> return x
readMay :: Read a => String -> Maybe a
readMay s = case [x | (x,t) <- reads s, ("","") <- lex t] of
[x] -> Just x
_ -> Nothing
processValue :: Mode a -> [String] -> a
processValue m xs = case process m xs of
Left x -> error x
Right x -> x
flagHelpSimple :: (a -> a) -> Flag a
flagHelpSimple f = flagNone ["help","?"] f "Display help message"
flagHelpFormat :: (HelpFormat -> TextFormat -> a -> a) -> Flag a
flagHelpFormat f = (flagOpt "" ["help","?"] upd "" "Display help message"){flagInfo = FlagOptRare ""}
where
upd s v = case format s of
Left e -> Left e
Right (a,b) -> Right $ f a b v
format :: String -> Either String (HelpFormat,TextFormat)
format xs = foldl (\acc x -> either Left (f x) acc) (Right def) (sep xs)
where
sep = words . map (\x -> if x `elem` ":," then ' ' else toLower x)
f x (a,b) = case x of
"all" -> Right (HelpFormatAll,b)
"one" -> Right (HelpFormatOne,b)
"def" -> Right (HelpFormatDefault,b)
"html" -> Right (a,HTML)
"text" -> Right (a,defaultWrap)
"bash" -> Right (HelpFormatBash,Wrap 1000000)
"zsh" -> Right (HelpFormatZsh ,Wrap 1000000)
_ | all isDigit x -> Right (a,Wrap $ read x)
_ -> Left "unrecognised help format, expected one of: all one def html text <NUMBER>"
flagVersion :: (a -> a) -> Flag a
flagVersion f = flagNone ["version","V"] f "Print version information"
flagsVerbosity :: (Verbosity -> a -> a) -> [Flag a]
flagsVerbosity f =
[flagNone ["verbose","v"] (f Loud) "Loud verbosity"
,flagNone ["quiet","q"] (f Quiet) "Quiet verbosity"]