{-# LANGUAGE ScopedTypeVariables, CPP #-}
{-|
    This module constructs command lines. You may either use the helper functions
    ('flagNone', 'flagOpt', 'mode' etc.) or construct the type directly. These
    types are intended to give all the necessary power to the person constructing
    a command line parser.

    For people constructing simpler command line parsers, the module
    "System.Console.CmdArgs.Implicit" may be more appropriate.

    As an example of a parser:

    @
    arguments :: 'Mode' [(String,String)]
    arguments = 'mode' \"explicit\" [] \"Explicit sample program\" ('flagArg' (upd \"file\") \"FILE\")
        ['flagOpt' \"world\" [\"hello\",\"h\"] (upd \"world\") \"WHO\" \"World argument\"
        ,'flagReq' [\"greeting\",\"g\"] (upd \"greeting\") \"MSG\" \"Greeting to give\"
        ,'flagHelpSimple' ((\"help\",\"\"):)]
        where upd msg x v = Right $ (msg,x):v
    @

    And this can be invoked by:

    @
    main = do
        xs <- 'processArgs' arguments
        if (\"help\",\"\") \`elem\` xs then
            print $ 'helpText' [] 'HelpFormatDefault' arguments
         else
            print xs
    @

    /Groups/: The 'Group' structure allows flags/modes to be grouped for the purpose of
    displaying help. When processing command lines, the group structure is ignored.

    /Modes/: The Explicit module allows multiple mode programs by placing additional modes
    in 'modeGroupModes'. Every mode is allowed sub-modes, and thus multiple levels of mode
    may be created. Given a mode @x@ with sub-modes @xs@, if the first argument corresponds
    to the name of a sub-mode, then that sub-mode will be applied. If not, then the arguments
    will be processed by mode @x@. Consequently, if you wish to force the user to explicitly
    enter a mode, simply give sub-modes, and leave 'modeArgs' as @Nothing@. Alternatively, if
    you want one sub-mode to be selected by default, place all it's flags both in the sub-mode
    and the outer mode.

    /Parsing rules/: Command lines are parsed as per most GNU programs. Short arguments single
    letter flags start with @-@, longer flags start with @--@, and everything else is considered
    an argument. Anything after @--@ alone is considered to be an argument. For example:

  > -f --flag argument1 -- --argument2

    This command line passes one single letter flag (@f@), one longer flag (@flag@) and two arguments
    (@argument1@ and @--argument2@).
-}
module System.Console.CmdArgs.Explicit(
    -- * Running command lines
    process, processArgs, processValue, processValueIO,
    -- * Constructing command lines
    module System.Console.CmdArgs.Explicit.Type,
    flagHelpSimple, flagHelpFormat, flagVersion, flagNumericVersion, flagsVerbosity,
    -- * Displaying help
    module System.Console.CmdArgs.Explicit.Help,
    -- * Utilities for working with command lines
    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


-- | Process the flags obtained by @'getArgs'@ and @'expandArgsAt'@ with a mode. Displays
--   an error and exits with failure if the command line fails to parse, or returns
--   the associated value. Implemented in terms of 'process'. This function makes
--   use of the following environment variables:
--
-- * @$CMDARGS_COMPLETE@ - causes the program to produce completions using 'complete', then exit.
--   Completions are based on the result of 'getArgs', the index of the current argument is taken
--   from @$CMDARGS_COMPLETE@ (set it to @-@ to complete the last argument), and the index within
--   that argument is taken from @$CMDARGS_COMPLETE_POS@ (if set).
--
-- * @$CMDARGS_HELPER@\/@$CMDARGS_HELPER_/PROG/@ - uses the helper mechanism for entering command
--   line programs as described in "System.Console.CmdArgs.Helper".
processArgs :: Mode a -> IO a
processArgs :: forall a. Mode a -> IO a
processArgs Mode a
m = do
    env <- IO [([Char], [Char])]
getEnvironment
    case lookup "CMDARGS_COMPLETE" env of
        Just [Char]
x -> do
            args <- IO [[Char]]
getArgs
            let argInd = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe ([[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
args Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMay [Char]
x
                argPos = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (if Int
argInd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
argInd Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [[Char]] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
args then [Char] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[Char]]
args [[Char]] -> Int -> [Char]
forall a. HasCallStack => [a] -> Int -> a
!! Int
argInd) else Int
0) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$
                         [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMay ([Char] -> Maybe Int) -> Maybe [Char] -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Char] -> [([Char], [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
"CMDARGS_COMPLETE_POS" [([Char], [Char])]
env
            print $ complete m (concatMap words args) (argInd,argPos)
            exitWith ExitSuccess
        Maybe [Char]
Nothing -> do
            nam <- IO [Char]
getProgName
            let var = Maybe [Char] -> Maybe [Char] -> Maybe [Char]
forall a. Maybe a -> Maybe a -> Maybe a
forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus ([Char] -> [([Char], [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup ([Char]
"CMDARGS_HELPER_" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show ((Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
forall a. HasCallStack => [a] -> a
head ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ Mode a -> [[Char]]
forall a. Mode a -> [[Char]]
modeNames Mode a
m [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
nam])) [([Char], [Char])]
env)
                            ([Char] -> [([Char], [Char])] -> Maybe [Char]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [Char]
"CMDARGS_HELPER" [([Char], [Char])]
env)
            case var of
                Maybe [Char]
Nothing -> Mode a -> [[Char]] -> IO a
forall a. Mode a -> [[Char]] -> IO a
processValueIO Mode a
m ([[Char]] -> IO a) -> IO [[Char]] -> IO a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (if Mode a -> Bool
forall a. Mode a -> Bool
modeExpandAt Mode a
m then [[Char]] -> IO [[Char]]
expandArgsAt else [[Char]] -> IO [[Char]]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return) ([[Char]] -> IO [[Char]]) -> IO [[Char]] -> IO [[Char]]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO [[Char]]
getArgs
                Just [Char]
cmd -> do
                    res <- [Char] -> Mode a -> [[Char]] -> IO (Either [Char] [[Char]])
forall a.
[Char] -> Mode a -> [[Char]] -> IO (Either [Char] [[Char]])
execute [Char]
cmd Mode a
m []
                    case res of
                        Left [Char]
err -> do
                            Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Error when running helper " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
cmd
                            Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
err
                            IO a
forall a. IO a
exitFailure
                        Right [[Char]]
args -> Mode a -> [[Char]] -> IO a
forall a. Mode a -> [[Char]] -> IO a
processValueIO Mode a
m [[Char]]
args


readMay :: Read a => String -> Maybe a
readMay :: forall a. Read a => [Char] -> Maybe a
readMay [Char]
s = case [a
x | (a
x,[Char]
t) <- ReadS a
forall a. Read a => ReadS a
reads [Char]
s, ([Char]
"",[Char]
"") <- ReadS [Char]
lex [Char]
t] of
                [a
x] -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
                [a]
_ -> Maybe a
forall a. Maybe a
Nothing


#if __GLASGOW_HASKELL__ < 800
errorWithoutStackTrace :: String -> a
errorWithoutStackTrace = error
#endif

-- | Process a list of flags (usually obtained from @'getArgs'@ and @'expandArgsAt'@) with a mode.
--   Throws an error if the command line fails to parse, or returns
--   the associated value. Implemeneted in terms of 'process'. This function
--   does not take account of any environment variables that may be set
--   (see 'processArgs').
--
--   If you are in 'IO' you will probably get a better user experience by calling 'processValueIO'.
processValue :: Mode a -> [String] -> a
processValue :: forall a. Mode a -> [[Char]] -> a
processValue Mode a
m [[Char]]
xs = case Mode a -> [[Char]] -> Either [Char] a
forall a. Mode a -> [[Char]] -> Either [Char] a
process Mode a
m [[Char]]
xs of
    Left [Char]
x -> [Char] -> a
forall a. [Char] -> a
errorWithoutStackTrace [Char]
x
    Right a
x -> a
x

-- | Like 'processValue' but on failure prints to stderr and exits the program.
processValueIO :: Mode a -> [String] -> IO a
processValueIO :: forall a. Mode a -> [[Char]] -> IO a
processValueIO Mode a
m [[Char]]
xs = case Mode a -> [[Char]] -> Either [Char] a
forall a. Mode a -> [[Char]] -> Either [Char] a
process Mode a
m [[Char]]
xs of
    Left [Char]
x -> do Handle -> [Char] -> IO ()
hPutStrLn Handle
stderr [Char]
x; IO a
forall a. IO a
exitFailure
    Right a
x -> a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x


-- | Create a help flag triggered by @-?@/@--help@.
flagHelpSimple :: (a -> a) -> Flag a
flagHelpSimple :: forall a. (a -> a) -> Flag a
flagHelpSimple a -> a
f = [[Char]] -> (a -> a) -> [Char] -> Flag a
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"help",[Char]
"?"] a -> a
f [Char]
"Display help message"


-- | Create a help flag triggered by @-?@/@--help@. The user
--   may optionally modify help by specifying the format, such as:
--
-- > --help=all          - help for all modes
-- > --help=html         - help in HTML format
-- > --help=100          - wrap the text at 100 characters
-- > --help=100,one      - full text wrapped at 100 characters
flagHelpFormat :: (HelpFormat -> TextFormat -> a -> a) -> Flag a
flagHelpFormat :: forall a. (HelpFormat -> TextFormat -> a -> a) -> Flag a
flagHelpFormat HelpFormat -> TextFormat -> a -> a
f = ([Char] -> [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
forall a.
[Char] -> [[Char]] -> Update a -> [Char] -> [Char] -> Flag a
flagOpt [Char]
"" [[Char]
"help",[Char]
"?"] Update a
upd [Char]
"" [Char]
"Display help message"){flagInfo = FlagOptRare ""}
    where
        upd :: Update a
upd [Char]
s a
v = case [Char] -> Either [Char] (HelpFormat, TextFormat)
format [Char]
s of
            Left [Char]
e -> [Char] -> Either [Char] a
forall a b. a -> Either a b
Left [Char]
e
            Right (HelpFormat
a,TextFormat
b) -> a -> Either [Char] a
forall a b. b -> Either a b
Right (a -> Either [Char] a) -> a -> Either [Char] a
forall a b. (a -> b) -> a -> b
$ HelpFormat -> TextFormat -> a -> a
f HelpFormat
a TextFormat
b a
v

        format :: String -> Either String (HelpFormat,TextFormat)
        format :: [Char] -> Either [Char] (HelpFormat, TextFormat)
format [Char]
xs = (Either [Char] (HelpFormat, TextFormat)
 -> [Char] -> Either [Char] (HelpFormat, TextFormat))
-> Either [Char] (HelpFormat, TextFormat)
-> [[Char]]
-> Either [Char] (HelpFormat, TextFormat)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Either [Char] (HelpFormat, TextFormat)
acc [Char]
x -> [Char]
-> (HelpFormat, TextFormat)
-> Either [Char] (HelpFormat, TextFormat)
f [Char]
x ((HelpFormat, TextFormat)
 -> Either [Char] (HelpFormat, TextFormat))
-> Either [Char] (HelpFormat, TextFormat)
-> Either [Char] (HelpFormat, TextFormat)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either [Char] (HelpFormat, TextFormat)
acc) ((HelpFormat, TextFormat) -> Either [Char] (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat, TextFormat)
forall a. Default a => a
def) ([Char] -> [[Char]]
sep [Char]
xs)
            where
                sep :: [Char] -> [[Char]]
sep = [Char] -> [[Char]]
words ([Char] -> [[Char]]) -> ([Char] -> [Char]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x Char -> [Char] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
":," then Char
' ' else Char -> Char
toLower Char
x)
                f :: [Char]
-> (HelpFormat, TextFormat)
-> Either [Char] (HelpFormat, TextFormat)
f [Char]
x (HelpFormat
a,TextFormat
b) = case [Char]
x of
                    [Char]
"all" -> (HelpFormat, TextFormat) -> Either [Char] (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
HelpFormatAll,TextFormat
b)
                    [Char]
"one" -> (HelpFormat, TextFormat) -> Either [Char] (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
HelpFormatOne,TextFormat
b)
                    [Char]
"def" -> (HelpFormat, TextFormat) -> Either [Char] (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
HelpFormatDefault,TextFormat
b)
                    [Char]
"html" -> (HelpFormat, TextFormat) -> Either [Char] (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
a,TextFormat
HTML)
                    [Char]
"text" -> (HelpFormat, TextFormat) -> Either [Char] (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
a,TextFormat
defaultWrap)
                    [Char]
"bash" -> (HelpFormat, TextFormat) -> Either [Char] (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
HelpFormatBash,Int -> TextFormat
Wrap Int
1000000)
                    [Char]
"zsh"  -> (HelpFormat, TextFormat) -> Either [Char] (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
HelpFormatZsh ,Int -> TextFormat
Wrap Int
1000000)
                    [Char]
_ | (Char -> Bool) -> [Char] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit [Char]
x -> (HelpFormat, TextFormat) -> Either [Char] (HelpFormat, TextFormat)
forall a b. b -> Either a b
Right (HelpFormat
a,Int -> TextFormat
Wrap (Int -> TextFormat) -> Int -> TextFormat
forall a b. (a -> b) -> a -> b
$ [Char] -> Int
forall a. Read a => [Char] -> a
read [Char]
x)
                    [Char]
_ -> [Char] -> Either [Char] (HelpFormat, TextFormat)
forall a b. a -> Either a b
Left [Char]
"unrecognised help format, expected one of: all one def html text <NUMBER>"


-- | Create a version flag triggered by @-V@/@--version@.
flagVersion :: (a -> a) -> Flag a
flagVersion :: forall a. (a -> a) -> Flag a
flagVersion a -> a
f = [[Char]] -> (a -> a) -> [Char] -> Flag a
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"version",[Char]
"V"] a -> a
f [Char]
"Print version information"

-- | Create a version flag triggered by @--numeric-version@.
flagNumericVersion :: (a -> a) -> Flag a
flagNumericVersion :: forall a. (a -> a) -> Flag a
flagNumericVersion a -> a
f = [[Char]] -> (a -> a) -> [Char] -> Flag a
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"numeric-version"] a -> a
f [Char]
"Print just the version number"


-- | Create verbosity flags triggered by @-v@/@--verbose@ and
--   @-q@/@--quiet@
flagsVerbosity :: (Verbosity -> a -> a) -> [Flag a]
flagsVerbosity :: forall a. (Verbosity -> a -> a) -> [Flag a]
flagsVerbosity Verbosity -> a -> a
f =
    [[[Char]] -> (a -> a) -> [Char] -> Flag a
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"verbose",[Char]
"v"] (Verbosity -> a -> a
f Verbosity
Loud) [Char]
"Loud verbosity"
    ,[[Char]] -> (a -> a) -> [Char] -> Flag a
forall a. [[Char]] -> (a -> a) -> [Char] -> Flag a
flagNone [[Char]
"quiet",[Char]
"q"] (Verbosity -> a -> a
f Verbosity
Quiet) [Char]
"Quiet verbosity"]