1{-# LANGUAGE ScopedTypeVariables, CPP #-}
2{-|
3    This module constructs command lines. You may either use the helper functions
4    ('flagNone', 'flagOpt', 'mode' etc.) or construct the type directly. These
5    types are intended to give all the necessary power to the person constructing
6    a command line parser.
7
8    For people constructing simpler command line parsers, the module
9    "System.Console.CmdArgs.Implicit" may be more appropriate.
10
11    As an example of a parser:
12
13    @
14    arguments :: 'Mode' [(String,String)]
15    arguments = 'mode' \"explicit\" [] \"Explicit sample program\" ('flagArg' (upd \"file\") \"FILE\")
16        ['flagOpt' \"world\" [\"hello\",\"h\"] (upd \"world\") \"WHO\" \"World argument\"
17        ,'flagReq' [\"greeting\",\"g\"] (upd \"greeting\") \"MSG\" \"Greeting to give\"
18        ,'flagHelpSimple' ((\"help\",\"\"):)]
19        where upd msg x v = Right $ (msg,x):v
20    @
21
22    And this can be invoked by:
23
24    @
25    main = do
26        xs <- 'processArgs' arguments
27        if (\"help\",\"\") \`elem\` xs then
28            print $ 'helpText' [] 'HelpFormatDefault' arguments
29         else
30            print xs
31    @
32
33    /Groups/: The 'Group' structure allows flags/modes to be grouped for the purpose of
34    displaying help. When processing command lines, the group structure is ignored.
35
36    /Modes/: The Explicit module allows multiple mode programs by placing additional modes
37    in 'modeGroupModes'. Every mode is allowed sub-modes, and thus multiple levels of mode
38    may be created. Given a mode @x@ with sub-modes @xs@, if the first argument corresponds
39    to the name of a sub-mode, then that sub-mode will be applied. If not, then the arguments
40    will be processed by mode @x@. Consequently, if you wish to force the user to explicitly
41    enter a mode, simply give sub-modes, and leave 'modeArgs' as @Nothing@. Alternatively, if
42    you want one sub-mode to be selected by default, place all it's flags both in the sub-mode
43    and the outer mode.
44
45    /Parsing rules/: Command lines are parsed as per most GNU programs. Short arguments single
46    letter flags start with @-@, longer flags start with @--@, and everything else is considered
47    an argument. Anything after @--@ alone is considered to be an argument. For example:
48
49  > -f --flag argument1 -- --argument2
50
51    This command line passes one single letter flag (@f@), one longer flag (@flag@) and two arguments
52    (@argument1@ and @--argument2@).
53-}
54module System.Console.CmdArgs.Explicit(
55    -- * Running command lines
56    process, processArgs, processValue, processValueIO,
57    -- * Constructing command lines
58    module System.Console.CmdArgs.Explicit.Type,
59    flagHelpSimple, flagHelpFormat, flagVersion, flagNumericVersion, flagsVerbosity,
60    -- * Displaying help
61    module System.Console.CmdArgs.Explicit.Help,
62    -- * Utilities for working with command lines
63    module System.Console.CmdArgs.Explicit.ExpandArgsAt,
64    module System.Console.CmdArgs.Explicit.SplitJoin,
65    Complete(..), complete
66    ) where
67
68import System.Console.CmdArgs.Explicit.Type
69import System.Console.CmdArgs.Explicit.Process
70import System.Console.CmdArgs.Explicit.Help
71import System.Console.CmdArgs.Explicit.ExpandArgsAt
72import System.Console.CmdArgs.Explicit.SplitJoin
73import System.Console.CmdArgs.Explicit.Complete
74import System.Console.CmdArgs.Default
75import System.Console.CmdArgs.Helper
76import System.Console.CmdArgs.Text
77import System.Console.CmdArgs.Verbosity
78
79import Control.Monad
80import Data.Char
81import Data.Maybe
82import System.Environment
83import System.Exit
84import System.IO
85
86
87-- | Process the flags obtained by @'getArgs'@ and @'expandArgsAt'@ with a mode. Displays
88--   an error and exits with failure if the command line fails to parse, or returns
89--   the associated value. Implemented in terms of 'process'. This function makes
90--   use of the following environment variables:
91--
92-- * @$CMDARGS_COMPLETE@ - causes the program to produce completions using 'complete', then exit.
93--   Completions are based on the result of 'getArgs', the index of the current argument is taken
94--   from @$CMDARGS_COMPLETE@ (set it to @-@ to complete the last argument), and the index within
95--   that argument is taken from @$CMDARGS_COMPLETE_POS@ (if set).
96--
97-- * @$CMDARGS_HELPER@\/@$CMDARGS_HELPER_/PROG/@ - uses the helper mechanism for entering command
98--   line programs as described in "System.Console.CmdArgs.Helper".
99processArgs :: Mode a -> IO a
100processArgs m = do
101    env <- getEnvironment
102    case lookup "CMDARGS_COMPLETE" env of
103        Just x -> do
104            args <- getArgs
105            let argInd = fromMaybe (length args - 1) $ readMay x
106                argPos = fromMaybe (if argInd >= 0 && argInd < length args then length (args !! argInd) else 0) $
107                         readMay =<< lookup "CMDARGS_COMPLETE_POS" env
108            print $ complete m (concatMap words args) (argInd,argPos)
109            exitWith ExitSuccess
110        Nothing -> do
111            nam <- getProgName
112            let var = mplus (lookup ("CMDARGS_HELPER_" ++ show (map toUpper $ head $ modeNames m ++ [nam])) env)
113                            (lookup "CMDARGS_HELPER" env)
114            case var of
115                Nothing -> processValueIO m =<< (if modeExpandAt m then expandArgsAt else return) =<< getArgs
116                Just cmd -> do
117                    res <- execute cmd m []
118                    case res of
119                        Left err -> do
120                            hPutStrLn stderr $ "Error when running helper " ++ cmd
121                            hPutStrLn stderr err
122                            exitFailure
123                        Right args -> processValueIO m args
124
125
126readMay :: Read a => String -> Maybe a
127readMay s = case [x | (x,t) <- reads s, ("","") <- lex t] of
128                [x] -> Just x
129                _ -> Nothing
130
131
132#if __GLASGOW_HASKELL__ < 800
133errorWithoutStackTrace :: String -> a
134errorWithoutStackTrace = error
135#endif
136
137-- | Process a list of flags (usually obtained from @'getArgs'@ and @'expandArgsAt'@) with a mode.
138--   Throws an error if the command line fails to parse, or returns
139--   the associated value. Implemeneted in terms of 'process'. This function
140--   does not take account of any environment variables that may be set
141--   (see 'processArgs').
142--
143--   If you are in 'IO' you will probably get a better user experience by calling 'processValueIO'.
144processValue :: Mode a -> [String] -> a
145processValue m xs = case process m xs of
146    Left x -> errorWithoutStackTrace x
147    Right x -> x
148
149-- | Like 'processValue' but on failure prints to stderr and exits the program.
150processValueIO :: Mode a -> [String] -> IO a
151processValueIO m xs = case process m xs of
152    Left x -> do hPutStrLn stderr x; exitFailure
153    Right x -> return x
154
155
156-- | Create a help flag triggered by @-?@/@--help@.
157flagHelpSimple :: (a -> a) -> Flag a
158flagHelpSimple f = flagNone ["help","?"] f "Display help message"
159
160
161-- | Create a help flag triggered by @-?@/@--help@. The user
162--   may optionally modify help by specifying the format, such as:
163--
164-- > --help=all          - help for all modes
165-- > --help=html         - help in HTML format
166-- > --help=100          - wrap the text at 100 characters
167-- > --help=100,one      - full text wrapped at 100 characters
168flagHelpFormat :: (HelpFormat -> TextFormat -> a -> a) -> Flag a
169flagHelpFormat f = (flagOpt "" ["help","?"] upd "" "Display help message"){flagInfo = FlagOptRare ""}
170    where
171        upd s v = case format s of
172            Left e -> Left e
173            Right (a,b) -> Right $ f a b v
174
175        format :: String -> Either String (HelpFormat,TextFormat)
176        format xs = foldl (\acc x -> either Left (f x) acc) (Right def) (sep xs)
177            where
178                sep = words . map (\x -> if x `elem` ":," then ' ' else toLower x)
179                f x (a,b) = case x of
180                    "all" -> Right (HelpFormatAll,b)
181                    "one" -> Right (HelpFormatOne,b)
182                    "def" -> Right (HelpFormatDefault,b)
183                    "html" -> Right (a,HTML)
184                    "text" -> Right (a,defaultWrap)
185                    "bash" -> Right (HelpFormatBash,Wrap 1000000)
186                    "zsh"  -> Right (HelpFormatZsh ,Wrap 1000000)
187                    _ | all isDigit x -> Right (a,Wrap $ read x)
188                    _ -> Left "unrecognised help format, expected one of: all one def html text <NUMBER>"
189
190
191-- | Create a version flag triggered by @-V@/@--version@.
192flagVersion :: (a -> a) -> Flag a
193flagVersion f = flagNone ["version","V"] f "Print version information"
194
195-- | Create a version flag triggered by @--numeric-version@.
196flagNumericVersion :: (a -> a) -> Flag a
197flagNumericVersion f = flagNone ["numeric-version"] f "Print just the version number"
198
199
200-- | Create verbosity flags triggered by @-v@/@--verbose@ and
201--   @-q@/@--quiet@
202flagsVerbosity :: (Verbosity -> a -> a) -> [Flag a]
203flagsVerbosity f =
204    [flagNone ["verbose","v"] (f Loud) "Loud verbosity"
205    ,flagNone ["quiet","q"] (f Quiet) "Quiet verbosity"]
206