cmdargs 0.1 → 0.2

raw patch · 41 files changed

+2893/−1123 lines, 41 filessetup-changedPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Generics/Any.hs +119/−0
• Data/Generics/Any/Prelude.hs +57/−0
• Diffy.hs +0/−24
• HLint.hs +0/−35
• Main.hs +53/−87
• Maker.hs +0/−34
• Setup.hs +2/−0
• System/Console/CmdArgs.hs +3/−203
• System/Console/CmdArgs/Default.hs +30/−0
• System/Console/CmdArgs/Expand.hs +0/−83
• System/Console/CmdArgs/Explicit.hs +72/−0
• System/Console/CmdArgs/Explicit/Help.hs +93/−0
• System/Console/CmdArgs/Explicit/Process.hs +150/−0
• System/Console/CmdArgs/Explicit/Type.hs +221/−0
• System/Console/CmdArgs/Flag.hs +0/−127
• System/Console/CmdArgs/GetOpt.hs +93/−0
• System/Console/CmdArgs/Help.hs +0/−50
• System/Console/CmdArgs/Implicit.hs +147/−0
• System/Console/CmdArgs/Implicit/Ann.hs +25/−0
• System/Console/CmdArgs/Implicit/Capture.hs +80/−0
• System/Console/CmdArgs/Implicit/Read.hs +137/−0
• System/Console/CmdArgs/Implicit/Step1.hs +177/−0
• System/Console/CmdArgs/Implicit/Step2.hs +128/−0
• System/Console/CmdArgs/Implicit/Step3.hs +189/−0
• System/Console/CmdArgs/Implicit/UI.hs +161/−0
• System/Console/CmdArgs/Test/All.hs +18/−0
• System/Console/CmdArgs/Test/Explicit.hs +80/−0
• System/Console/CmdArgs/Test/GetOpt.hs +42/−0
• System/Console/CmdArgs/Test/Implicit.hs +12/−0
• System/Console/CmdArgs/Test/Implicit/Diffy.hs +44/−0
• System/Console/CmdArgs/Test/Implicit/HLint.hs +71/−0
• System/Console/CmdArgs/Test/Implicit/Maker.hs +51/−0
• System/Console/CmdArgs/Test/Implicit/Tests.hs +149/−0
• System/Console/CmdArgs/Test/Implicit/Util.hs +46/−0
• System/Console/CmdArgs/Test/Util.hs +32/−0
• System/Console/CmdArgs/Text.hs +149/−0
• System/Console/CmdArgs/Type.hs +0/−85
• System/Console/CmdArgs/UI.hs +0/−229
• System/Console/CmdArgs/Verbosity.hs +60/−0
• cmdargs.cabal +55/−15
• cmdargs.htm +147/−151

@@ -0,0 +1,119 @@+{-# LANGUAGE ExistentialQuantification #-}++module Data.Generics.Any where++import Control.Monad.State+import qualified Data.Data as D+import Data.Data hiding (toConstr, typeOf, dataTypeOf, isAlgType)+import Data.List+import Data.Maybe+++type CtorName = String+type FieldName = String+++readTupleType :: String -> Maybe Int+readTupleType x | "(" `isPrefixOf` x && ")" `isSuffixOf` x && all (== ',') y = Just $ length y+                | otherwise = Nothing+    where y = init $ tail x+++---------------------------------------------------------------------+-- BASIC TYPES++data Any = forall a . Data a => Any a+type AnyT t = Any++instance Show Any where+    show = show . typeOf++fromAny :: Data a => Any -> a+fromAny (Any x) = case cast x of+    Just y -> y+    ~(Just y) -> error $ "Data.Generics.Any.fromAny: Failed to extract any, got " +++                         show (D.typeOf x) ++ ", wanted " ++ show (D.typeOf y)+++---------------------------------------------------------------------+-- SYB COMPATIBILITY++toConstr :: Any -> Constr+toConstr (Any x) = D.toConstr x++typeOf :: Any -> TypeRep+typeOf (Any x) = D.typeOf x++dataTypeOf :: Any -> DataType+dataTypeOf (Any x) = D.dataTypeOf x++isAlgType :: Any -> Bool+isAlgType = D.isAlgType . dataTypeOf++---------------------------------------------------------------------+-- TYPE STUFF++typeShell :: Any -> String+typeShell = tyconUQname . typeShellFull++typeShellFull :: Any -> String+typeShellFull = tyConString . typeRepTyCon . typeOf++typeName :: Any -> String+typeName = show . typeOf++---------------------------------------------------------------------+-- ANY PRIMITIVES++ctor :: Any -> CtorName+ctor = showConstr . toConstr++fields :: Any -> [String]+fields = constrFields . toConstr++children :: Any -> [Any]+children (Any x) = gmapQ Any x+++compose0 :: Any -> CtorName -> Any+compose0 (Any x) c = Any $ fromConstrB err y `asTypeOf` x+    where Just y = readConstr (D.dataTypeOf x) c+          err = error $ "Data.Generics.Any: Undefined field inside compose0, " ++ c ++ " :: " ++ show (Any x)+++recompose :: Any -> [Any] -> Any+recompose (Any x) cs = Any $ res `asTypeOf` x+    where res = flip evalState cs $ flip fromConstrM (D.toConstr x) $ do+                    c:cs <- get; put cs; return $ fromAny c+++ctors :: Any -> [CtorName]+ctors = map showConstr . dataTypeConstrs . dataTypeOf++---------------------------------------------------------------------+-- DERIVED FUNCTIONS++decompose :: Any -> (CtorName,[Any])+decompose x = (ctor x, children x)++arity = length . children++compose :: Any -> CtorName -> [Any] -> Any+compose t c xs = recompose (compose0 t c) xs+++---------------------------------------------------------------------+-- FIELD UTILITIES++getField :: FieldName -> Any -> Any+getField lbl x = fromMaybe (error $ "getField: Could not find field " ++ show lbl) $+    lookup lbl $ zip (fields x) (children x)+++setField :: (FieldName,Any) -> Any -> Any+setField (lbl,child) parent+    | lbl `notElem` fs = error $ "setField: Could not find field " ++ show lbl+    | otherwise = recompose parent $ zipWith (\f c -> if f == lbl then child else c) fs cs+    where+        fs = fields parent+        cs = children parent

@@ -0,0 +1,57 @@+{-# LANGUAGE ViewPatterns #-}++module Data.Generics.Any.Prelude where++import Prelude hiding (head,tail,null)+import Data.Generics.Any+import Data.Maybe+++head :: AnyT [a] -> AnyT a+head (decompose -> ("(:)",[x,_])) = x++tail :: AnyT [a] -> AnyT [a]+tail (decompose -> ("(:)",[_,x])) = x++cons :: AnyT a -> AnyT [a] -> AnyT [a]+cons x y = compose y "(:)" [x,y]++null :: AnyT [a] -> Bool+null x | isList x = ctor x == "[]"++just_ :: AnyT (Maybe a) -> AnyT a -> AnyT (Maybe a)+just_ w x = compose w "Just" [x]++nil_ :: AnyT [a] -> AnyT [a]+nil_ w = compose w "[]" []++append :: AnyT [a] -> AnyT [a] -> AnyT [a]+append x y | typeOf x == typeOf y = f x y+    where f x y | null x = y+                | otherwise = cons (head x) (f (tail x) y)+++isList x = typeShell x == "[]"+isMaybe x = typeShell x == "Maybe"+isTuple x = isJust $ readTupleType $ typeShell x++fromList w = children (compose0 w "(:)") !! 0+fromMaybe w = children (compose0 w "Just") !! 0+fromTuple w = children (compose0 w $ typeShell w)++unit :: AnyT ()+unit = Any ()++-- Could use a witness and avoid switching on the list of tuples, but this+-- presents a nicer interface+tuple :: [Any] -> Any+tuple [] = unit+tuple [x] = x+-- $(2\7 tuple [$(1,$ Any x$)] = Any ($(1,$ x$)))+tuple [Any x1,Any x2] = Any (x1,x2)+tuple [Any x1,Any x2,Any x3] = Any (x1,x2,x3)+tuple [Any x1,Any x2,Any x3,Any x4] = Any (x1,x2,x3,x4)+tuple [Any x1,Any x2,Any x3,Any x4,Any x5] = Any (x1,x2,x3,x4,x5)+tuple [Any x1,Any x2,Any x3,Any x4,Any x5,Any x6] = Any (x1,x2,x3,x4,x5,x6)+tuple [Any x1,Any x2,Any x3,Any x4,Any x5,Any x6,Any x7] = Any (x1,x2,x3,x4,x5,x6,x7)+tuple _ = error "Data.Generics.Any: Tuples of 8 elements or more are not supported by Data.Data"

@@ -1,24 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-module Diffy where-import System.Console.CmdArgs--data Diffy = Create {src :: FilePath, out :: FilePath}-           | Diff {old :: FilePath, new :: FilePath, out :: FilePath}-             deriving (Data,Typeable,Show,Eq)--outFlags = text "Output file" & typFile--create = mode $ Create-    {src = "." &= text "Source directory" & typDir-    ,out = "ls.txt" &= outFlags-    } &= prog "diffy" & text "Create a fingerprint"--diff = mode $ Diff-    {old = def &= typ "OLDFILE" & argPos 0-    ,new = def &= typ "NEWFILE" & argPos 1-    ,out = "diff.txt" &= outFlags-    } &= text "Perform a diff"--modes = [create,diff]--main = print =<< cmdArgs "Diffy v1.0" modes

@@ -1,35 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-module HLint where-import System.Console.CmdArgs--data HLint = HLint-    {report :: [FilePath]-    ,hint :: [FilePath]-    ,color :: Bool-    ,ignore :: [String]-    ,show_ :: Bool-    ,test :: Bool-    ,cpp_define :: [String]-    ,cpp_include :: [String]-    ,files :: [String]-    }-    deriving (Data,Typeable,Show,Eq)--hlint = mode $ HLint-    {report = def &= empty "report.html" & typFile & text "Generate a report in HTML"-    ,hint = def &= typFile & text "Hint/ignore file to use"-    ,color = def &= flag "c" & flag "colour" & text "Color the output (requires ANSI terminal)"-    ,ignore = def &= typ "MESSAGE" & text "Ignore a particular hint"-    ,show_ = def &= text "Show all ignored ideas"-    ,test = def &= text "Run in test mode"-    ,cpp_define = def &= typ "NAME[=VALUE]" & text "CPP #define"-    ,cpp_include = def &= typDir & text "CPP include path"-    ,files = def &= args & typ "FILE/DIR"-    } &=-    prog "hlint" &-    text "Suggest improvements to Haskell source code" &-    helpSuffix ["To check all Haskell files in 'src' and generate a report type:","  hlint src --report"]--modes = [hlint]--main = print =<< cmdArgs "HLint v1.6.5, (C) Neil Mitchell 2006-2009" modes

@@ -1,91 +1,46 @@-{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE PatternGuards #-}  module Main where -import System.Console.CmdArgs-import Control.Monad-import System.IO-import System.Environment-import Control.Exception-import Data.List+import System.Console.CmdArgs.Test.All+import qualified System.Console.CmdArgs.Test.Implicit.Diffy as D+import qualified System.Console.CmdArgs.Test.Implicit.HLint as H+import qualified System.Console.CmdArgs.Test.Implicit.Maker as M+import System.Console.CmdArgs.Implicit(CmdArgs(..))+import System.Console.CmdArgs.Explicit+import System.Console.CmdArgs.Text+import System.Console.CmdArgs.Default -import qualified HLint as H-import qualified Diffy as D-import qualified Maker as M+import Data.List+import Data.Maybe+import System.IO  -main = do-    args <- getArgs-    case args of-        "hlint":xs -> withArgs xs H.main-        "diffy":xs -> withArgs xs D.main-        "maker":xs -> withArgs xs M.main-        "test":_ -> testHLint >> testDiffy >> testMaker >> putStrLn "Test successful"-        "generate":_ -> generateManual-        _ -> error "CmdArgs test program, expected one of: test hlint diffy maker"-+data Args = Test+          | Generate+          | Help HelpFormat TextFormat+          | Version+          | Demo Demo -test x = (map modeValue x, (===), fails)+args = (modes "cmdargs" (Help def def) "CmdArgs demo program" ms){modeGroupFlags = toGroup flags}     where-        (===) args v = do-            res <- withArgs args $ cmdArgs "" x-            when (res /= v) $-                error $ "Mismatch on flags " ++ show args--        fails args = do-            res <- try $ withArgs args $ cmdArgs "" x-            case res of-                Left (e :: SomeException) -> return ()-                Right _ -> error $ "Expected failure " ++ show args--------------------------------------------------------------------------- TESTS--testHLint = do-    let ([v],(===),fails) = test H.modes-    [] === v-    fails ["-ch"]-    ["--colo"] === v{H.color=True}-    ["-ct"] === v{H.color=True,H.test=True}-    ["--colour","--test"] === v{H.color=True,H.test=True}-    ["-thfoo"] === v{H.test=True,H.hint=["foo"]}-    ["-cr"] === v{H.color=True,H.report=["report.html"]}-    ["--cpp-define=val","x"] === v{H.cpp_define=["val"],H.files=["x"]}-    fails ["--cpp-define"]-    ["--cpp-define","val","x","y"] === v{H.cpp_define=["val"],H.files=["x","y"]}-+        flags = [flagHelpFormat $ \a b _ -> Help a b+                ,flagVersion $ const Version+                ,flagNone ["t","test"] (const Test) "Run the tests"+                ,flagNone ["g","generate"] (const Generate) "Generate the manual"] -testDiffy = do-    let ([create,diff],(===),fails) = test D.modes-    fails []-    ["create"] === create-    fails ["create","file1"]-    ["create","--src","x"] === create{D.src="x"}-    ["create","--src","x","--src","y"] === create{D.src="y"}-    fails ["diff","--src","x"]-    fails ["create","foo"]-    ["diff","foo1","foo2"] === diff{D.old="foo1",D.new="foo2"}-    fails ["diff","foo1"]-    fails ["diff","foo1","foo2","foo3"]+        ms = map (remap Demo (\(Demo x) -> (x,Demo))) demo  -testMaker = do-    let ([build,wipe,tst],(===),fails) = test M.modes-    [] === build-    ["build","foo","--profile"] === build{M.files=["foo"],M.method=M.Profile}-    ["foo","--profile"] === build{M.files=["foo"],M.method=M.Profile}-    ["foo","--profile","--release"] === build{M.files=["foo"],M.method=M.Release}-    ["-d"] === build{M.method=M.Debug}-    ["build","-j3"] === build{M.threads=3}-    ["build","-j=3"] === build{M.threads=3}-    fails ["build","-jN"]-    -- FIXME: should fail, but -t gets intepreted as --t, which matches --threaded-    -- fails ["build","-t1"]-    ["wipe"] === wipe-    ["test"] === tst-    ["test","foo"] === tst{M.extra=["foo"]}-    ["test","foo","-baz","-j3","--what=1"] === tst{M.extra=["foo","-baz","--what=1"],M.threads=3}+main = do+    x <- processArgs args+    let ver = "CmdArgs demo program, (C) Neil Mitchell"+    case x of+        Version -> putStrLn ver+        Help hlp txt -> putStrLn $ showText txt $ Line ver : Line "" : helpText hlp args+        Test -> test+        Generate -> generateManual+        Demo x -> runDemo x   ---------------------------------------------------------------------@@ -109,15 +64,26 @@         f (x:xs) = fmap (x:) $ f xs  generateChunk :: [String] -> IO [String]-generateChunk ["help",x] = do-    src <- readFile $ x ++ ".hs"-    let str = head [takeWhile (/= '\"') $ drop 1 $ dropWhile (/= '\"') x | x <- lines src, "main" `isPrefixOf` x]-    () <- length src `seq` return ()-    fmap lines $ case x of-        "hlint" -> cmdArgsHelp str H.modes HTML-        "diffy" -> cmdArgsHelp str D.modes HTML-        "maker" -> cmdArgsHelp str M.modes HTML+generateChunk ["help",x] = return $ case x of+    "hlint" -> f H.mode+    "diffy" -> f D.mode+    "maker" -> f M.mode+    where f = lines . fromJust . cmdArgsHelp . flip processValue ["--help=html"]  generateChunk ["code",x] = do-    src <- readFile $ x ++ ".hs"-    return $ ["<pre>"] ++ lines src ++ ["</pre>"]+    src <- readFile $ "System/Console/CmdArgs/Test/Implicit/" ++ x ++ ".hs"+    return $ ["<pre>"] ++ recode (lines src) ++ ["</pre>"]+++recode :: [String] -> [String]+recode = concatMap f . blanks . takeWhile (not . isPrefixOf "test")+    where+        blanks ("":"":xs) = blanks ("":xs)+        blanks [""] = []+        blanks [] = []+        blanks (x:xs) = x : blanks xs++        f x | x == "import System.Console.CmdArgs.Test.Implicit.Util" = []+            | "{-# LANGUAGE " `isPrefixOf` x = ["{-# LANGUAGE DeriveDataTypeable #-}"]+            | "module System.Console.CmdArgs.Test.Implicit." `isPrefixOf` x = ["module " ++ drop 44 x]+        f x = [x]

@@ -1,34 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-module Maker where-import System.Console.CmdArgs--data Method = Debug | Release | Profile-              deriving (Data,Typeable,Show,Eq)--data Maker-    = Wipe-    | Test {threads :: Int, extra :: [String]}-    | Build {threads :: Int, method :: Method, files :: [FilePath]}-      deriving (Data,Typeable,Show,Eq)--threadsMsg = text "Number of threads to use" & flag "j" & typ "NUM"--wipe = mode $ Wipe &= prog "maker" & text "Clean all build objects"--test = mode $ Test-    {threads = def &= threadsMsg-    ,extra = def &= typ "ANY" & args & unknownFlags-    } &= text "Run the test suite"--build = mode $ Build-    {threads = def &= threadsMsg-    ,method = enum Release-        [Debug &= text "Debug build"-        ,Release &= text "Release build"-        ,Profile &= text "Profile build"]-    ,files = def &= args-    } &= text "Build the project" & defMode--modes = [build,wipe,test]--main = print =<< cmdArgs "Maker v1.0" modes

@@ -1,2 +1,4 @@+#! /usr/bin/runhaskell+ import Distribution.Simple main = defaultMain

@@ -1,205 +1,5 @@-{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, PatternGuards #-}-{-|-    This module provides simple command line argument processing.-    The main function of interest is 'cmdArgs'.-    A simple example is:--    @data Sample = Sample {hello :: String} deriving (Show, Data, Typeable)@--    @sample = 'mode' $ Sample{hello = def '&=' 'text' \"World argument\" '&' 'empty' \"world\"}@--    @main = print =<< 'cmdArgs' \"Sample v1, (C) Neil Mitchell 2009\" [sample]@---    Attributes are used to control a number of behaviours:-    -    * The help message: 'text', 'typ', 'helpSuffix', 'prog'-    -    * Default behaviour: 'empty', 'defMode'-    -    * Flag name assignment: 'flag', 'explicit', 'enum'-    -    * Controlling non-flag arguments: 'args', 'argPos', 'unknownFlags'--}--module System.Console.CmdArgs(-    -- * Running command lines-    cmdArgs, modeValue,-    -- * Attributes-    module System.Console.CmdArgs.UI,-    -- * Verbosity control-    isQuiet, isNormal, isLoud,-    -- * Display help information-    HelpFormat(..), cmdArgsHelp,-    -- * Default values-    Default(..),-    -- * Re-exported for convenience-    Data, Typeable-    ) where--import System.IO.Unsafe-import Data.Dynamic-import Data.Data-import Data.List-import Data.Maybe-import Data.IORef-import System.Environment-import System.Exit-import System.FilePath-import Data.Char-import Control.Monad.State-import Data.Function--import System.Console.CmdArgs.Type-import System.Console.CmdArgs.UI-import System.Console.CmdArgs.Expand-import System.Console.CmdArgs.Flag-import System.Console.CmdArgs.Help--------------------------------------------------------------------------- DEFAULTS---- | Class for default values-class Default a where-    -- | Provide a default value-    def :: a--instance Default Bool where def = False-instance Default [a] where def = []-instance Default Int where def = 0-instance Default Integer where def = 0-instance Default Float where def = 0-instance Default Double where def = 0--------------------------------------------------------------------------- VERBOSITY CONTROL--{-# NOINLINE verbosity #-}-verbosity :: IORef Int -- 0 = quiet, 1 = normal, 2 = verbose-verbosity = unsafePerformIO $ newIORef 1---- | Used to test if essential messages should be output to the user.---   Always true (since even @--quiet@ wants essential messages output).---   Must be called after 'cmdArgs'.-isQuiet :: IO Bool-isQuiet = return True---- | Used to test if normal messages should be output to the user.---   True unless @--quiet@ is specified.---   Must be called after 'cmdArgs'.-isNormal :: IO Bool-isNormal = fmap (>=1) $ readIORef verbosity---- | Used to test if helpful debug messages should be output to the user.---   False unless @--verbose@ is specified.---   Must be called after 'cmdArgs'.-isLoud :: IO Bool-isLoud = fmap (>=2) $ readIORef verbosity--------------------------------------------------------------------------- MAIN DRIVERS---- | Extract the default value from inside a Mode.-modeValue :: Mode a -> a-modeValue = modeVal----- | The main entry point for programs using CmdArgs.---   For an example see "System.Console.CmdArgs".-cmdArgs :: Data a-    => String -- ^ Information about the program, something like: @\"ProgramName v1.0, Copyright PersonName 2000\"@.-    -> [Mode a] -- ^ The modes of operation, constructed by 'mode'. For single mode programs it is a singleton list.-    -> IO a-cmdArgs short modes = do-    modes <- return $ expand modes-    (mode,args) <- parseModes modes `fmap` getArgs-    when (hasAction args "!help") $ do-        hlp <- case mode of-            Right (True,mode) -> helpInfo short modes [mode]-            _ -> helpInfo short modes modes-        let Update _ op = fromJust $ getAction args "!help"-        putStr $ showHelp hlp (fromDyn (op undefined) "")-        exitSuccess-    when (hasAction args "!version") $ do-        putStrLn short-        exitSuccess-    mode <- case mode of-        Right (_,x) -> return x-        Left x -> putStrLn x >> exitFailure-    sequence_ [putStrLn x >> exitFailure | Error x <- args]-    when (hasAction args "!verbose") $ writeIORef verbosity 2-    when (hasAction args "!quiet") $ writeIORef verbosity 0-    return $ applyActions args $ modeValue mode--------------------------------------------------------------------------- HELP INFORMATION---- | Format to display help in.-data HelpFormat-    = Text -- ^ As output on the console.-    | HTML -- ^ Suitable for inclusion in web pages (uses a table rather than explicit wrapping).-    deriving (Eq,Ord,Show,Read,Enum,Bounded)---- | Display the help message, as it would appear with @--help@.---   The first argument should match the first argument to 'cmdArgs'.-cmdArgsHelp :: String -> [Mode a] -> HelpFormat -> IO String-cmdArgsHelp short xs format = fmap (`showHelp` (show format)) $ helpInfo short modes modes-    where modes = expand xs---helpInfo :: String -> [Mode a] -> [Mode a] -> IO [Help]-helpInfo short tot now = do-    prog <- fmap (map toLower . takeBaseName) getProgName-    prog <- return $ head $ mapMaybe modeProg tot ++ [prog]-    let info = [([Norm $ unwords $ prog : [['['|def] ++ name ++ [']'|def] | length tot /= 1] ++ "[FLAG]" : args] ++-                 [Norm $ "  " ++ text | text /= ""]-                ,concatMap helpFlag flags)-               | Mode{modeName=name,modeFlags=flags,modeText=text,modeDef=def} <- now-               , let args = map snd $ sortBy (compare `on` fst) $ concatMap helpFlagArgs flags]-    let dupes = if length now == 1 then [] else foldr1 intersect (map snd info)-    return $-        Norm short :-        concat [ Norm "" : mode ++ [Norm "" | flags /= []] ++ map Trip flags-               | (mode,args) <- info, let flags = args \\ dupes] ++-        (if null dupes then [] else Norm "":Norm "Common flags:":map Trip dupes) ++-        concat [ map Norm $ "":suf | suf@(_:_) <- map modeHelpSuffix tot]--------------------------------------------------------------------------- PROCESS FLAGS--parseModes :: [Mode a] -> [String] -> (Either String (Bool, Mode a), [Action])-parseModes modes args-    | [mode] <- modes = (Right (False,mode), parseFlags (modeFlags mode) args)-    | [] <- poss, Just mode <- def = (Right (False,mode), parseFlags (modeFlags mode) args)-    | [mode] <- poss = (Right (True, mode), parseFlags (modeFlags mode) $ tail args)-    | otherwise = (Left err, parseFlags autoFlags args)-    where-        err = if null poss-              then "No mode given, expected one of: " ++ unwords (map modeName modes)-              else "Multiple modes given, could be any of: " ++ unwords (map modeName poss)--        def = listToMaybe $ filter modeDef modes-        poss = let f eq = [m | a <- take 1 args, m <- modes, a `eq` modeName m]-                   (exact,prefix) = (f (==), f isPrefixOf)-               in if null exact then prefix else exact--------------------------------------------------------------------------- APPLICATION--setField :: Data a => a -> String -> (Dynamic -> Dynamic) -> a-setField x name v = flip evalState (constrFields $ toConstr x) $ flip gmapM x $ \i -> do-    n:ns <- get-    put ns-    return $ if n == name then fromDyn (v $ toDyn i) i else i+-- | This module re-exports the implicit command line parser. +module System.Console.CmdArgs(module System.Console.CmdArgs.Implicit) where -applyActions :: Data a => [Action] -> a -> a-applyActions (Update name op:as) x | not $ "!" `isPrefixOf` name = applyActions as $ setField x name op-applyActions (a:as) x = applyActions as x-applyActions [] x = x+import System.Console.CmdArgs.Implicit

@@ -0,0 +1,30 @@++-- | This module provides default values for many types.+--   To use the default value simply write 'def'.+module System.Console.CmdArgs.Default where+++-- | Class for default values.+class Default a where+    -- | Provide a default value, such as @()@, @False@, @0@, @[]@, @Nothing@.+    def :: a++instance Default () where def = ()+instance Default Bool where def = False+instance Default Int where def = 0+instance Default Integer where def = 0+instance Default Float where def = 0+instance Default Double where def = 0+instance Default [a] where def = []+instance Default (Maybe a) where def = Nothing++-- EXPANDY: $(2\10 instance ($(1,$ Default a$)) => Default ($(1,$ a$)) where def = ($(1,$ def)))+instance (Default a1,Default a2) => Default (a1,a2) where def = (def,def)+instance (Default a1,Default a2,Default a3) => Default (a1,a2,a3) where def = (def,def,def)+instance (Default a1,Default a2,Default a3,Default a4) => Default (a1,a2,a3,a4) where def = (def,def,def,def)+instance (Default a1,Default a2,Default a3,Default a4,Default a5) => Default (a1,a2,a3,a4,a5) where def = (def,def,def,def,def)+instance (Default a1,Default a2,Default a3,Default a4,Default a5,Default a6) => Default (a1,a2,a3,a4,a5,a6) where def = (def,def,def,def,def,def)+instance (Default a1,Default a2,Default a3,Default a4,Default a5,Default a6,Default a7) => Default (a1,a2,a3,a4,a5,a6,a7) where def = (def,def,def,def,def,def,def)+instance (Default a1,Default a2,Default a3,Default a4,Default a5,Default a6,Default a7,Default a8) => Default (a1,a2,a3,a4,a5,a6,a7,a8) where def = (def,def,def,def,def,def,def,def)+instance (Default a1,Default a2,Default a3,Default a4,Default a5,Default a6,Default a7,Default a8,Default a9) => Default (a1,a2,a3,a4,a5,a6,a7,a8,a9) where def = (def,def,def,def,def,def,def,def,def)+instance (Default a1,Default a2,Default a3,Default a4,Default a5,Default a6,Default a7,Default a8,Default a9,Default a10) => Default (a1,a2,a3,a4,a5,a6,a7,a8,a9,a10) where def = (def,def,def,def,def,def,def,def,def,def)

@@ -1,83 +0,0 @@--module System.Console.CmdArgs.Expand(defaults,expand,autoFlags) where--import System.Console.CmdArgs.Type-import Data.Dynamic-import Data.List-import Data.Maybe-import Data.Char-import Data.Function--------------------------------------------------------------------------- PRESUPPLIED ARGS--autoFlags :: [Flag]-autoFlags =-    [(f "!help" "?" "help" "Show usage information (optional format)")-        {flagType=fromJust $ toFlagType (typeOf ""),flagOpt=Just "",flagTyp="FORMAT"}-    ,f "!version" "V" "version" "Show version information"-    ,f "!verbose" "v" "verbose" "Higher verbosity"-    ,f "!quiet" "q" "quiet" "Lower verbosity"-    ]-    where f name short long text = flagDefault-            {flagName=name,flagKey=name,flagFlag=[short,long],flagText=text,flagType=FlagBool (toDyn True),flagVal=toDyn False,flagExplicit=True}-------------------------------------------------------------------------- FLAG DEFAULTS---- FIXME: Add the string (default=foo) in the appropriate places-defaults :: a -> Flag -> Flag-defaults = error "todo" --------------------------------------------------------------------------- FLAG EXPANSION--- Introduce more long/short names---- (keyname,([flags],explicit))-type FlagNames = [(String,([String],Bool))]---- Error if:---   Two things with the same FldName have different FldFlag or Explicit---   Two fields without the same FldName have different FldFlag-expand :: [Mode a] -> [Mode a]-expand xs | not $ checkFlags ys = error "Flag's don't meet their condition"-          | otherwise = xs3-    where-        xs3 = map (\x -> x{modeFlags=[if isFlagArgs c then c else c{flagFlag=fst $ fromJust $ lookup (flagKey c) ys2} | c <- modeFlags x]}) xs2-        ys2 = assignShort $ assignLong ys-        ys = sort $ nub [(flagKey x, (flagFlag x, flagExplicit x)) | x <- map modeFlags xs2, x <- x, isFlagFlag x]-        xs2 = map (\x -> x{modeFlags = autoFlags ++ modeFlags x}) xs---checkFlags :: FlagNames -> Bool-checkFlags xs | any ((/=) 1 . length) $ groupBy ((==) `on` fst) xs = error "Two record names have different flags"-              | nub names /= names = error "One flag has been assigned twice"-              | otherwise = True-    where names = concatMap (fst . snd) xs---assignLong :: FlagNames -> FlagNames-assignLong xs = map f xs-    where-        seen = concatMap (fst . snd) xs-        f (name,(already,False)) | name `notElem` seen = (name,(g name:already,False))-        f x = x-        g xs | "_" `isSuffixOf` xs = g $ init xs-        g xs = [if x == '_' then '-' else x | x <- xs]---assignShort :: FlagNames -> FlagNames-assignShort xs = zipWith (\x (a,(b,c)) -> (a,(maybe [] (return . return) x ++ b,c))) good xs-    where-        seen = concat $ filter ((==) 1 . length) $ concatMap (fst . snd) xs-        guesses = map guess xs :: [Maybe Char]-        dupes = let gs = catMaybes guesses in nub $ gs \\ nub gs-        good = [if maybe True (`elem` (dupes++seen)) g then Nothing else g | g <- guesses] :: [Maybe Char]--        -- guess at a possible short flag-        guess (name,(already,False)) | all ((/=) 1 . length) already = Just $ head $ head already-        guess _ = Nothing--

@@ -0,0 +1,72 @@++-- | 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.+module System.Console.CmdArgs.Explicit(+    -- * Running command lines+    module System.Console.CmdArgs.Explicit.Process,+    -- * Constructing command lines+    module System.Console.CmdArgs.Explicit.Type,+    module System.Console.CmdArgs.Explicit,+    -- * Displaying help+    module System.Console.CmdArgs.Explicit.Help+    ) where++import System.Console.CmdArgs.Explicit.Type+import System.Console.CmdArgs.Explicit.Process+import System.Console.CmdArgs.Explicit.Help+import System.Console.CmdArgs.Default+import System.Console.CmdArgs.Text+import System.Console.CmdArgs.Verbosity++import Data.Char+++-- | Create a help flag triggered by @-?@/@--help@.+flagHelpSimple :: (a -> a) -> Flag a+flagHelpSimple f = flagNone ["help","?"] f "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 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)+                    _ | all isDigit x -> Right (a,Wrap $ read x)+                    _ -> Left "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 f = flagNone ["version","V"] f "Print version information"+++-- | Create verbosity flags triggered by @-v@/@--verbose@ and+--   @-q@/@--quiet@+flagsVerbosity :: (Verbosity -> a -> a) -> [Flag a]+flagsVerbosity f =+    [flagNone ["verbose","v"] (f Loud) "Loud verbosity"+    ,flagNone ["quiet","q"] (f Quiet) "Quiet verbosity"]

@@ -0,0 +1,93 @@++module System.Console.CmdArgs.Explicit.Help(HelpFormat(..), helpText) where++import System.Console.CmdArgs.Explicit.Type+import System.Console.CmdArgs.Text+import System.Console.CmdArgs.Default+import Data.List+import Data.Maybe+++-- | Specify the format to output the help.+data HelpFormat+    = HelpFormatDefault -- ^ Equivalent to 'HelpFormatAll' if there is not too much text, otherwise 'HelpFormatOne'.+    | HelpFormatOne -- ^ Display only the first mode.+    | HelpFormatAll -- ^ Display all modes.+      deriving (Read,Show,Enum,Bounded,Eq,Ord)++instance Default HelpFormat where def = HelpFormatDefault+++instance Show (Mode a) where+    show = show . helpTextDefault+++-- | Generate a help message from a mode.+helpText :: HelpFormat -> Mode a -> [Text]+helpText HelpFormatDefault = helpTextDefault+helpText HelpFormatOne = helpTextOne+helpText HelpFormatAll = helpTextAll+++helpTextDefault x = if length all > 40 then one else all+    where all = helpTextAll x+          one = helpTextOne x+++-- | Help text for all modes+--+-- > <program> [OPTIONS] <file_args>+-- > <options>+-- > <program> MODE [SUBMODE] [OPTIONS] [FLAG]+helpTextAll :: Mode a -> [Text]+helpTextAll = disp . push ""+    where+        disp m = uncurry (++) (helpTextMode m) ++ concatMap (\x -> Line "" : disp x) (modeModes m)+        push s m = m{modeNames = map (s++) $ modeNames m+                    ,modeGroupModes = fmap (push s2) $ modeGroupModes m}+            where s2 = s ++ concat (take 1 $ modeNames m) ++ " "+++-- | Help text for only this mode+--+-- > <program> [OPTIONS] <file_args>+-- > <options>+-- > <program> MODE [FLAGS]+-- > <options>+helpTextOne :: Mode a -> [Text]+helpTextOne m = pre ++ ms ++ suf+    where +        (pre,suf) = helpTextMode m+        ms = space $ [Line " Modes" | not $ null $ groupUnnamed $ modeGroupModes m] ++ helpGroup f (modeGroupModes m)+        f m = return $ cols [concat $ take 1 $ modeNames m, modeHelp m]+++helpTextMode :: Mode a -> ([Text], [Text])+helpTextMode x = (pre,suf)+    where+        pre = [Line $ unwords $ take 1 (modeNames x) ++ ["[OPTIONS]" | not $ null $ modeFlags x] +++                  map argType (maybeToList $ modeArgs x)] +++              [Line $ " " ++ modeHelp x | not $ null $ modeHelp x] +++              space (helpGroup helpFlag $ modeGroupFlags x)+        suf = space (map (\x -> Line $ " " ++ x) $ modeHelpSuffix x)+++helpGroup :: (a -> [Text]) -> Group a -> [Text]+helpGroup f xs = concatMap f (groupUnnamed xs) ++ concatMap g (groupNamed xs)+    where g (a,b) = Line (' ':a) : concatMap f b+++helpFlag :: Flag a -> [Text]+helpFlag x = [cols [unwords $ map ("-"++) a2, unwords $ map ("--"++) b2, ' ' : flagHelp x]]+        where+            (a,b) = partition ((==) 1 . length) $ flagNames x+            (a2,b2) = if null b then (add a opt, b) else (a, add b opt)+            add x y = if null x then x else (head x ++ y) : tail x+            hlp = if null (flagType x) then "ITEM" else flagType x+            opt = case flagInfo x of+                FlagReq -> '=' : hlp+                FlagOpt x -> "[=" ++ hlp ++ "]"+                _ -> ""++cols (x:xs) = Cols $ ("  "++x) : map (' ':) xs+space xs = [Line "" | not $ null xs] ++ xs

@@ -0,0 +1,150 @@++module System.Console.CmdArgs.Explicit.Process(process, processValue, processArgs) where++import System.Console.CmdArgs.Explicit.Type+import Control.Arrow+import Data.List+import Data.Maybe+import System.Environment+import System.Exit+++-- | Process the flags obtained by @getArgs@ 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'.+processArgs :: Mode a -> IO a+processArgs m = do+    xs <- getArgs+    case process m xs of+        Left x -> do putStrLn x; exitFailure+        Right x -> return x+++-- | Process a list of flags (usually obtained from @getArgs@) with a mode. Displays+--   an error and exits with failure if the command line fails to parse, or returns+--   the associated value. Implemeneted in terms of 'process'.+processValue :: Mode a -> [String] -> a+processValue m xs = case process m xs of+    Left x -> error x+    Right x -> x+++-- | Process a list of flags (usually obtained from @getArgs@) with a mode. Returns+--   @Left@ and an error message if the command line fails to parse, or @Right@ and+--   the associated value.+process :: Mode a -> [String] -> Either String a+process = processMode+++processMode :: Mode a -> [String] -> Either String a+processMode m args =+    case find of+        Ambiguous xs -> Left $ ambiguous "mode" a xs+        Found x -> processMode x as+        NotFound+            | isNothing (modeArgs m) && args /= [] &&+              not (null $ modeModes m) && not ("-" `isPrefixOf` concat args)+                -> Left $ missing "mode" $ concatMap modeNames $ modeModes m+            | otherwise -> either Left (modeCheck m) $ processFlags m (modeValue m) args+    where+        (find,a,as) = case args of+            [] -> (NotFound,"",[])+            x:xs -> (lookupName (map (modeNames &&& id) $ modeModes m) x, x, xs)+++data S a = S+    {val :: a+    ,args :: [String]+    ,errs :: [String]+    }++err :: S a -> String -> S a+err s x = s{errs=x:errs s}++upd :: S a -> (a -> Either String a) -> S a+upd s f = case f $ val s of+    Left x -> err s x+    Right x -> s{val=x}+++processFlags :: Mode a -> a -> [String] -> Either String a+processFlags mode val_ args_ = f $ S val_ args_ []+    where+        f s | not $ null $ errs s = Left $ last $ errs s+            | null $ args s = Right $ val s+            | otherwise = f (processFlag mode s)+++pickFlags long mode = [(filter (\x -> (length x > 1) == long) $ flagNames flag,(flagInfo flag,flag)) | flag <- modeFlags mode]+++processFlag :: Mode a -> S a -> S a+processFlag mode s_@S{args=('-':'-':xs):ys} | xs /= "" =+    case lookupName (pickFlags True mode) a of+        Ambiguous poss -> err s $ ambiguous "flag" ("--" ++ a) poss+        NotFound -> err s $ "Unknown flag: --" ++ a+        Found (arg,flag) -> case arg of+            FlagNone | null b -> upd s $ flagValue flag ""+                     | otherwise -> err s $ "Unhandled argument to flag, none expected: --" ++ xs+            FlagReq | null b && null ys -> err s $ "Flag requires argument: --" ++ xs+                    | null b -> upd s{args=tail ys} $ flagValue flag $ head ys+                    | otherwise -> upd s $ flagValue flag $ tail b+            _ | null b -> upd s $ flagValue flag $ fromFlagOpt arg+              | otherwise -> upd s $ flagValue flag $ tail b+    where+        s = s_{args=ys}+        (a,b) = break (== '=') xs+++processFlag mode s_@S{args=('-':x:xs):ys} | x /= '-' =+    case lookupName (pickFlags False mode) [x] of+        Ambiguous poss -> err s $ ambiguous "flag" ['-',x] poss+        NotFound -> err s $ "Unknown flag: -" ++ [x]+        Found (arg,flag) -> case arg of+            FlagNone | "=" `isPrefixOf` xs -> err s $ "Unhandled argument to flag, none expected: -" ++ [x]+                     | otherwise -> upd s_{args=['-':xs|xs/=""] ++ ys} $ flagValue flag ""+            FlagReq | null xs && null ys -> err s $ "Flag requires argument: -" ++ [x]+                    | null xs -> upd s_{args=tail ys} $ flagValue flag $ head ys+                    | otherwise -> upd s_{args=ys} $ flagValue flag $ if "=" `isPrefixOf` xs then tail xs else xs+            FlagOpt x | null xs -> upd s_{args=ys} $ flagValue flag x+                      | otherwise -> upd s_{args=ys} $ flagValue flag $ if "=" `isPrefixOf` xs then tail xs else xs+            FlagOptRare x | "=" `isPrefixOf` xs -> upd s_{args=ys} $ flagValue flag $ tail xs+                          | otherwise -> upd s_{args=['-':xs|xs/=""] ++ ys} $ flagValue flag x+    where+        s = s_{args=ys}+++processFlag mode s_ =+    case modeArgs mode of+        Nothing -> err s $ "Unhandled argument, none expected: " ++ x+        Just arg -> case argValue arg x (val s) of+            Left e -> err s $ "Unhandled argument, " ++ e ++ ": " ++ x+            Right v -> s{val=v}+    where+        x:ys = if head (args s_) == "--" then tail (args s_) else args s_+        s = s_{args=ys}+++---------------------------------------------------------------------+-- UTILITIES++ambiguous typ got xs = "Ambiguous " ++ typ ++ " '" ++ got ++ "', could be any of: " ++ unwords xs+missing typ xs = "Missing " ++ typ ++ ", wanted any of: " ++ unwords xs+++data LookupName a = NotFound+                  | Ambiguous [Name]+                  | Found a++-- different order to lookup so can potentially partially-apply it+lookupName :: [([Name],a)] -> Name -> LookupName a+lookupName names value =+    case (match (==), match isPrefixOf) of+        ([],[]) -> NotFound+        ([],[x]) -> Found $ snd x+        ([],xs) -> Ambiguous $ map fst xs+        ([x],_) -> Found $ snd x+        (xs,_) -> Ambiguous $ map fst xs+    where+        match op = [(head ys,v) | (xs,v) <- names, let ys = filter (op value) xs, ys /= []]+    

@@ -0,0 +1,221 @@++module System.Console.CmdArgs.Explicit.Type where++import Control.Arrow+import Control.Monad+import Data.Char+import Data.List+import Data.Maybe+import Data.Monoid+++-- | A name, either the name of a flag (@--/foo/@) or the name of a mode.+type Name = String++-- | A help message that goes with either a flag or a mode.+type Help = String++-- | The type of a flag, i.e. @--foo=/TYPE/@.+type FlagHelp = String+++---------------------------------------------------------------------+-- UTILITY++-- | Parse a boolean, accepts as True: true yes on enabled 1. +parseBool :: String -> Maybe Bool+parseBool s | ls `elem` true  = Just True+            | ls `elem` false = Just False+            | otherwise = Nothing+    where+        ls = map toLower s+        true = ["true","yes","on","enabled","1"]+        false = ["false","no","off","disabled","0"]+++---------------------------------------------------------------------+-- GROUPS++-- | A group of items (modes or flags). The items are treated as a list, but the+--   group structure is used when displaying the help message.+data Group a = Group+    {groupUnnamed :: [a] -- ^ Normal items.+    ,groupHiden :: [a] -- ^ Items that are hidden (not displayed in the help message).+    ,groupNamed :: [(Help, [a])] -- ^ Items that have been grouped, along with a description of each group.+    } deriving Show ++instance Functor Group where+    fmap f (Group a b c) = Group (map f a) (map f b) (map (second $ map f) c)++instance Monoid (Group a) where+    mempty = Group [] [] []+    mappend (Group x1 x2 x3) (Group y1 y2 y3) = Group (x1++y1) (x2++y2) (x3++y3)++-- | Convert a group into a list.+fromGroup :: Group a -> [a]+fromGroup (Group x y z) = x ++ y ++ concatMap snd z++-- | Convert a list into a group, placing all fields in 'groupUnnamed'.+toGroup :: [a] -> Group a+toGroup x = Group x [] []+++---------------------------------------------------------------------+-- TYPES++-- | A mode. Each mode has three main features:+--+--   * A list of submodes ('modeGroupModes')+--+--   * A list of flags ('modeGroupFlags')+--+--   * Optionally an unnamed argument ('modeArgs')+data Mode a = Mode+    {modeGroupModes :: Group (Mode a) -- ^ The available sub-modes+    ,modeNames :: [Name] -- ^ The names assigned to this mode+    ,modeValue :: a -- ^ Value to start with+    ,modeCheck :: a -> Either String a -- checking a value is correct+    ,modeHelp :: Help -- ^ Help text+    ,modeHelpSuffix :: [String] -- ^ A longer help suffix displayed after a mode+    ,modeArgs :: Maybe (Arg a) -- ^ An unnamed argument+    ,modeGroupFlags :: Group (Flag a) -- ^ Groups of flags+    }++-- | Extract the modes from a 'Mode'+modeModes :: Mode a -> [Mode a]+modeModes = fromGroup . modeGroupModes++-- | Extract the flags from a 'Mode'+modeFlags :: Mode a -> [Flag a]+modeFlags = fromGroup . modeGroupFlags++-- | The 'FlagInfo' type has the following meaning:+--+--+-- >              FlagReq     FlagOpt      FlagOptRare/FlagNone+-- > -xfoo        -x=foo      -x=foo       -x= -foo+-- > -x foo       -x=foo      -x foo       -x= foo+-- > -x=foo       -x=foo      -x=foo       -x=foo+-- > --xx foo     --xx=foo    --xx foo     --xx foo+-- > --xx=foo     --xx=foo    --xx=foo     --xx=foo+data FlagInfo+    = FlagReq             -- ^ Required argument+    | FlagOpt String      -- ^ Optional argument+    | FlagOptRare String  -- ^ Optional argument that requires an = before the value+    | FlagNone            -- ^ No argument+      deriving (Eq,Ord)++-- | Extract the value from inside a 'FlagOpt' or 'FlagOptRare', or raises an error.+fromFlagOpt :: FlagInfo -> String+fromFlagOpt (FlagOpt x) = x+fromFlagOpt (FlagOptRare x) = x++-- | A function to take a string, and a value, and either produce an error message+--   (@Left@), or a modified value (@Right@).+type Update a = String -> a -> Either String a++-- | A flag, consisting of a list of flag names and other information.+data Flag a = Flag+    {flagNames :: [Name] -- ^ The names for the flag.+    ,flagInfo :: FlagInfo -- ^ Information about a flag's arguments.+    ,flagValue :: Update a -- ^ The way of processing a flag.+    ,flagType :: FlagHelp -- ^ The type of data for the flag argument, i.e. FILE\/DIR\/EXT+    ,flagHelp :: Help -- ^ The help message associated with this flag.+    }++-- | An unnamed argument.+data Arg a = Arg+    {argValue :: Update a -- ^ A way of processing the argument.+    ,argType :: FlagHelp -- ^ The type of data for the argument, i.e. FILE\/DIR\/EXT+    }++---------------------------------------------------------------------+-- CHECK FLAGS++-- | Check that a mode is well formed.+checkMode :: Mode a -> Maybe String+checkMode x =+    (checkNames "modes" $ concatMap modeNames $ modeModes x) `mplus`+    msum (map checkMode $ modeModes x) `mplus`+    (checkGroup $ modeGroupModes x) `mplus`+    (checkGroup $ modeGroupFlags x) `mplus`+    (checkNames "flag names" $ concatMap flagNames $ modeFlags x)+    where+        checkGroup :: Group a -> Maybe String+        checkGroup x =+            (check "Empty group name" $ all (not . null . fst) $ groupNamed x) `mplus`+            (check "Empty group contents" $ all (not . null . snd) $ groupNamed x)++        checkNames :: String -> [Name] -> Maybe String+        checkNames msg xs = check "Empty names" (all (not . null) xs) `mplus` do+            bad <- listToMaybe $ xs \\ nub xs+            let dupe = filter (== bad) xs+            return $ "Sanity check failed, multiple " ++ msg ++ ": " ++ unwords (map show dupe)++        check :: String -> Bool -> Maybe String+        check msg True = Nothing+        check msg False = Just msg+++---------------------------------------------------------------------+-- REMAP++-- | Change the underlying type of a 'Mode' structure.+remap :: (a -> b) -- ^ Embed the mode+      -> (b -> (a, a -> b)) -- ^ Extract the mode and give a way of re-embedding+      -> Mode a -> Mode b+remap f g x = x+    {modeGroupModes = fmap (remap f g) $ modeGroupModes x+    ,modeValue = f $ modeValue x+    ,modeCheck = \v -> let (a,b) = g v in fmap b $ modeCheck x a+    ,modeArgs = fmap remapArg $ modeArgs x+    ,modeGroupFlags = fmap remapFlag $ modeGroupFlags x}+    where+        remapUpdate upd = \s v -> let (a,b) = g v in fmap b $ upd s a+        remapFlag x = x{flagValue = remapUpdate $ flagValue x}+        remapArg x = x{argValue = remapUpdate $ argValue x}+++---------------------------------------------------------------------+-- MODE/MODES CREATORS++-- | Create a mode with a name, an initial value, some help text, a way of processing arguments+--   and a list of flags.+mode :: Name -> a -> Help -> Arg a -> [Flag a] -> Mode a+mode name value help arg flags = Mode (toGroup []) [name] value Right help [] (Just arg) $ toGroup flags++-- | Create a list of modes, with a program name, an initial value, some help text and the child modes.+modes :: String -> a -> Help -> [Mode a] -> Mode a+modes name value help xs = Mode (toGroup xs) [name] value Right help [] Nothing $ toGroup []+++---------------------------------------------------------------------+-- FLAG CREATORS++-- | Create a flag taking no argument value, with a list of flag names, an update function+--   and some help text.+flagNone :: [Name] -> (a -> a) -> Help -> Flag a+flagNone names f help = Flag names FlagNone upd "" help+    where upd _ x = Right $ f x++-- | Create a flag taking an optional argument value, with an optional value, a list of flag names,+--   an update function, the type of the argument and some help text.+flagOpt :: String -> [Name] -> Update a -> FlagHelp -> Help -> Flag a+flagOpt def names upd typ help = Flag names (FlagOpt def) upd typ help++-- | Create a flag taking a required argument value, with a list of flag names,+--   an update function, the type of the argument and some help text.+flagReq :: [Name] -> Update a -> FlagHelp -> Help -> Flag a+flagReq names upd typ help = Flag names FlagReq upd typ help++-- | Create an argument flag, with an update function and the type of the argument.+flagArg :: Update a -> FlagHelp -> Arg a+flagArg upd typ = Arg upd typ++-- | Create a boolean flag, with a list of flag names, an update function and some help text.+flagBool :: [Name] -> (Bool -> a -> a) -> Help -> Flag a+flagBool names f help = Flag names (FlagOptRare "") upd "" help+    where+        upd s x = case if s == "" then Just True else parseBool s of+            Just b -> Right $ f b x+            Nothing -> Left "expected boolean value (true/false)"

@@ -1,127 +0,0 @@-{-# LANGUAGE PatternGuards #-}--module System.Console.CmdArgs.Flag where--import Data.Dynamic-import Data.List-import Data.Maybe-import Data.Char-import Control.Monad-import Data.Function--import System.Console.CmdArgs.Type---data Action = Update String (Dynamic -> Dynamic)-            | Error String--instance Show Action where-    show (Update x y) = "Update " ++ show x ++ " <function>"-    show (Error x) = "Error " ++ show x--getAction :: [Action] -> String -> Maybe Action-getAction as x = listToMaybe [a | a@(Update s _) <- as, s == x]--hasAction :: [Action] -> String -> Bool-hasAction as = isJust . getAction as--------------------------------------------------------------------------- HELP INFORMATION FOR A FLAG--helpFlag :: Flag -> [(String,String,String)]-helpFlag xs =-    [(unwords (map ("-"++) short)-     ,unwords (map ("--"++) long) ++ val-     ,flagText xs ++ maybe "" (\x -> " (default=" ++ x ++ ")") (defaultFlag xs))-    | isFlagFlag xs]-    where-        (short,long) = partition ((==) 1 . length) $ flagFlag xs-        val = if isFlagBool xs then ""-              else ['['|opt] ++ "=" ++ flagTypDef "VALUE" xs ++ [']'|opt]-        opt = isFlagOpt xs----- Given a flag, see what argument positions it should have--- with the Int being a sort order-helpFlagArgs :: Flag -> [(Int,String)]-helpFlagArgs xs = case (flagArgs xs, flagTypDef "FILE" xs) of-    (Just Nothing,x) -> [(maxBound :: Int,"[" ++ x ++ "]")]-    (Just (Just i),x) -> [(i,x)]-    _ -> []---defaultFlag :: Flag -> Maybe String-defaultFlag x = if res `elem` [Just "",Just "0"] then Nothing else res-    where-        res = flagOpt x `mplus` val-        val = case flagVal x of-                x | Just v <- fromDynamic x -> Just (v :: String)-                  | Just v <- fromDynamic x -> Just $ show (v :: Int)-                  | Just v <- fromDynamic x -> Just $ show (v :: Integer)-                  | Just v <- fromDynamic x -> Just $ show (v :: Float)-                  | Just v <- fromDynamic x -> Just $ show (v :: Double)-                _ -> Nothing--------------------------------------------------------------------------- PROCESS A FLAG--parseFlags :: [Flag] -> [String] -> [Action]-parseFlags flags = f 0-    where-        f seen [] = case reverse $ sort [i | Flag{flagArgs=Just (Just i),flagOpt=Nothing} <- flags, i >= seen] of-            [] -> []-            x:_ -> [Error $ "Not enough non-flag arguments, expected " ++ show (x+1) ++ ", but got " ++ show seen]--        f seen (x:xs) = act : f (seen + if "-" `isPrefixOf` x then 0 else 1) ys-            where (act,ys) = case sortBy (compare `on` fst) $ mapMaybe (\flag -> parseFlag flag seen (x:xs)) flags of-                    [] -> (Error $ "Unknown flag: " ++ x, xs)-                    r1:r2:_ | fst r1 == fst r2 -> (Error $ "Ambiguous flag: " ++ x, xs)-                    r:_ -> snd r---data Priority = PriExactFlag | PriPrefixFlag | PriFilePos | PriFile | PriUnknown-                deriving (Eq,Ord,Show)---parseFlag :: Flag -> Int -> [String] -> Maybe (Priority, (Action, [String]))--parseFlag flag seen (x:xs) | flagUnknown flag = Just (PriUnknown, (Update (flagName flag) (addMany x), xs))--parseFlag flag seen (('-':x:xs):ys) | xs /= "" && x `elem` expand = parseFlag flag seen (['-',x]:('-':xs):ys)-    where expand = [x | isFlagBool flag, [x] <- flagFlag flag]--parseFlag flag seen (('-':x:xs):ys) | x /= '-' = parseFlag flag seen (x2:ys)-    where x2 = '-':'-':x:['='| xs /= [] && head xs /= '=']++xs--parseFlag flag seen (('-':'-':x):xs)-    | not $ any (a `isPrefixOf`) (flagFlag flag) = Nothing-    | otherwise = Just $ (,) (if a `elem` flagFlag flag then PriExactFlag else PriPrefixFlag) $-    case flagType flag of-        FlagBool r ->-            if b /= "" then err "does not take an argument" xs-                       else upd (const r) xs-        FlagItem r ->-            if not (isFlagOpt flag) && null b && (null xs || "-" `isPrefixOf` head xs)-            then err "needs an argument" xs-            else let (text,rest) = case flagOpt flag of-                        Just v | null b -> (v, xs)-                        _ | null b -> (head xs, tail xs)-                        _ -> (drop 1 b, xs)-                 in case r text of-                        Nothing -> err "couldn't parse argument" rest-                        Just v -> upd v rest-    where-        (a,b) = break (== '=') x-        err msg rest = (Error $ "Error on flag " ++ show x ++ ", flag " ++ msg, rest)-        upd v rest = (Update (flagName flag) v, rest)--parseFlag flag seen (x:xs) = case flagArgs flag of-    Just Nothing -> upd (addMany x) PriFile-    Just (Just i) | i == seen -> upd (addOne x) PriFilePos-    _ -> Nothing-    where upd op p = Just (p, (Update (flagName flag) op, xs))--addMany x v = toDyn $ fromDyn v [""] ++ [x]-addOne x v = toDyn x

@@ -0,0 +1,93 @@++-- | This provides a compatiblity wrapper to the @System.Console.GetOpt@ module in @base@.+--   That module is essentially a Haskell port of the GNU @getopt@ library.+--+--   /Changes:/ The changes from @GetOpt@ are listed in the documentation for each function.+module System.Console.CmdArgs.GetOpt(+    convert, getOpt, getOpt', usageInfo,+    ArgOrder(..), OptDescr(..), ArgDescr(..)+    ) where++import System.Console.CmdArgs.Explicit+++-- | What to do with options following non-options.+--+--   /Changes:/ Only 'Permute' is allowed, both @RequireOrder@ and @ReturnInOrder@+--   have been removed.+data ArgOrder a = Permute+++-- | Each 'OptDescr' describes a single option/flag.+--+--   The arguments to 'Option' are:+--+--   * list of short option characters+--+--   * list of long option strings (without "--", may not be 1 character long)+--+--   * argument descriptor+--+--   * explanation of option for userdata+data OptDescr a = Option+    [Char]+    [String]+    (ArgDescr a)+    String+++-- | Describes whether an option takes an argument or not, and if so+--   how the argument is injected into a value of type @a@.+data ArgDescr a+   = NoArg                   a         -- ^ no argument expected+   | ReqArg (String       -> a) String -- ^ option requires argument+   | OptArg (Maybe String -> a) String -- ^ optional argument+++-- | Return a string describing the usage of a command, derived from+--   the header (first argument) and the options described by the +--   second argument.+usageInfo :: String -> [OptDescr a] -> String+usageInfo desc flags = show $ convert desc flags+++-- | Process the command-line, and return the list of values that matched+--   (and those that didn\'t). The arguments are:+--+--   * The order requirements (see 'ArgOrder')+--+--   * The option descriptions (see 'OptDescr')+--+--   * The actual command line arguments (presumably got from +--     'System.Environment.getArgs').+--+--   'getOpt' returns a triple consisting of the option arguments, a list+--   of non-options, and a list of error messages.+--+--   /Changes:/ The list of errors will contain at most one entry, and if an+--   error is present then the other two lists will be empty.+getOpt  :: ArgOrder  a -> [OptDescr  a] -> [String] -> ([a], [String], [String])+getOpt _ flags args =+    case process (convert "" flags) args of+        Left x -> ([],[],[x])+        Right (a,b) -> (a,b,[])+++-- | /Changes:/ This is exactly the same as 'getOpt', but the 3rd element of the+--   tuple (second last) will be an empty list.+getOpt' :: ArgOrder a -> [OptDescr a] -> [String] -> ([a], [String], [String], [String])+getOpt' x y z = (a,b,[],c)+    where (a,b,c) = getOpt x y z+++-- | Given a help text and a list of option descriptions, generate a 'Mode'.+convert :: String -> [OptDescr a] -> Mode ([a],[String])+convert help flags = mode "program" ([],[]) help args (map f flags)+    where+        args = flagArg (\x (a,b) -> Right (a,b++[x])) "ARG"++        f (Option short long x help) = case x of+            NoArg x -> flagNone names (\(a,b) -> (a++[x],b)) help+            ReqArg op x -> flagReq names (\x (a,b) -> Right (a++[op x],b)) x help+            OptArg op x -> flagOpt "" names (\x (a,b) -> Right (a++[op $ if null x then Nothing else Just x],b)) x help+            where names = map return short ++ long

@@ -1,50 +0,0 @@--module System.Console.CmdArgs.Help(Help(..), showHelp) where--import Data.Char---data Help = Norm String-          | Trip (String,String,String)---showHelp :: [Help] -> String -> String-showHelp help format = case map toLower format of-    "html" -> showHTML help-    x | x `elem` ["text",""] -> showText help-    _ -> "Unknown help mode " ++ show format ++ ", expected one of: text html\n\n" ++-         showText help---showText :: [Help] -> String-showText xs = unlines $ map f xs-    where-        f (Norm x) = x-        f (Trip (a,b,c)) = "  " ++ pad an a ++ pad bn b ++ " " ++ c--        (as,bs,_) = unzip3 [x | Trip x <- xs]-        an = maximum $ map length as-        bn = maximum $ map length bs-        pad n x = x ++ replicate (n - length x + 1) ' '---showHTML :: [Help] -> String-showHTML xs = unlines $-    ["<table class='cmdargs'>"] ++-    map f xs ++-    ["</table>"]-    where-        f (Norm x) = "<tr><td colspan='3'" ++ (if null a then "" else " class='indent'") ++ ">" ++-                     (if null b then "&nbsp;" else escape b) ++ "</td></tr>"-            where (a,b) = span isSpace x-        f (Trip (a,b,c)) = "<tr><td class='indent'>" ++ escape a ++ "</td>" ++-                           "<td>" ++ escape b ++ "</td>" ++-                           "<td>" ++ escape c ++ "</td></tr>"---escape :: String -> String-escape = concatMap f-    where f '&' = "&amp;"-          f '>' = "&gt;"-          f '<' = "&lt;"-          f x = [x]

@@ -0,0 +1,147 @@+{-# LANGUAGE RecordWildCards, PatternGuards #-}+{-|+    This module provides simple command line argument processing.+    The main function of interest is 'cmdArgs'.+    A simple example is:++    @data Sample = Sample {hello :: String} deriving (Show, Data, Typeable)@++    @sample = Sample{hello = 'def' '&=' 'help' \"World argument\" '&=' 'opt' \"world\"}@+    @         '&=' summary \"Sample v1\"@++    @main = print =<< 'cmdArgs' sample@+++    Attributes are used to control a number of behaviours:+    +    * The help message: 'help', 'typ', 'details', 'summary', 'program', 'groupname'+    +    * Flag behaviour: 'opt', 'enum', 'verbosity'+    +    * Flag name assignment: 'name', 'explicit'+    +    * Controlling non-flag arguments: 'args', 'argPos'++    * multi-mode programs: 'modes', 'auto'++    [Supported Types] Each field in the record must be one of the supported+    atomic types (@String@, @Int@, @Integer@, @Float@, @Double@, @Bool@) or+    a list (@[]@) or @Maybe@ wrapping at atomic type.++    [Missing Fields] If a field is shared by multiple modes, it may be omitted+    in subsequent modes, and will default to the previous value.++    /Warning:/ Values created with annotations are not pure - the first+    time they are used they will include the annotations, but subsequently+    they will not. To capture the annotations, so they can be used multiple times,+    use 'cmdArgsMode'.+-}++module System.Console.CmdArgs.Implicit(+    -- * Running command lines+    cmdArgs, cmdArgsMode, cmdArgsRun, cmdArgsApply, CmdArgs(..),+    -- * Constructing command lines+    -- | Attributes can work on a flag (inside a field), on a mode (outside the record),+    --   or on all modes (outside the 'modes' call).+    (&=), modes, enum,+    module System.Console.CmdArgs.Implicit.UI,+    -- * Re-exported for convenience+    -- | Provides a few opaque types (for writing type signatures),+    --   verbosity control, default values with 'def' and the+    --   @Data@/@Typeable@ type classes.+    module System.Console.CmdArgs.Verbosity,+    module System.Console.CmdArgs.Default,+    Ann, Mode,+    Data, Typeable+    ) where++import Data.Data+import Data.Generics.Any+import System.Exit+import System.Console.CmdArgs.Explicit(Mode,processArgs,remap)+import System.Console.CmdArgs.Implicit.Ann+import System.Console.CmdArgs.Implicit.Capture+import System.Console.CmdArgs.Implicit.Step1+import System.Console.CmdArgs.Implicit.Step2+import System.Console.CmdArgs.Implicit.Step3+import System.Console.CmdArgs.Implicit.UI+import System.Console.CmdArgs.Verbosity+import System.Console.CmdArgs.Default+++-- | Take annotated records and run the corresponding command line.+--   Shortcut for @'cmdArgsRun' . 'cmdArgsMode'@.+cmdArgs :: Data a => a -> IO a+cmdArgs = cmdArgsRun . cmdArgsMode+++-- | Take annotated records and turn them in to a 'Mode' value, that can+--   make use of the "System.Console.CmdArgs.Explicit" functions (i.e. 'process').+--+--   Annotated records are impure, and will only contain annotations on+--   their first use. The result of this function is pure, and can be reused.+cmdArgsMode :: Data a => a -> Mode (CmdArgs a)+cmdArgsMode = remap embed proj . step3 . step2 . step1 . capture . Any+    where embed = fmap fromAny+          proj x = (fmap Any x, embed)+++-- | Run a Mode structure. This function reads the command line arguments+--   and then performs as follows:+--+--   * If invalid arguments are given, it will display the error message+--     and exit.+--+--   * If @--help@ is given, it will display the help message and exit.+--+--   * If @--version@ is given, it will display the version and exit.+--+--   * In all other circumstances the program will return a value.+--+--   * Additionally, if either @--quiet@ or @--verbose@ is given (see 'verbosity')+--     it will set the verbosity (see 'setVerbosity').+cmdArgsRun :: Mode (CmdArgs a) -> IO a+cmdArgsRun m = cmdArgsApply =<< processArgs m+++-- | Perform the necessary actions dictated by a 'CmdArgs' structure.+--+--   * If 'cmdArgsHelp' is @Just@, it will display the help message and exit.+--+--   * If 'cmdArgsVersion' is @Just@, it will display the version and exit.+--+--   * In all other circumstances it will return a value.+--+--   * Additionally, if 'cmdArgsVerbosity' is @Just@ (see 'verbosity')+--     it will set the verbosity (see 'setVerbosity').+cmdArgsApply :: CmdArgs a -> IO a+cmdArgsApply CmdArgs{..}+    | Just x <- cmdArgsHelp = do putStrLn x; exitSuccess+    | Just x <- cmdArgsVersion = do putStrLn x; exitSuccess+    | otherwise = do+        maybe (return ()) setVerbosity cmdArgsVerbosity+        return cmdArgsValue+++-- | Modes: \"I want a program with multiple modes, like darcs or cabal.\"+--+--   Takes a list of modes, and creates a mode which includes them all.+--   If you want one of the modes to be chosen by default, see 'auto'.+--+-- > data Modes = Mode1 | Mode2 | Mode3 deriving Data+-- > cmdArgs $ modes [Mode1,Mode2,Mode3]+modes :: Data a => [a] -> a+modes = many++-- | Flag: \"I want several different flags to set this one field to different values.\"+--+--   This annotation takes a type which is an enumeration, and provides multiple+--   separate flags to set the field to each value.+--+-- > data State = On | Off deriving Data+-- > data Mode = Mode {state :: State}+-- > cmdArgs $ Mode {state = enum [On &= help "Turn on",Off &= help "Turn off"]}+-- >   --on   Turn on+-- >   --off  Turn off+enum :: Data a => [a] -> a+enum = many

@@ -0,0 +1,25 @@+{-# LANGUAGE PatternGuards #-}++module System.Console.CmdArgs.Implicit.Ann where++-- | The general type of annotations that can be associated with a value.+data Ann+    = Help String+    | Name String+    | Explicit+    | GroupName String++    | FlagOptional String+    | FlagArgs+    | FlagArgPos Int+    | FlagType String+    | FlagEnum -- private, specified by 'one'+    | FlagInherit -- private, specified by omitting it (which throws RecConError)++    | ModeDefault+    | ModeHelpSuffix [String]++    | ProgSummary String+    | ProgProgram String+    | ProgVerbosity+      deriving (Eq,Ord,Show)

@@ -0,0 +1,80 @@+{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}++-- | This module does all the tricky/unsafe bits of CmdArgs.+--   It captures annotations on the data structure in the most direct way+--   possible.+module System.Console.CmdArgs.Implicit.Capture(+    Capture(..), capture, many, (&=)+    ) where++import Data.Data(Data)+import Data.IORef+import System.IO.Unsafe+import Control.Exception+import System.Console.CmdArgs.Implicit.Ann+import Data.Generics.Any+++-- test = show $ capture $ many [Just ((66::Int) &= P 1 &= P 2), Nothing &= P 8] &= P 3+++infixl 2 &=++data Capture+    = Many [Capture]+    | Ann Ann Capture+    | Value Any+    | Missing Any -- a RecConError+    | Ctor Any [Capture]+      deriving Show+      +{-+The idea is to keep a stack of either continuations, or values+If you encounter 'many' you become a value+If you encounter '&=' you increase the continuation+-}++{-# NOINLINE ref #-}+ref :: IORef [Either (Capture -> Capture) Capture]+ref = unsafePerformIO $ newIORef []++push = modifyIORef ref (Left id :)+pop = do x:xs <- readIORef ref; writeIORef ref xs; return x+modify f = modifyIORef ref $ \x -> case x of Left g : rest -> f g : rest ; _ -> error "Internal error in Capture"+add f = modify $ \x -> Left $ x . f+set x = modify $ \f -> Right $ f x+++-- | Collapse multiple values in to one.+many :: Data a => [a] -> a+many xs = unsafePerformIO $ do+    ys <- mapM (force . Any) xs+    set $ Many ys+    return $ head xs+++-- | Add an annotation to a value. Note that if the value is evaluated+--   more than once the annotation will only be available the first time.+(&=) :: Data a => a -> Ann -> a+(&=) x y = unsafePerformIO $ do+    add (Ann y)+    evaluate x+    return x+++capture :: Any -> Capture+capture x = unsafePerformIO $ force x+++force :: Any -> IO Capture+force x@(Any xx) = do+    push+    res <- try $ evaluate xx+    y <- pop+    case y of+        _ | Left (_ :: RecConError) <- res -> return $ Missing x+        Right r -> return r+        Left f | not $ isAlgType x -> return $ f $ Value x+               | otherwise -> do+            cs <- mapM force $ children x+            return $ f $ Ctor x cs

@@ -0,0 +1,137 @@++module System.Console.CmdArgs.Implicit.Read(isReadBool, toReadContainer, reader, addContainer, readHelp) where++import Data.Generics.Any+import qualified Data.Generics.Any.Prelude as A+import System.Console.CmdArgs.Explicit+import Data.Char+import Data.Either+import Data.List+++data ReadContainer+    = ReadList ReadAtom+    | ReadMaybe ReadAtom+    | ReadAtom ReadAtom++data ReadAtom+    = ReadBool+    | ReadInt+    | ReadInteger+    | ReadFloat+    | ReadDouble+    | ReadString+    | ReadEnum [(String,Any)]+    | ReadTuple [ReadAtom]++isReadBool x = case fromReadContainer x of+    ReadBool{} -> True+    _ -> False++fromReadContainer :: ReadContainer -> ReadAtom+fromReadContainer (ReadList x) = x+fromReadContainer (ReadMaybe x) = x+fromReadContainer (ReadAtom x) = x+++toReadContainer :: Any -> Maybe ReadContainer+toReadContainer x = case typeShell x of+        "[]" | typeName x /= "[Char]" -> fmap ReadList $ toReadAtom $ A.fromList x+        "Maybe" -> fmap ReadMaybe $ toReadAtom $ A.fromMaybe x+        _ -> fmap ReadAtom $ toReadAtom x+++toReadAtom :: Any -> Maybe ReadAtom+toReadAtom x = case typeName x of+    "Bool" -> Just ReadBool+    "Int" -> Just ReadInt+    "Integer" -> Just ReadInteger+    "Float" -> Just ReadFloat+    "Double" -> Just ReadDouble+    "[Char]" -> Just ReadString+    _ | A.isTuple x -> fmap ReadTuple $ mapM toReadAtom $ children $ compose0 x $ typeShell x+    _ -> toReadEnum x+++toReadEnum :: Any -> Maybe ReadAtom+toReadEnum x+    | isAlgType x && all ((==) 0 . arity . compose0 x) cs+        = Just $ ReadEnum [(map toLower c, compose0 x c) | c <- cs]+    | otherwise = Nothing+    where cs = ctors x+++-- | Both Any will be the same type as ReadContainer+reader :: ReadContainer -> String -> Any -> Either String Any+reader t s x = fmap (addContainer t x) $ readAtom (fromReadContainer t) s+++-- | If c is the container type, and a is the atom type:+--   Type (c a) -> c a -> a -> c a+addContainer :: ReadContainer -> Any -> Any -> Any+addContainer (ReadAtom _) _ x = x+addContainer (ReadMaybe _) o x = A.just_ o x+addContainer (ReadList _) o x = A.append o $ A.cons x $ A.nil_ o+++-- | The Any will be the type as ReadAtom+readAtom :: ReadAtom -> String -> Either String Any+readAtom ty s = case ty of+    ReadBool -> maybe (Left $ "Could not read as boolean, " ++ show s) (Right . Any) $ parseBool s+    ReadInt -> f (0::Int)+    ReadInteger -> f (0::Integer)+    ReadFloat -> f (0::Float)+    ReadDouble -> f (0::Double)+    ReadString -> Right $ Any s+    ReadEnum xs -> readEnum (map toLower s) xs+    ReadTuple _ -> readTuple ty s+    where+        f t = case reads s of+            [(x,"")] -> Right $ Any $ x `asTypeOf` t+            _ -> Left $ "Could not read as type " ++ show (typeOf $ Any t) ++ ", " ++ show s+++readEnum:: String -> [(String,a)] -> Either String a+readEnum a xs | null ys = Left $ "Could not read, expected one of: " ++ unwords (map fst xs)+              | length ys > 1 = Left $ "Ambiguous read, could be any of: " ++ unwords (map fst ys)+              | otherwise = Right $ snd $ head ys+    where ys = filter (\x -> a `isPrefixOf` fst x) xs+++readTuple :: ReadAtom -> String -> Either String Any+readTuple ty s+    | length ss /= length ts = Left "Incorrect number of comma separated fields for tuple"+    | not $ null left = Left $ head left+    | otherwise = Right $ gen right+    where+        (left,right) = partitionEithers $ zipWith readAtom ts ss+        (ts,gen) = flatten ty+        ss = split s+++split :: String -> [String]+split = lines . map (\x -> if x == ',' then '\n' else x)++flatten :: ReadAtom -> ([ReadAtom], [Any] -> Any)+flatten (ReadTuple xs) = (concat ns, A.tuple . zipWith ($) fs . unconcat ns)+    where (ns,fs) = unzip $ map flatten xs+flatten x = ([x], \[a] -> a)+++unconcat :: [[w]] -> [a] -> [[a]]+unconcat [] [] = []+unconcat (w:ws) xs = x1 : unconcat ws x2+    where (x1,x2) = splitAt (length w) xs+++readHelp :: ReadContainer -> String+readHelp = f . fromReadContainer+    where+        f ReadBool = "BOOL"+        f ReadInt = "INT"+        f ReadInteger = "INT"+        f ReadFloat = "NUM"+        f ReadDouble = "NUM"+        f ReadString = "ITEM"+        f (ReadEnum xs) = map toUpper $ typeShell $ snd $ head xs+        f (ReadTuple xs) = intercalate "," $ map f xs

@@ -0,0 +1,177 @@+{-# LANGUAGE RecordWildCards, ViewPatterns, PatternGuards #-}+{-# OPTIONS_GHC -fno-warn-overlapping-patterns #-}++-- | This module takes the result of Structure, and traslates it to+--   the CmdArgs.Explicit format.+module System.Console.CmdArgs.Implicit.Step1(step1, Prog1(..), Mode1(..), Flag1(..)) where++import System.Console.CmdArgs.Implicit.Ann+import Data.Generics.Any+import System.Console.CmdArgs.Implicit.Capture++import Data.Char+import Data.List+import Data.Maybe+++data Prog1 = Prog1 [Ann] [Mode1] deriving Show+data Mode1 = Mode1 [Ann] Any [Flag1] deriving Show+data Flag1 = Flag1 [Ann] String Any deriving Show+++step1 :: Capture -> Prog1+step1 = expand . groupnames . inherit . flatten+++err x = error $ "CmdArgs.Implicit.Step1: " ++ x+++mapMode :: (Mode1 -> Mode1) -> Prog1 -> Prog1+mapMode f (Prog1 a b) = Prog1 a $ map f b+++---------------------------------------------------------------------+-- EXPAND FLAGS+-- Add FlagName properties where you can++-- For every flag/mode, assign it a name based on the type information, unless it has explicit+-- For every flag, assign it a short name if it doesn't have one and it would be unambiguous, and no explicit+-- Remove all explicit annotations+expand :: Prog1 -> Prog1+expand = mapMode (removeExplicit . assignShort . assignLong)+++removeExplicit (Mode1 a b c) = Mode1 (del a) b $ map f c+    where f (Flag1 a b c) = Flag1 (del a) b c+          del = filter (/= Explicit)+++assignShort (Mode1 a b c) = Mode1 a b [Flag1 ((s \\ dupe) ++ x) y z | (s,Flag1 x y z) <- zip poss c]+    where seen = [x | Flag1 a _ _ <- c, Name [x] <- a]+          dupe = concat poss \\ nub (concat poss)+          poss = map f c+          f (Flag1 a b c) = [Name [x] | Explicit `notElem` a, null [() | Name [_] <- a]+                                       , x <- take 1 [head x | Name x <- a], x `notElem` seen]+++assignLong (Mode1 a b c) = Mode1 (add (ctor b) a) b $ map f c+    where f (Flag1 a b c) = Flag1 (add newname a) b c+               where newname = if FlagEnum `elem` a then ctor c else b+          add s xs = [Name ss | all g xs, Name ss `notElem` xs] ++ xs+               where ss = map (\x -> if x == '_' then '-' else toLower x) $ if last s == '_' then init s else s++          g Explicit = False+          g FlagArgs = False+          g FlagArgPos{} = False+          g _ = True+++---------------------------------------------------------------------+-- GROUP NAMES+-- Make sure every mode/flag has a GroupName annotation++groupnames :: Prog1 -> Prog1+groupnames (Prog1 a b) = Prog1 a $ f onmode "" [Mode1 c d $ f onflag "" e | Mode1 c d e <- b]+    where+        onmode (Mode1 a b c) = (a, \a -> Mode1 a b c)+        onflag (Flag1 a b c) = (a, \a -> Flag1 a b c)++        f on name [] = []+        f on name (x:xs) = case [y | GroupName y <- c] of+            [] -> g (GroupName name:c) : f on name xs+            ys -> x : f on (last ys) xs+            where (c,g) = on x+++---------------------------------------------------------------------+-- INHERIT+-- Deal with FlagInherit++inherit :: Prog1 -> Prog1+inherit (Prog1 a b) = Prog1 a $ f ask0 b+    where+        ask0 s = err $ "Field missing and not specified previously: " ++ show s++        f ask (x:xs) = x2 : f (\s -> fromMaybe (ask s) $ lookup s [(a,b) | b@(Flag1 _ a _) <- cs]) xs+            where x2@(Mode1 _ _ cs) = inheritMode ask x+        f ask [] = []+++inheritMode :: (String -> Flag1) -> Mode1 -> Mode1+inheritMode ask (Mode1 a b c) = Mode1 a (foldr ($) b upd) c2+    where (c2,upd) = unzip $ map (inheritFlag ask) c+++inheritFlag :: (String -> Flag1) -> Flag1 -> (Flag1, Any -> Any)+inheritFlag ask (Flag1 a b c)+    | FlagInherit `notElem` a = (Flag1 a b c, id)+    | Flag1 a2 b2 c2 <- ask b, typeOf c == typeOf c2 = (Flag1 a2 b2 c2, setField (b2,c2))+    | otherwise = err $ "Field missing and previous instance has a different type:" ++ show b+++---------------------------------------------------------------------+-- FLATTEN+-- Separate the data in to Prog/Mode/Flag++flatten :: Capture -> Prog1+flatten = moveAnn . flattenProg+++-- Move annotations from Prog to Mode if appropriate+-- 'Help' can be at the program level for multi-mode programs+moveAnn :: Prog1 -> Prog1+moveAnn (Prog1 as ms) = Prog1 prog [Mode1 (mode++a) b c | Mode1 a b c <- ms]+    where (prog,mode) = partition (\x -> case x of Help{} -> length ms > 1; _ -> isProgAnn x) as++isProgAnn ProgSummary{} = True+isProgAnn ProgProgram{} = True+isProgAnn ProgVerbosity{} = True+isProgAnn _ = False+++flattenProg :: Capture -> Prog1+flattenProg (Ann a b) = let Prog1 x y = flattenProg b in Prog1 (x++[a]) y+flattenProg (Many xs) = Prog1 [] $ map flattenMode xs+flattenProg x@Ctor{} = Prog1 [] [flattenMode x]+flattenProg x = err $ "Unexpected in a program: " ++ show x+++flattenMode :: Capture -> Mode1+flattenMode (Ann a b) = let Mode1 x y z = flattenMode b in Mode1 (x++[a]) y z+flattenMode (Ctor x ys) = Mode1 [] x [Flag1 a n b | (y,n) <- zip ys $ fields x, Flag1 a _ b <- flattenFlag y]+flattenMode x = err $ "Unexpected in a mode: " ++ show x+++flattenFlag :: Capture -> [Flag1]+flattenFlag (Ann a b) = [Flag1 (x++[a]) y z | Flag1 x y z <- flattenFlag b]+flattenFlag (Value x) = [Flag1 [] "" x]+flattenFlag (Missing x) = [Flag1 [FlagInherit] "" x]+flattenFlag x@Ctor{} = [Flag1 [] "" $ flattenValue x]+flattenFlag (Many xs) = concatMap flattenFlag $ map (Ann FlagEnum) xs+flattenFlag x = err $ "Unexpected in a flag: " ++ show x+++flattenValue :: Capture -> Any+flattenValue (Ctor x _) = x+flattenValue (Value x) = x+flattenValue x = err $ "Unexpected in a value: " ++ show x+++{-+*** Exception:++Ann (ProgSummary "HLint v1.6.5, (C) Neil Mitchell 2006-2009")+Ann (ModeHelpSuffix ["To check all Haskell files in 'src' and generate a report type:","  hlint src --report"])+Ann (Text "Suggest improvements to Haskell source code")+Ann (ProgProgram "hlint")++(Ctor HLint+    [Ann (Text "Generate a report in HTML") (Ann (FldTyp "FILE") (Ann (FldEmpty "report.html") (Ctor [] [])))+    ,Ann (Text "Hint/ignore file to use") (Ann (FldTyp "FILE") (Ctor [] []))+    ,Ann (Text "Color the output (requires ANSI terminal)") (Ann (FldFlag "colour") (Ann (FldFlag "c") (Ctor False [])))+    ,Ann (Text "Ignore a particular hint") (Ann (FldTyp "MESSAGE") (Ctor [] []))+    ,Ann (Text "Show all ignored ideas") (Ctor False []),Ann (Text "Run in test mode") (Ctor False [])+    ,Ann (Text "CPP #define") (Ann (FldTyp "NAME[=VALUE]") (Ctor [] []))+    ,Ann (Text "CPP include path") (Ann (FldTyp "DIR") (Ctor [] []))+    ,Ann (FldTyp "FILE/DIR") (Ann FldArgs (Ctor [] []))]))))+-}

@@ -0,0 +1,128 @@+{-# LANGUAGE RecordWildCards, ViewPatterns, PatternGuards #-}++-- | This module takes the result of Capture, and forms the structure of+--   the arguments. This module supplies the most direct translation of+--   the annotations.+module System.Console.CmdArgs.Implicit.Step2(+    step2,+    Prog2(..), Mode2(..), Flag2(..), Flag2Type(..), Arg2(..)+    ) where++import System.Console.CmdArgs.Implicit.Ann+import System.Console.CmdArgs.Implicit.Read+import System.Console.CmdArgs.Implicit.Step1+import System.Console.CmdArgs.Explicit++import Data.Char+import Data.Generics.Any+import Data.List+import Data.Maybe+++data Prog2 a = Prog2+    {prog2Summary :: String+    ,prog2Name :: String+    ,prog2Help :: String+    ,prog2Verbosity :: Bool+    ,prog2ModeDefault :: Maybe Int -- index in to prog2Modes+    ,prog2Modes :: [Mode2 a]+    }++data Mode2 a = Mode2+    {mode2Names :: [Name]+    ,mode2Group :: String+    ,mode2Value :: a+    ,mode2Help :: Help+    ,mode2Suffix :: [String]+    ,mode2Flags :: [Flag2 a]+    ,mode2Args :: [Arg2 a]+    }++data Flag2 a = Flag2+    {flag2Names :: [Name]+    ,flag2Group :: String+    ,flag2Upd :: Flag2Type a+    ,flag2Opt :: Maybe String+    ,flag2FlagHelp :: FlagHelp+    ,flag2Help :: Help+    }++data Flag2Type a+    = Flag2String {fromFlag2String :: String -> a -> Either String a}+    | Flag2Bool (Bool -> a -> a)+    | Flag2Value (a -> a)++data Arg2 a = Arg2+    {arg2FlagHelp :: FlagHelp+    ,arg2Upd :: String -> a -> Either String a+    ,arg2Pos :: Maybe Int+    ,arg2Opt :: Maybe String+    }+++step2 :: Prog1 -> Prog2 Any+step2 = transProg+++isArg FlagArgs = True+isArg FlagArgPos{} = True+isArg _ = False+++---------------------------------------------------------------------+-- TRANSLATE+-- Translate in to the Mode domain++transProg :: Prog1 -> Prog2 Any+transProg (Prog1 ann xs) = Prog2 summary program hlp verb defMode (map transMode xs)+    where+        summary = let x = concat [x | ProgSummary x <- ann] in if null x then "The " ++ defProg ++ " program" else x+        hlp = concat [x | Help x <- ann]+        defMode = flip findIndex xs $ \(Mode1 an _ _) -> length xs /= 1 && ModeDefault `elem` an+        verb = ProgVerbosity `elem` ann+        program = last $ defProg : [x | ProgProgram x <- ann]+        defProg = let Mode1 _ x _ = head xs in map toLower $ typeShell x+++transMode :: Mode1 -> Mode2 Any+transMode (Mode1 an c xs) = Mode2+    [x | Name x <- an]+    (last $ "" : [x | GroupName x <- an])+    c+    (concat [x | Help x <- an])+    (concat [x | ModeHelpSuffix x <- an])+    (map transFlag rest)+    (map transArg args)+    where (args,rest) = partition (ann isArg) xs+          ann f (Flag1 x _ _) = any f x+++transFlag :: Flag1 -> Flag2 Any+transFlag flag@(Flag1 ann fld val)+    | Just (flaghelpdef,upd) <- transFlagType flag =+        Flag2 names grp upd opt (if null flaghelp then flaghelpdef else flaghelp) help+    | otherwise = error $ "Don't know how to deal with field type, " ++ fld ++ " :: " ++ show val+    where+        opt = let a = [x | FlagOptional x <- ann] in if null a then Nothing else Just $ concat a+        grp = last $ "" : [x | GroupName x <- ann]+        help = concat [x | Help x <- ann] ++ concat [" (default=" ++ x ++ ")" | Just x <- [opt], x /= ""]+        names = [x | Name x <- ann]+        flaghelp = concat [x | FlagType x <- ann]+++transFlagType :: Flag1 -> Maybe (String,Flag2Type Any)+transFlagType (Flag1 ann fld val)+    | FlagEnum `elem` ann = Just $ (,) "" $ Flag2Value $ \x -> setField (fld,val) x+    | isNothing mty = Nothing+    | isReadBool ty = f $ Flag2Bool $ \b x -> setField (fld,addContainer ty (getField fld x) (Any b)) x+    | otherwise = f $ Flag2String $ \s x -> fmap (\c -> setField (fld,c) x) $ reader ty s $ getField fld x+    where+        mty = toReadContainer val+        ty = fromJust mty+        f x = Just (readHelp ty, x)+++transArg :: Flag1 -> Arg2 Any+transArg x@(Flag1 ann _ _) = Arg2 (flag2FlagHelp y) (fromFlag2String $ flag2Upd y) pos (flag2Opt y)+    where y = transFlag x+          pos = listToMaybe [i | FlagArgPos i <- ann]

@@ -0,0 +1,189 @@+{-# LANGUAGE RecordWildCards, ViewPatterns, PatternGuards, DeriveDataTypeable #-}++-- | This module takes the result of Structure, and traslates it to+--   the CmdArgs.Explicit format.+module System.Console.CmdArgs.Implicit.Step3(+    step3,+    -- cmdArgs_privateArgsSeen is exported, otherwise Haddock+    -- gets confused when using RecordWildCards+    CmdArgs(..), cmdArgsHasValue+    ) where++import System.Console.CmdArgs.Implicit.Step2+import System.Console.CmdArgs.Explicit+import System.Console.CmdArgs.Verbosity+import System.Console.CmdArgs.Text++import Control.Arrow+import Data.Data+import Data.Maybe+import Data.Monoid+import Data.List+import Data.Function+++-- | A structure to store the additional data relating to @--help@,+--   @--version@, @--quiet@ and @--verbose@.+data CmdArgs a = CmdArgs+    {cmdArgsValue :: a -- ^ The underlying value being wrapped.+    ,cmdArgsHelp :: Maybe String -- ^ @Just@ if @--help@ is given, then gives the help message for display.+    ,cmdArgsVersion :: Maybe String -- ^ @Just@ if @--verion@ is given, then gives the version message for display.+    ,cmdArgsVerbosity :: Maybe Verbosity -- ^ @Just@ if @--quiet@ or @--verbose@ is given, then gives the verbosity to use.+    ,cmdArgsPrivate :: CmdArgsPrivate -- ^ Private: Only exported due to Haddock limitations.+    }+    deriving (Show,Data,Typeable)++instance Functor CmdArgs where+    fmap f x = x{cmdArgsValue = f $ cmdArgsValue x}++cmdArgsHasValue :: CmdArgs a -> Bool+cmdArgsHasValue x = isNothing (cmdArgsHelp x) && isNothing (cmdArgsVersion x)++data CmdArgsPrivate = CmdArgsPrivate+    Int -- ^ The number of arguments that have been seen+    deriving (Data,Typeable)++instance Show CmdArgsPrivate where show _ = "CmdArgsPrivate"++incArgsSeen x = x{cmdArgsPrivate = CmdArgsPrivate $ getArgsSeen x + 1}+getArgsSeen CmdArgs{cmdArgsPrivate = CmdArgsPrivate i} = i+++step3 :: Prog2 a -> Mode (CmdArgs a)+step3 p = common p $ transProg $ liftProg p+++---------------------------------------------------------------------+-- COMMON+-- Add common flags (--help/--version etc)++common :: Prog2 a -> Mode (CmdArgs a) -> Mode (CmdArgs a)+common p m+    | null $ modeModes m = addNormal m $ commonFlags p $ addNormal m+    | otherwise = addCommon m2 $ commonFlags p $ addCommon m2+    where+        add m xs = m{modeGroupFlags = xs `mappend` modeGroupFlags m}+        addNormal m xs = add m $ toGroup xs+        addCommon m xs = add m $ Group [] [] [("Common flags",xs)]+        addHidden m xs = add m $ Group [] xs []++        m2 = m{modeGroupModes = fmap f $ modeGroupModes m}+        f m = addHidden m $ commonFlags p $ addCommon $ m{modeNames = map ((prog2Name p ++ " ") ++) $ modeNames m}+++-- add common flags to a mode+commonFlags :: Prog2 a -> ([Flag (CmdArgs a)] -> Mode (CmdArgs a)) -> [Flag (CmdArgs a)]+commonFlags Prog2{..} add = flags+    where+        help hlp txt = showText txt $ Line prog2Summary : Line "" : helpText hlp (add flags)+        flags = +            [flagHelpFormat $ \hlp txt x -> x{cmdArgsHelp = Just $ help hlp txt}+            ,flagVersion $ \x -> x{cmdArgsVersion = Just prog2Summary}] +++            if not prog2Verbosity then [] else flagsVerbosity $ \v x -> x{cmdArgsVerbosity=Just v}+++---------------------------------------------------------------------+-- TRANSLATE+-- Translate in to the CmdArgs.Explicit domain++transProg :: Prog2 (CmdArgs a) -> Mode (CmdArgs a)+transProg p = res{modeNames = [prog2Name p]}+    where+        res = if length ys == 1 then snd $ head ys else defMode{modeGroupModes = toGroups ys, modeHelp = prog2Help p}+        defMode = maybe zeroMode (silentMode . snd . (ys!!)) $ prog2ModeDefault p+        silentMode m = m{modeGroupFlags=Group [] (modeFlags m) [], modeArgs=fmap (\x -> x{argType=""}) (modeArgs m)}+        ys = zip (map mode2Group $ prog2Modes p) $+                 zipWith transMode (map ((==) (prog2ModeDefault p) . Just) [0..]) $ prog2Modes p++        zeroMode = Mode (toGroup []) [] (embed $ error msg) chk "" [] Nothing $ toGroup []+            where msg = "System.Console.CmdArgs.Implicit: No default mode given (see cmdArgsHelp/cmdArgsVersion)"+                  chk x = if cmdArgsHasValue x then Left "No mode given and no default mode" else Right x+++transMode :: Bool -> Mode2 (CmdArgs a) -> Mode (CmdArgs a)+transMode auto Mode2{..} = transArgs mode2Args $ Mode+    (toGroup [])+    (["[" ++ head mode2Names ++ "]" | auto] ++ mode2Names)+    mode2Value+    Right+    mode2Help+    mode2Suffix+    Nothing+    (toGroups $ map (flag2Group &&& transFlag) mode2Flags)+++toGroups :: [(String,a)] -> Group a+toGroups xs = Group (f "") [] (map (id &&& f) names)+    where names = filter (not . null) $ nub $ map fst xs+          f x = map snd $ filter ((==) x . fst) xs+++transFlag :: Flag2 (CmdArgs a) -> Flag (CmdArgs a)+transFlag Flag2{..} = case flag2Upd of+    Flag2String upd -> (maybe flagReq flagOpt flag2Opt) flag2Names upd flag2FlagHelp flag2Help+    Flag2Bool upd -> flagBool flag2Names upd flag2Help+    Flag2Value upd -> flagNone flag2Names upd flag2Help+++transArgs :: [Arg2 (CmdArgs a)] -> Mode (CmdArgs a) -> Mode (CmdArgs a)+transArgs [] x = x+transArgs xs x = x{modeCheck=chk, modeArgs = Just $ flagArg upd hlp}+    where+        (ord,rep) = orderArgs xs+        mn = length $ dropWhile (isJust . arg2Opt) $ reverse ord++        chk v | not $ cmdArgsHasValue v = Right v+              | n < mn = Left $ "Requires at least " ++ show mn ++ " arguments, got " ++ show n+              | otherwise = foldl f (addOptArgs n v) (drop n ord)+            where n = getArgsSeen v+                  f (Right v) arg = arg2Upd arg (fromJust $ arg2Opt arg) v+                  f x _ = x++        -- if we have repeating args which is also opt, translate that here+        addOptArgs n v+            | Just x <- rep, Just o <- arg2Opt x, Just n <= findIndex (isNothing . arg2Pos) (ord ++ [x]) = arg2Upd x o v+            | otherwise = Right v++        hlp = unwords $ a ++ map (\x -> "["++x++"]") b+            where (a,b) = splitAt mn $ map arg2FlagHelp $ ord ++ maybeToList rep++        upd s v | n < length ord = arg2Upd (ord !! n) s v2+                | Just x <- rep = arg2Upd x s v2+                | otherwise = Left $ "expected at most " ++ show (length ord)+            where n = getArgsSeen v+                  v2 = incArgsSeen v+++-- return the arguments in order, plus those at the end+orderArgs :: [Arg2 a] -> ([Arg2 a], Maybe (Arg2 a))+orderArgs args = (f 0 ord, listToMaybe rep)+    where+        (rep,ord) = span (isNothing . arg2Pos) $ sortBy (compare `on` arg2Pos) args+        f i [] = []+        f i (x:xs) = case fromJust (arg2Pos x) `compare` i of+            LT -> f i xs+            EQ -> x : f (i+1) xs+            GT -> take 1 rep ++ f (i+1) (x:xs)+++---------------------------------------------------------------------+-- LIFT+-- Add the CmdArgs structure++embed x = CmdArgs x Nothing Nothing Nothing $ CmdArgsPrivate 0+proj x = (cmdArgsValue x, \y -> x{cmdArgsValue=y})++liftProg :: Prog2 a -> Prog2 (CmdArgs a)+liftProg x = x{prog2Modes = map liftMode $ prog2Modes x}++liftMode :: Mode2 a -> Mode2 (CmdArgs a)+liftMode x = x+    {mode2Value = embed $ mode2Value x+    ,mode2Flags = map liftFlag $ mode2Flags x+    ,mode2Args = map liftArg $ mode2Args x}++liftFlag x = x{flag2Upd = liftType $ flag2Upd x}+liftArg x = x{arg2Upd = fromFlag2String $ liftType $ Flag2String $ arg2Upd x}+liftType (Flag2String upd) = Flag2String $ \s v -> let (a,b) = proj v in fmap b $ upd s a+liftType (Flag2Bool upd) = Flag2Bool $ \s v -> let (a,b) = proj v in b $ upd s a+liftType (Flag2Value upd) = Flag2Value $ \v -> let (a,b) = proj v in b $ upd a

@@ -0,0 +1,161 @@+{-# LANGUAGE PatternGuards #-}+{-|+    This module describes the attributes that can be specified on flags and modes.++    Many attributes have examples specified on the following data type:++    > data Sample = Sample {hello :: String}+-}++module System.Console.CmdArgs.Implicit.UI where++import System.Console.CmdArgs.Implicit.Ann+import Data.Typeable+++-- | Flag: \"I want users to be able to omit the value for this flag.\"+--+--   Make the value of a flag optional. If @--flag@ is given, it will+--   be treated as @--flag=/this_argument/@.+--+-- > {hello = def &= opt "foo"}+-- >   -h --hello[=VALUE]    (default=foo)+opt :: (Show a, Typeable a) => a -> Ann+opt x = FlagOptional $ case cast x of+    Just y -> y+    _ -> show x++-- | Flag: \"For this flag, users need to give something of type ...\"+--+--   The the type of a flag's value, usually upper case. Only used+--   for the help message. Commonly the type will be @FILE@ ('typFile')+--   or @DIR@ ('typDir').+--+-- > {hello = def &= typ "MESSAGE"}+-- >   -h --hello=MESSAGE+typ :: String -> Ann+typ = FlagType++-- | Flag: \"Users must give a file for this flag's value.\"+--+--   Alias for @'typ' "FILE"@.+typFile :: Ann+typFile = typ "FILE"++-- | Flag: \"Users must give a directory for this flag's value.\"+--+--   Alias for @'typ' "DIR"@.+typDir :: Ann+typDir = typ "DIR"+++-- | Flag/Mode: \"The help message is ...\"+--+--   Descriptive text used in the help output.+--+-- > {hello = def &= help "Help message"}+-- >   -h --hello=VALUE      Help message+help :: String -> Ann+help = Help++{-+-- | Flag: Specify group membership for this flag+--+-- > {str = def &= group "Repository Management"+-- >   ---- Repository Management ----+-- >   -s --str=VALUE+group :: String -> Ann+group = FldGroup+-}++-- | Flag: \"Use this flag name for this field.\"+--+--   Add flags which trigger this option.+--+-- > {hello = def &= name "foo"}+-- >   -h --hello --foo=VALUE+name :: String -> Ann+name = Name++-- | Flag: \"Put non-flag arguments here.\"+--+-- > {hello = def &= args}+args :: Ann+args = FlagArgs++-- | Flag: \"Put the nth non-flag argument here.\"+--+--   This field should be used to store a particular argument position+--   (0-based).+--+-- > {hello = def &= argPos 0}+argPos :: Int -> Ann+argPos = FlagArgPos+++-- | Flag\/Mode: \"Give these flags/modes a group name in the help output.\"+--+--   This mode will be used for all following modes/flags, until the+--   next @groupname@.+--+-- > {hello = def &= groupname "Welcomes"}+-- > Welcomes+-- >   -h --hello=VALUE+groupname :: String -> Ann+groupname = GroupName+++-- | Mode: \"A longer description of this mode is ...\"+--+--   Suffix to be added to the help message.+--+-- > Sample{..} &= details ["More details on the website www.example.org"]+details :: [String] -> Ann+details = ModeHelpSuffix++-- | Modes: \"My program name\/version\/copyright is ...\"+--+--   One line summary of the entire program, the first line of+--   @--help@ and the only line of @--version@.+--+-- > Sample{..} &= summary "CmdArgs v0.0, (C) Neil Mitchell 1981"+summary :: String -> Ann+summary = ProgSummary+++-- | Mode: \"If the user doesn't give a mode, use this one.\"+--+--   This mode is the default. If no mode is specified and a mode has this+--   attribute then that mode is selected, otherwise an error is raised.+--+-- > modes [Mode1{..}, Mode2{..} &= auto, Mode3{..}]+auto :: Ann+auto = ModeDefault+++-- | Modes: \"My program executable is named ...\"+--+--   This is the name of the program executable. Only used in the help message.+--   Defaults to the type of the mode.+--+-- > Sample{..} &= program "sample"+program :: String -> Ann+program = ProgProgram+++-- | Flag: \"Don't guess any names for this field.\"+--+--   A field should not have any flag names guessed for it.+--   All flag names must be specified by 'flag'.+--+-- > {hello = def &= explicit &= flag "foo"}+-- >   --foo=VALUE+explicit :: Ann+explicit = Explicit+++-- | Modes: \"My program needs verbosity flags.\"+--+--   Add @--verbose@ and @--quiet@ flags.+verbosity :: Ann+verbosity = ProgVerbosity

@@ -0,0 +1,18 @@++module System.Console.CmdArgs.Test.All(test,demo,Demo,runDemo) where++import System.Console.CmdArgs.Explicit+import System.Console.CmdArgs.Test.Util+import qualified System.Console.CmdArgs.Test.Explicit as Explicit+import qualified System.Console.CmdArgs.Test.Implicit as Implicit+import qualified System.Console.CmdArgs.Test.GetOpt as GetOpt++test :: IO ()+test = do+    Explicit.test+    GetOpt.test+    Implicit.test+    putStrLn "\nTest completed"++demo :: [Mode Demo]+demo = GetOpt.demo ++ Explicit.demo ++ Implicit.demo

@@ -0,0 +1,80 @@++module System.Console.CmdArgs.Test.Explicit(test, demo) where++import System.Console.CmdArgs.Explicit+import System.Console.CmdArgs.Test.Util+++demo = []++test :: IO ()+test = do+    testUnnamedOnly+    testFlags+    testModes++testUnnamedOnly = do+    let m = name "UnnamedOnly" $ mode "" [] "" (flagArg (upd "") "") []+    checkFail m ["-f"]+    checkFail m ["--test"]+    checkGood m ["fred","bob"] ["fred","bob"]+    checkGood m ["--","--test"] ["--test"]+    checkGood m [] []++testFlags = do+    let m = name "Flags" $ mode "" [] "" (flagArg (upd "") "")+                [flagNone ["test","t"] ("test":) ""+                ,flagNone ["more","m"] ("more":) ""+                ,flagReq ["color","colour","bobby"] (upd "color") "" ""+                ,flagOpt "" ["bob","z"] (upd "bob") "" ""+                ,flagBool ["x","xxx"] (upb "xxx") ""]+    checkFail m ["-q"]+    checkGood m ["--test"] ["test"]+    checkGood m ["-t"] ["test"]+    checkFail m ["-t="]+    checkFail m ["--test=value"]+    checkFail m ["--bo"]+    checkGood m ["--bobb=r"] ["colorr"]+    checkGood m ["--bob"] ["bob"]+    checkGood m ["--bob=foo"] ["bobfoo"]+    checkGood m ["--bob","foo"] ["bob","foo"]+    checkGood m ["-zfoo"] ["bobfoo"]+    checkGood m ["-z=foo"] ["bobfoo"]+    checkGood m ["-z","foo"] ["bob","foo"]+    checkGood m ["--mo"] ["more"]+    checkGood m ["-tm"] ["test","more"]+    checkGood m ["--col=red"] ["colorred"]+    checkGood m ["--col","red","-t"] ["colorred","test"]++testModes = do+    let m = name "Modes" $ modes "" [] ""+                [(mode "test" ["test"] "" undefined [flagNone ["bob"] ("bob":) ""]){modeArgs=Nothing}+                ,mode "dist" ["dist"] "" (flagArg (upd "") "") [flagNone ["bob"] ("bob":) "", flagReq ["bill"] (upd "bill") "" ""]]+    checkGood m [] []+    checkFail m ["--bob"]+    checkFail m ["tess"]+    checkFail m ["test","arg"]+    checkGood m ["test","--b"] ["test","bob"]+    checkGood m ["t","--bo"] ["test","bob"]+    checkGood m ["dist","--bob"] ["dist","bob"]+    checkFail m ["dist","--bill"]+    checkGood m ["dist","--bill","foo"] ["dist","billfoo"]+++---------------------------------------------------------------------+-- UTILITIES++upd pre s x = Right $ (pre++s):x+upb pre s x = (pre ++ show s):x+name x y = ("Explicit " ++ x, y)++checkFail :: (String,Mode [String]) -> [String] -> IO ()+checkFail (n,m) xs = case process m xs of+    Right a -> failure "Succeeded when should have failed" [("Name",n),("Args",show xs),("Result",show a)]+    Left a -> length (show a) `hpc` success++checkGood :: (String,Mode [String]) -> [String] -> [String] -> IO ()+checkGood (n,m) xs ys = case process m xs of+    Left err -> failure "Failed when should have succeeded" [("Name",n),("Args",show xs),("Error",err)]+    Right a | reverse a /= ys -> failure "Wrong parse" [("Name",n),("Args",show xs),("Wanted",show ys),("Got",show $ reverse a)]+    _ -> success

@@ -0,0 +1,42 @@+{-# LANGUAGE DeriveDataTypeable #-}++module System.Console.CmdArgs.Test.GetOpt where++import Data.Data+import System.Console.CmdArgs.GetOpt+import qualified System.Console.CmdArgs.Explicit as Explicit+import System.Console.CmdArgs.Test.Util+++data Flag = Verbose | Version | Name String | Output String | Arg String deriving (Show,Data,Typeable)++options :: [OptDescr Flag]+options =+   [Option ['v']     ["verbose"]           (NoArg Verbose)      "verbosely list files",+    Option ['V','?'] ["version","release"] (NoArg Version)      "show version info",+    Option ['o']     ["output"]            (OptArg out "FILE")  "use FILE for dump",+    Option ['n']     ["name"]              (ReqArg Name "USER") "only dump USER's files"]++out :: Maybe String -> Flag+out Nothing  = Output "stdout"+out (Just o) = Output o++tester :: [String] -> (String,String)+tester cmdline = case getOpt Permute options cmdline of+                        (o,n,[]  ) -> let x = "options=" ++ show o ++ "  args=" ++ show n in (x,x)+                        (_,_,errs) -> ("failed", unlines errs ++ usageInfo header options)+   where header = "Usage: foobar [OPTION...] files..."++mode = (convert "GetOpt compatibility demo" options){Explicit.modeNames=["getopt"]}++demo = [newDemo print mode]+++test = do+    tester ["foo","-v"] === "options=[Verbose]  args=[\"foo\"]"+    tester ["foo","--","-v"] === "options=[]  args=[\"foo\",\"-v\"]"+    tester ["-?o","--name","bar","--na=baz"] === "options=[Version,Output \"stdout\",Name \"bar\",Name \"baz\"]  args=[]"+    tester ["--ver","foo"] === "failed"++a === b | fst a == b = success+        | otherwise = failure "Mismatch in GetOpt" [("Wanted",b),("Got",fst a)]

@@ -0,0 +1,12 @@++module System.Console.CmdArgs.Test.Implicit(test, demo) where++import System.Console.CmdArgs.Test.Implicit.Util+import qualified System.Console.CmdArgs.Test.Implicit.Diffy as Diffy+import qualified System.Console.CmdArgs.Test.Implicit.HLint as HLint+import qualified System.Console.CmdArgs.Test.Implicit.Maker as Maker+import qualified System.Console.CmdArgs.Test.Implicit.Tests as Tests++test = Diffy.test >> HLint.test >> Maker.test >> Tests.test++demo = toDemo Diffy.mode : toDemo HLint.mode : toDemo Maker.mode : Tests.demos

@@ -0,0 +1,44 @@+{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}+module System.Console.CmdArgs.Test.Implicit.Diffy where+import System.Console.CmdArgs+import System.Console.CmdArgs.Test.Implicit.Util++data Diffy = Create {src :: Maybe FilePath, out :: FilePath}+           | Diff {old :: FilePath, new :: FilePath, out :: FilePath}+             deriving (Data,Typeable,Show,Eq)++outFlags x = x &= help "Output file" &= typFile++create = Create+    {src = def &= help "Source directory" &= typDir+    ,out = outFlags "ls.txt"+    } &= help "Create a fingerprint"++diff = Diff+    {old = def &= typ "OLDFILE" &= argPos 0+    ,new = def &= typ "NEWFILE" &= argPos 1+    ,out = outFlags "diff.txt"+    } &= help "Perform a diff"++mode = cmdArgsMode $ modes [create,diff] &= help "Create and compare differences" &= program "diffy" &= summary "Diffy v1.0"++test = do+    let Tester{..} = tester "Diffy" mode+    fails []+    isHelp ["--help"]+    isHelp ["create","--help"]+    isHelp ["diff","--help"]+    isVersion ["--version"]+    ["create"] === create+    fails ["create","file1"]+    fails ["create","--quiet"]+    fails ["create","--verbose"]+    isVerbosity ["create"] Normal+    ["create","--src","x"] === create{src=Just "x"}+    ["create","--src","x","--src","y"] === create{src=Just "y"}+    fails ["diff","--src","x"]+    fails ["create","foo"]+    ["diff","foo1","foo2"] === diff{old="foo1",new="foo2"}+    fails ["diff","foo1"]+    fails ["diff","foo1","foo2","foo3"]+

@@ -0,0 +1,71 @@+{-# LANGUAGE DeriveDataTypeable, NamedFieldPuns #-}+module System.Console.CmdArgs.Test.Implicit.HLint where+import System.Console.CmdArgs+import System.Console.CmdArgs.Test.Implicit.Util+++data HLint = HLint+    {report :: [FilePath]+    ,hint :: [FilePath]+    ,color :: Bool+    ,ignore :: [String]+    ,show_ :: Bool+    ,extension :: [String]+    ,language :: [String]+    ,utf8 :: Bool+    ,encoding :: String+    ,find :: [FilePath]+    ,test_ :: Bool+    ,datadir :: [FilePath]+    ,cpp_define :: [String]+    ,cpp_include :: [FilePath]+    ,files :: [FilePath]+    }+    deriving (Data,Typeable,Show,Eq)++hlint = HLint+    {report = def &= opt "report.html" &= typFile &= help "Generate a report in HTML"+    ,hint = def &= typFile &= help "Hint/ignore file to use"+    ,color = def &= name "c" &= name "colour" &= help "Color the output (requires ANSI terminal)"+    ,ignore = def &= typ "MESSAGE" &= help "Ignore a particular hint"+    ,show_ = def &= help "Show all ignored ideas"+    ,extension = def &= typ "EXT" &= help "File extensions to search (defaults to hs and lhs)"+    ,language = def &= name "X" &= typ "LANG" &= help "Language extension (Arrows, NoCPP)"+    ,utf8 = def &= help "Use UTF-8 text encoding"+    ,encoding = def &= typ "ENC" &= help "Choose the text encoding"+    ,find = def &= typFile &= help "Find hints in a Haskell file"+    ,test_ = def &= help "Run in test mode"+    ,datadir = def &= typDir &= help "Override the data directory"+    ,cpp_define = def &= typ "NAME[=VALUE]" &= help "CPP #define"+    ,cpp_include = def &= typDir &= help "CPP include path"+    ,files = def &= args &= typ "FILES/DIRS"+    } &=+    verbosity &=+    help "Suggest improvements to Haskell source code" &=+    summary "HLint v0.0.0, (C) Neil Mitchell 2006-2010" &=+    details ["Hlint gives hints on how to improve Haskell code",""+            ,"To check all Haskell files in 'src' and generate a report type:","  hlint src --report"]++mode = cmdArgsMode hlint++test = do+    let Tester{(===),fails,isVerbosity} = tester "HLint" mode+    [] === hlint+    fails ["-ch"]+    isVerbosity ["--color","--quiet"] Quiet+    isVerbosity ["--color","--verbose"] Loud+    isVerbosity ["--color","--quiet","--verbose"] Loud+    isVerbosity [] Normal+    ["--colo"] === hlint{color=True}+    ["--colour","--colour=false"] === hlint+    ["--colour=true"] === hlint{color=True}+    ["-c=off"] === hlint+    ["-ct"] === hlint{color=True,test_=True}+    ["--colour","--test"] === hlint{color=True,test_=True}+    ["-thfoo"] === hlint{test_=True,hint=["foo"]}+    ["-cr"] === hlint{color=True,report=["report.html"]}+    ["--cpp-define=val","x"] === hlint{cpp_define=["val"],files=["x"]}+    fails ["--cpp-define"]+    ["--cpp-define","val","x","y"] === hlint{cpp_define=["val"],files=["x","y"]}++

@@ -0,0 +1,51 @@+{-# LANGUAGE DeriveDataTypeable, NamedFieldPuns #-}+module System.Console.CmdArgs.Test.Implicit.Maker where+import System.Console.CmdArgs+import System.Console.CmdArgs.Test.Implicit.Util++data Method = Debug | Release | Profile+              deriving (Data,Typeable,Show,Eq)++data Maker+    = Wipe+    | Test {threads :: Int, extra :: [String]}+    | Build {threads :: Int, method :: Method, files :: [FilePath]}+      deriving (Data,Typeable,Show,Eq)++threadsMsg x = x &= help "Number of threads to use" &= name "j" &= typ "NUM"++wipe = Wipe &= help "Clean all build objects"++test_ = Test+    {threads = threadsMsg def+    ,extra = def &= typ "ANY" &= args+    } &= help "Run the test suite"++build = Build+    {threads = threadsMsg def+    ,method = enum+        [Release &= help "Release build"+        ,Debug &= help "Debug build"+        ,Profile &= help "Profile build"]+    ,files = def &= args+    } &= help "Build the project" &= auto++mode = cmdArgsMode $ modes [build,wipe,test_] &= help "Build helper program" &= program "maker" &= summary "Maker v1.0"++test = do+    let Tester{(===),fails} = tester "Maker" mode+    [] === build+    ["build","foo","--profile"] === build{files=["foo"],method=Profile}+    ["foo","--profile"] === build{files=["foo"],method=Profile}+    ["foo","--profile","--release"] === build{files=["foo"],method=Release}+    ["-d"] === build{method=Debug}+    ["build","-j3"] === build{threads=3}+    ["build","-j=3"] === build{threads=3}+    fails ["build","-jN"]+    fails ["build","-t1"]+    ["wipe"] === wipe+    ["test"] === test_+    ["test","foo"] === test_{extra=["foo"]}+    ["test","foo","-j3"] === test_{extra=["foo"],threads=3}+    fails ["test","foo","-baz","-j3","--what=1"]+

@@ -0,0 +1,149 @@+{-# LANGUAGE DeriveDataTypeable, NamedFieldPuns #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}++module System.Console.CmdArgs.Test.Implicit.Tests where++import System.Console.CmdArgs+import System.Console.CmdArgs.Explicit(modeHelp)+import System.Console.CmdArgs.Test.Implicit.Util++test = test1 >> test2 >> test3 >> test4 >> test5 >> test6 >> test7 >> test8+demos = zipWith f [1..]+        [toDemo mode1, toDemo mode2, toDemo mode3, toDemo mode4, toDemo mode5, toDemo mode6+        ,toDemo mode7, toDemo mode8]+    where f i x = x{modeHelp = "Testing various corner cases (" ++ show i ++ ")"}+++-- from bug #256 and #231+data Test1+    = Test1 {maybeInt :: Maybe Int, listDouble :: [Double], maybeStr :: Maybe String, float :: Float+            ,bool :: Bool, maybeBool :: Maybe Bool, listBool :: [Bool]}+      deriving (Show,Eq,Data,Typeable)++def1 = Test1 def def def (def &= args) def def def+mode1 = cmdArgsMode $ def1++test1 = do+    let Tester{fails,(===)} = tester "Test1" mode1+    [] === def1+    ["--maybeint=12"] === def1{maybeInt = Just 12}+    ["--maybeint=12","--maybeint=14"] === def1{maybeInt = Just 14}+    fails ["--maybeint"]+    fails ["--maybeint=test"]+    ["--listdouble=1","--listdouble=3","--listdouble=2"] === def1{listDouble=[1,3,2]}+    fails ["--maybestr"]+    ["--maybestr="] === def1{maybeStr=Just ""}+    ["--maybestr=test"] === def1{maybeStr=Just "test"}+    ["12.5"] === def1{float=12.5}+    ["12.5","18"] === def1{float=18}+    ["--bool"] === def1{bool=True}+    ["--maybebool"] === def1{maybeBool=Just True}+    ["--maybebool=off"] === def1{maybeBool=Just False}+    ["--listbool","--listbool=true","--listbool=false"] === def1{listBool=[True,True,False]}+    fails ["--listbool=fred"]+++-- from bug #230+data Test2 = Cmd1 {bs :: [String]}+           | Cmd2 {bar :: Int}+             deriving (Show, Eq, Data, Typeable)++mode2 = cmdArgsMode $ modes [Cmd1 [], Cmd2 42]++test2 = do+    let Tester{fails,(===)} = tester "Test2" mode2+    fails []+    ["cmd1","-btest"] === Cmd1 ["test"]+    ["cmd2","-b14"] === Cmd2 14+++-- various argument position+data Test3 = Test3 {pos1_1 :: [Int], pos1_2 :: [String], pos1_rest :: [String]}+             deriving (Show, Eq, Data, Typeable)++mode3 = cmdArgsMode $ Test3 (def &= argPos 1) (def &= argPos 2 &= opt "foo") (def &= args)++test3 = do+    let Tester{fails,(===)} = tester "Test3" mode3+    fails []+    fails ["a"]+    ["a","1"] === Test3 [1] ["foo"] ["a"]+    ["a","1","c"] === Test3 [1] ["c"] ["a"]+    ["a","1","c","d"] === Test3 [1] ["c"] ["a","d"]+++-- from bug #222+data Test4 = Test4 {test_4 :: [String]}+             deriving (Show, Eq, Data, Typeable)++mode4 = cmdArgsMode $ Test4 (def &= opt "hello" &= args)++test4 = do+    let Tester{(===)} = tester "Test4" mode4+    [] === Test4 ["hello"]+    ["a"] === Test4 ["a"]+    ["a","b"] === Test4 ["a","b"]+++-- from #292, automatic enumerations+data ABC = Abacus | Arbitrary | B | C deriving (Eq,Show,Data,Typeable)+data Test5 = Test5 {choice :: ABC} deriving (Eq,Show,Data,Typeable)++mode5 = cmdArgsMode $ Test5 B++test5 = do+    let Tester{(===),fails} = tester "Test5" mode5+    [] === Test5 B+    fails ["--choice=A"]+    ["--choice=c"] === Test5 C+    ["--choice=C"] === Test5 C+    ["--choice=Aba"] === Test5 Abacus+    ["--choice=abacus"] === Test5 Abacus+    ["--choice=c","--choice=B"] === Test5 B++-- tuple support+data Test6 = Test6 {val1 :: (Int,Bool), val2 :: [(Int,(String,Double))]} deriving (Eq,Show,Data,Typeable)+val6 = Test6 def def++mode6 = cmdArgsMode val6++test6 = do+    let Tester{(===),fails} = tester "Test6" mode6+    [] === val6+    ["--val1=1,True"] === val6{val1=(1,True)}+    ["--val1=84,off"] === val6{val1=(84,False)}+    fails ["--val1=84"]+    fails ["--val1=84,off,1"]+    ["--val2=1,2,3","--val2=5,6,7"] === val6{val2=[(1,("2",3)),(5,("6",7))]}++-- from #333, add default fields+data Test7 = Test71 {shared :: Int}+           | Test72 {unique :: Int, shared :: Int}+           | Test73 {unique :: Int, shared :: Int}+             deriving (Eq,Show,Data,Typeable)++mode7 = cmdArgsMode $ modes [Test71{shared = def &= name "rename"}, Test72{unique=def}, Test73{}]++test7 = do+    let Tester{(===),fails} = tester "Test7" mode7+    fails []+    ["test71","--rename=2"] === Test71 2+    ["test72","--rename=2"] === Test72 0 2+    ["test72","--unique=2"] === Test72 2 0+    ["test73","--rename=2"] === Test73 0 2+    ["test73","--unique=2"] === Test73 2 0++-- from #252, grouping+data Test8 = Test8 {test8a :: Int, test8b :: Int, test8c :: Int}+           | Test81+           | Test82+             deriving (Eq,Show,Data,Typeable)++mode8 = cmdArgsMode $ modes [Test8 1 (2 &= groupname "Flags") 3 &= groupname "Mode1", Test81, Test82 &= groupname "Mode2"]++test8 = do+    let Tester{(===),fails} = tester "Test8" mode8+    -- FIXME: No good way to test the help output+    fails []+    ["test8","--test8a=18"] === Test8 18 2 3+

@@ -0,0 +1,46 @@++module System.Console.CmdArgs.Test.Implicit.Util where++import System.Console.CmdArgs.Implicit+import System.Console.CmdArgs.Explicit+import System.Console.CmdArgs.Test.Util+import Data.Maybe++toDemo :: (Typeable a, Show a) => Mode (CmdArgs a) -> Mode Demo+toDemo = newDemo $ \x -> cmdArgsApply x >>= print+++data Tester a = Tester+    {(===) :: [String] -> a -> IO ()+    ,fails :: [String] -> IO ()+    ,isHelp :: [String] -> IO ()+    ,isVersion :: [String] -> IO ()+    ,isVerbosity :: [String] -> Verbosity -> IO ()+    }+++tester :: (Show a, Eq a) => String -> Mode (CmdArgs a) -> Tester a+tester name m = Tester (===) fails isHelp isVersion isVerbosity+    where+        failed msg args xs = failure msg $ ("Name","Implicit "++name):("Args",show args):xs++        (===) args v = case process m args of+            Left x -> failed "Failed when should have succeeded" args [("Error",x)]+            Right x | cmdArgsValue x /= v -> failed "Wrong parse" args [("Expected",show v),("Got",show x)]+                    | otherwise -> success++        fails args = case process m args of+            Left x -> success+            Right x -> failed "Succeeded when should have failed" args [("Result",show x)]++        isHelp args = case process m args of+            Right x | isJust $ cmdArgsHelp x -> success+            _ -> failed "Failed on isHelp" args []++        isVersion args = case process m args of+            Right x | isJust $ cmdArgsVersion x -> success+            _ -> failed "Failed on isVersion" args []++        isVerbosity args v = case process m args of+            Right x | fromMaybe Normal (cmdArgsVerbosity x) == v -> success+            _ -> failed "Failed on isVerbosity" args []

@@ -0,0 +1,32 @@+{-# LANGUAGE ExistentialQuantification #-}++module System.Console.CmdArgs.Test.Util where++import System.Console.CmdArgs.Explicit+import Data.Maybe+import Data.Typeable+++failure :: String -> [(String,String)] -> IO ()+failure x ys = putStr $ unlines $ "" : "" : "FAILURE" : x : [a ++ ": " ++ b | (a,b) <- ys]++success :: IO ()+success = putChar '.'+++-- seq used to obtain better program coverage+hpc = seq+++-- Demo - wrap a demo up hiding the real type of it+data Demo = forall a . Typeable a => Demo (a -> IO ()) a++runDemo :: Demo -> IO ()+runDemo (Demo f a) = f a++-- Question: Is it possible to do this without the Typeable constraint?+newDemo :: Typeable a => (a -> IO ()) -> Mode a -> Mode Demo+newDemo act = remap (Demo act) (\(Demo f x) -> (coerce x, Demo f . coerce))+    where+        coerce :: (Typeable a, Typeable b) => a -> b+        coerce = fromMaybe (error "Type issue in CmdArgs.coerce") . cast

@@ -0,0 +1,149 @@+{-# LANGUAGE PatternGuards #-}++-- | A module to represent text with very basic formatting. Values are of+--   type ['Text'] and shown with 'showText'.+--+--   As an example of the formatting:+--+-- > [Line "Cooking for hungry people."+-- > ,Line "Welcome to my cookery recipe program, I sure hope you enjoy using it!"+-- > ,Line ""+-- > ,Cols ["Omlette","  A tasty eggy treat."]+-- > ,Cols ["  -m"," --mushrooms","  Some mushrooms, or in fact any other ingredients you have in the cupboards"]+-- > ,Cols ["  -e"," --eggs", "  But always you need eggs"]+-- > ,Line ""+-- > ,Cols ["Spagetti Bolognaise", "  An Italian delight."]+-- > ,Cols ["  -s"," --spagetti","  The first word in the name"]+-- > ,Cols ["  -b"," --bolognaise","  The second word in the name"]+-- > ,Cols ["  -d"," --dolmio","  The magic ingredient!"]+-- > ,Line ""+-- > ,Line "    The author of this program explicitly disclaims any liability for poisoning people who get their recipes off the internet."]+--+--   With @putStrLn ('showText' ('Wrap' 50) demo)@ gives:+--+-- > Cooking for hungry people.+-- > Welcome to my cookery recipe program, I sure hope+-- > you enjoy using it!+-- >+-- > Omlette              A tasty eggy treat.+-- >   -m --mushrooms   Some mushrooms, or in fact+-- >                    any other ingredients you have+-- >                    in the cupboards+-- >   -e --eggs        But always you need eggs+-- >+-- > Spagetti Bolognaise  An Italian delight.+-- >   -s --spagetti    The first word in the name+-- >   -b --bolognaise  The second word in the name+-- >   -d --dolmio      The magic ingredient!+-- >+-- >     The author of this program explicitly+-- >     disclaims any liability for poisoning people+-- >     who get their recipes off the internet.+module System.Console.CmdArgs.Text(TextFormat(..), defaultWrap, Text(..), showText) where++import Data.Char+import Data.Function+import Data.List+import Data.Maybe+import System.Console.CmdArgs.Default+++-- | Wrap with the default width of 80 characters.+defaultWrap :: TextFormat+defaultWrap = Wrap 80++-- | How to output the text.+data TextFormat = HTML -- ^ Display as HTML.+                | Wrap Int -- ^ Display as text wrapped at a certain width (see 'defaultWrap').+                  deriving (Read,Show,Eq,Ord)++instance Default TextFormat where def = defaultWrap++-- | The data type representing some text, typically used as @[Text]@. The formatting+--   is described by:+--+--   * 'Line' values represent a paragraph of text, and may be wrapped depending on the 'TextFormat'.+--     If a 'Line' value is wrapped then all leading space will be treated as an indent.+--+--   * 'Cols' values represent columns of text. Within any @[Text]@ all columns of the same length+--     are grouped in tabs, with the final column being wrapped if necessary. All columns are placed+--     adjacent with no space between them - for this reason most columns will start with a space.+data Text = Line String -- a single line+          | Cols [String] -- a single line with columns (always indented by 2 spaces)++instance Show Text where+    showList = showString . showText defaultWrap+    show x = showText defaultWrap [x]+++-- | Show some text using the given formatting.+showText :: TextFormat -> [Text] -> String+showText HTML = showHTML+showText (Wrap x) = showWrap x+++---------------------------------------------------------------------+-- TEXT OUTPUT++showWrap :: Int -> [Text] -> String+showWrap width xs = unlines $ concatMap f xs+    where+        cs :: [(Int,[Int])]+        cs = map (\x -> (fst $ head x, map maximum $ transpose $ map snd x)) $+                groupBy ((==) `on` fst) $ sortBy (compare `on` fst)+                [(length x, map length $ init x) | Cols x <- xs]+        pad n x = x ++ replicate (n - length x) ' '++        f (Line x) = map (a++) $ wrap1 (width - length a) b+            where (a,b) = span isSpace x++        f (Cols xs) = (concat $ zipWith pad ys xs ++ [z1]) : map (replicate n ' '++) zs+            where ys = fromJust $ lookup (length xs) cs+                  n = sum ys + length (takeWhile isSpace $ last xs)+                  z1:zs = wrap1 (width - n) (last xs)+++wrap1 width x = ["" | null res] ++ res+    where res = wrap width x++-- | Split the text into strips of no-more than the given width+wrap :: Int -> String -> [String]+wrap width = combine . split+    where+        split :: String -> [(String,Int)] -- string, amount of space after+        split "" = []+        split x = (a,length c) : split d+            where (a,b) = break isSpace x+                  (c,d) = span isSpace b++        -- combine two adjacent chunks while they are less than width+        combine :: [(String,Int)] -> [String]+        combine ((a,b):(c,d):xs) | length a + b + length c < width = combine $ (a ++ replicate b ' ' ++ c,d):xs+        combine (x:xs) = fst x : combine xs+        combine [] = []+++---------------------------------------------------------------------+-- HTML OUTPUT++showHTML :: [Text] -> String+showHTML xs = unlines $+    ["<table class='cmdargs'>"] +++    map f xs +++    ["</table>"]+    where+        cols = maximum [length x | Cols x <- xs]++        f (Line x) = tr $ td cols x+        f (Cols xs) = tr $ concatMap (td 1) (init xs) ++ td (cols + 1 - length xs) (last xs)++        tr x = "<tr>" ++ x ++ "</tr>"+        td cols x = "<td" ++ (if cols == 1 then "" else " colspan='" ++ show cols ++ "'")+                          ++ (if a /= "" then " style='padding-left:" ++ show (length a) ++ "ex;'" else "") +++                     ">" ++ if null b then "&nbsp;" else concatMap esc b ++ "</td>"+            where (a,b) = span isSpace x++        esc '&' = "&amp;"+        esc '>' = "&gt;"+        esc '<' = "&lt;"+        esc x = [x]

@@ -1,85 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, PatternGuards #-}-{-# OPTIONS_GHC -fno-warn-missing-fields #-}--module System.Console.CmdArgs.Type where--import Data.Dynamic-import Data.Data-import Data.List-import Data.Maybe-import Data.Char-import Data.Function---data Mode a = Mode-    {modeVal :: a-    ,modeName :: String-    ,modeText :: String-    ,modeHelpSuffix :: [String]-    ,modeExplicit :: Bool-    ,modeDef :: Bool-    ,modeProg :: Maybe String-    ,modeFlags :: [Flag]-    }-    deriving Show -- FIXME: The Show should be the --help--modeDefault = Mode{modeText="",modeHelpSuffix=[],modeExplicit=False,modeDef=False,modeProg=Nothing}--data Flag = Flag-    {flagName :: String -- field name-    ,flagKey :: String -- disambiguator (equal to field name, apart from enums)-    ,flagArgs :: Maybe (Maybe Int) -- Nothing = all arguments, Just i = position i, 0-based-    ,flagType :: FlagType-    ,flagVal :: Dynamic -- FIXME: Remove, only used in default computation-    ,flagOpt :: Maybe String-    ,flagTyp :: String-    ,flagText :: String-    ,flagFlag :: [String]-    ,flagUnknown :: Bool -- place to put unknown args-    ,flagExplicit :: Bool-    }-    deriving Show--flagDefault = Flag{flagArgs=Nothing,flagOpt=Nothing,flagTyp="",flagText="",flagFlag=[],flagUnknown=False,flagExplicit=False}--------------------------------------------------------------------------- STRUCTURED FLAGS---isFlagFlag = not . isFlagArgs-isFlagArgs = isJust . flagArgs-isFlagBool x = case flagType x of FlagBool{} -> True; _ -> False-isFlagOpt = isJust . flagOpt-flagTypDef def x = case flagTyp x of "" -> def; y -> y----- Flag types-data FlagType-    = FlagBool Dynamic-    | FlagItem (String -> Maybe (Dynamic -> Dynamic))--instance Show FlagType where-    show (FlagBool x) = "FlagBool " ++ show x-    show (FlagItem x) = "FlagItem <function>"--toFlagType :: TypeRep -> Maybe FlagType-toFlagType typ-    | typ == typeOf True = Just $ FlagBool $ toDyn True-    | Just r <- toFlagTypeRead False typ = Just $ FlagItem r-    | a == typeRepTyCon (typeOf ""), Just r <- toFlagTypeRead True (head b) = Just $ FlagItem r-    where (a,b) = splitTyConApp typ--toFlagTypeRead :: Bool -> TypeRep -> Maybe (String -> Maybe (Dynamic -> Dynamic))-toFlagTypeRead list x-    | x == typeOf "" = with (\x -> [(x,"")])-    | x == typeOf (0 :: Int) = with (reads :: ReadS Int)-    | x == typeOf (0 :: Integer) = with (reads :: ReadS Integer)-    | x == typeOf (0 :: Float) = with (reads :: ReadS Float)-    | x == typeOf (0 :: Double) = with (reads :: ReadS Double)-    | otherwise = Nothing-    where-        with :: forall a . Typeable a => ReadS a -> Maybe (String -> Maybe (Dynamic -> Dynamic))-        with r = Just $ \x -> case r x of-            [(v,"")] -> Just $ \old -> if list then toDyn $ fromJust (fromDynamic old) ++ [v] else toDyn v-            _ -> Nothing

@@ -1,229 +0,0 @@-{-# LANGUAGE PatternGuards #-}-{-|-    This module describes the attributes that can be specified on flags and modes.--    Many attributes have examples specified on the following data type:--    > data Sample = Sample-    >    {str :: String-    >    ,strs :: [String]}--}--module System.Console.CmdArgs.UI(-    -- ** Attribute mechanism-    mode, Mode, (&=), (&), Attrib,-    -- ** Flag attributes-    text, typ, typFile, typDir, empty, flag, explicit, enum, args, argPos, unknownFlags,-    -- ** Mode attributes-    prog, helpSuffix, defMode-    ) where--import System.Console.CmdArgs.Type-import System.IO.Unsafe-import Data.Dynamic-import Data.Data-import Data.List-import Data.Maybe-import Data.IORef-import Control.Exception-import Data.Char-import Control.Monad.State-import Data.Function---infix 1 &=-infixl 2 &-------------------------------------------------------------------------- STATE MANAGEMENT--{-# NOINLINE info #-}-info :: IORef Attrib-info = unsafePerformIO $ newIORef $ Attrib []---- | Add attributes to a value. Always returns the first argument, but---   has a non-pure effect on the environment. Take care when performing---   program transformations.------ > value &= attrib1 & attrib2-(&=) :: a -> Attrib -> a-(&=) x is = unsafePerformIO $ do-    writeIORef info is-    return x---- | Combine two attributes.-(&) :: Attrib -> Attrib -> Attrib-(&) (Attrib x) (Attrib y) = Attrib $ x ++ y--collect :: a -> IO [Info]-collect x = do-    evaluate x-    Attrib x <- readIORef info-    writeIORef info $ Attrib [] -- don't leak the info's-    return x---- | Construct a 'Mode' from a value annotated with attributes.-mode :: Data a => a -> Mode a-mode val = unsafePerformIO $ do-    info <- collect val-    let con = toConstr val-        name = map toLower $ showConstr con-    ref <- newIORef $ constrFields con-    flags <- liftM concat $ sequence $ flip gmapQ val $ \i -> do-        info <- collect i-        n:ns <- readIORef ref-        writeIORef ref ns-        case toFlagType $ typeOf i of-            _ | [FldEnum xs] <- info -> return [x{flagName=n} | x <- xs]-            Nothing -> error $ "Can't handle a type of " ++ show (typeOf i)-            Just x -> return [flagInfo flagDefault{flagName=n,flagKey=n,flagVal=toDyn i,flagType=x} info]-    return $ modeInfo modeDefault{modeVal=val,modeName=name,modeFlags=flags} info--------------------------------------------------------------------------- INFO ITEMS---- | Attributes to modify the behaviour.-newtype Attrib = Attrib [Info]--data Info-    = FldEmpty String-    | FldArgs-    | FldArgPos Int-    | FldTyp String-    | Text String-    | FldFlag String-    | FldExplicit-    | HelpSuffix [String]-    | FldUnknown-    | FldEnum [Flag]-    | ModDefault-    | ModProg String-      deriving Show---modeInfo :: Mode a -> [Info] -> Mode a-modeInfo = foldl $ \m x -> case x of-    Text x -> m{modeText=x}-    HelpSuffix x -> m{modeHelpSuffix=x}-    ModDefault -> m{modeDef=True}-    ModProg x -> m{modeProg=Just x}-    x -> error $ "Invalid attribute at mode level: " ++ show x---flagInfo :: Flag -> [Info] -> Flag-flagInfo = foldl $ \m x -> case x of-    Text x -> m{flagText=x}-    FldExplicit -> m{flagExplicit=True}-    FldTyp x -> m{flagTyp=x}-    FldEmpty x -> m{flagOpt=Just x}-    FldFlag x -> m{flagFlag=x:flagFlag m}-    FldArgs -> m{flagArgs=Just Nothing}-    FldArgPos i -> m{flagArgs=Just (Just i)}-    FldUnknown -> m{flagUnknown=True}-    x -> error $ "Invalid attribute at argument level: " ++ show x--------------------------------------------------------------------------- USER INTERFACE---- | Flag: Make the value of a flag optional, using the supplied---   value if none is given.------ > {str = def &= empty "foo"}--- >   -s --str[=VALUE]    (default=foo)-empty :: (Show a, Typeable a) => a -> Attrib-empty x = Attrib $ return $ case cast x of-    Just y -> FldEmpty y-    _ -> FldEmpty $ show x---- | Flag: The the type of a flag's value, usually upper case. Only---   used for the help message.------ > {str = def &= typ "FOO"}--- >   -s --str=FOO-typ :: String -> Attrib-typ = Attrib . return . FldTyp---- | Flag/Mode: Descriptive text used in the help output.------ > {str = def &= text "Help message"}--- >   -s --str=VALUE      Help message-text :: String -> Attrib-text = Attrib . return . Text---- | Flag: Add flags which trigger this option.------ > {str = def &= flag "foo"}--- >   -s --str --foo=VALUE-flag :: String -> Attrib-flag = Attrib . return . FldFlag---- | Flag: This field should be used to store the non-flag arguments. Can---   only be applied to fields of type @[String]@.------ > {strs = def &= args}-args :: Attrib-args = Attrib [FldArgs]---- | Flag: This field should be used to store a particular argument position---   (0-based). Can only be applied to fields of type @String@.------ > {str = def &= argPos 0}-argPos :: Int -> Attrib-argPos = Attrib . return . FldArgPos----- | Flag: Alias for @'typ' \"FILE\"@.-typFile :: Attrib-typFile = typ "FILE"---- | Flag: Alias for @'typ' \"DIR\"@.-typDir :: Attrib-typDir = typ "DIR"----- | Mode: Suffix to be added to the help message.-helpSuffix :: [String] -> Attrib-helpSuffix = Attrib . return . HelpSuffix---- | Flag: This field should be used to store all unknown flag arguments.---   If no @unknownFlags@ field is set, unknown flags raise errors.---   Can only be applied to fields of type @[String]@.------ > {strs = def &= unknownFlags}-unknownFlags :: Attrib-unknownFlags = Attrib [FldUnknown]---- | Mode: This mode is the default. If no mode is specified and a mode has this---   attribute then that mode is selected, otherwise an error is raised.-defMode :: Attrib-defMode = Attrib [ModDefault]---- | Mode: This is the name of the program running, used to override the result---   from @getProgName@. Only used in the help message.-prog :: String -> Attrib-prog = Attrib . return . ModProg---- | Flag: A field is an enumeration of possible values.------ > data Choice = Yes | No deriving (Data,Typeable,Show,Eq)--- > data Sample = Sample {choice :: Choice}--- > {choice = Yes & enum [Yes &= "say yes", No &= "say no"]}------ >   -y --yes    say yes (default)--- >   -n --no     say no-enum :: (Typeable a, Eq a, Show a) => a -> [a] -> a-enum def xs = unsafePerformIO $ do-    ys <- forM xs $ \x -> do-        y <- collect x-        return $ flagInfo flagDefault{flagKey=map toLower (show x), flagType=FlagBool (toDyn x), flagVal = toDyn False} y-    return $ def &= Attrib [FldEnum ys]---- | Flag: A field should not have any flag names guessed for it.---   All flag names must be specified by 'flag'.------ > {str = def &= explicit & flag "foo"}--- >   --foo=VALUE-explicit :: Attrib-explicit = Attrib [FldExplicit]

@@ -0,0 +1,60 @@+{-# LANGUAGE DeriveDataTypeable #-}++-- |  A module to deal with verbosity, how \'chatty\' a program should be.+--    This module defines the 'Verbosity' data type, along with functions+--    for manipulating a global verbosity value.+module System.Console.CmdArgs.Verbosity(+    Verbosity(..), setVerbosity, getVerbosity,+    isNormal, isLoud,+    whenNormal, whenLoud+    ) where++import Control.Monad+import Data.Data+import Data.IORef+import System.IO.Unsafe+++-- | The verbosity data type+data Verbosity+    = Quiet  -- ^ Only output essential messages (typically errors)+    | Normal -- ^ Output normal messages (typically errors and warnings)+    | Loud   -- ^ Output lots of messages (typically errors, warnings and status updates)+      deriving (Eq,Ord,Bounded,Enum,Show,Read,Data,Typeable)+++{-# NOINLINE ref #-}+ref :: IORef Verbosity+ref = unsafePerformIO $ newIORef Normal+++-- | Set the global verbosity.+setVerbosity :: Verbosity -> IO ()+setVerbosity = writeIORef ref++-- | Get the global verbosity. Initially @Normal@ before any calls to 'setVerbosity'.+getVerbosity :: IO Verbosity+getVerbosity = readIORef ref++-- | Used to test if warnings should be output to the user.+--   @True@ if the verbosity is set to 'Normal' or 'Loud' (when @--quiet@ is /not/ specified).+isNormal :: IO Bool+isNormal = fmap (>=Normal) getVerbosity++-- | Used to test if status updates should be output to the user.+--   @True@ if the verbosity is set to 'Loud' (when @--verbose@ is specified).+isLoud :: IO Bool+isLoud = fmap (>=Loud) getVerbosity+++-- | An action to perform if the verbosity is normal or higher, based on 'isNormal'.+whenNormal :: IO () -> IO ()+whenNormal act = do+    b <- isNormal+    when b act++-- | An action to perform if the verbosity is loud, based on 'isLoud'.+whenLoud :: IO () -> IO ()+whenLoud act = do+    b <- isLoud+    when b act

@@ -1,40 +1,80 @@ cabal-version:      >= 1.6 build-type:         Simple name:               cmdargs-version:            0.1+version:            0.2 license:            BSD3 license-file:       LICENSE category:           Console author:             Neil Mitchell <ndmitchell@gmail.com> maintainer:         Neil Mitchell <ndmitchell@gmail.com>-copyright:          Neil Mitchell 2009+copyright:          Neil Mitchell 2009-2010 synopsis:           Command line argument processing description:-    An easy way to define command line parsers. The two key features are:-    -    1) It's very concise to use, up to three times shorter than getopt.--    2) It supports programs with multiple modes (e.g. darcs or cabal).+    This library provides an easy way to define command line parsers. Most users+    will want to use the "System.Console.CmdArgs.Implicit" module, whose+    documentation contains an example.+    .+    * "System.Console.CmdArgs.Explicit" provides a way to write command line+      parsers for both single mode programs (most programs) and multiple+      mode programs (e.g. darcs or cabal). Parsers are defined by constructing+      a data structure.+    .+    * "System.Console.CmdArgs.Implicit" provides a way to concisely define+      command line parsers, up to three times shorter than getopt. These parsers+      are translated into the Explicit data type.+    .+    * "System.Console.CmdArgs.GetOpt" provides a wrapper allowing compatiblity+      with existing getopt parsers, mapping to the Explicit data type. homepage:           http://community.haskell.org/~ndm/cmdargs/ stability:          Beta extra-source-files:     cmdargs.htm +flag testprog+    default: True+    description: Build the test program+ library     build-depends: base == 4.*, mtl, filepath      exposed-modules:         System.Console.CmdArgs+        System.Console.CmdArgs.Default+        System.Console.CmdArgs.Explicit+        System.Console.CmdArgs.GetOpt+        System.Console.CmdArgs.Implicit+        System.Console.CmdArgs.Text+        System.Console.CmdArgs.Verbosity+     other-modules:-        System.Console.CmdArgs.UI-        System.Console.CmdArgs.Help-        System.Console.CmdArgs.Flag-        System.Console.CmdArgs.Type-        System.Console.CmdArgs.Expand+        Data.Generics.Any+        Data.Generics.Any.Prelude+        System.Console.CmdArgs.Explicit.Help+        System.Console.CmdArgs.Explicit.Process+        System.Console.CmdArgs.Explicit.Type+        System.Console.CmdArgs.Implicit.Ann+        System.Console.CmdArgs.Implicit.Capture+        System.Console.CmdArgs.Implicit.Read+        System.Console.CmdArgs.Implicit.Step1+        System.Console.CmdArgs.Implicit.Step2+        System.Console.CmdArgs.Implicit.Step3+        System.Console.CmdArgs.Implicit.UI  executable cmdargs     main-is: Main.hs+    if flag(testprog)+        buildable: True+    else+        buildable: False+     other-modules:-        HLint-        Diffy-        Maker+        System.Console.CmdArgs.Test.All+        System.Console.CmdArgs.Test.Explicit+        System.Console.CmdArgs.Test.GetOpt+        System.Console.CmdArgs.Test.Implicit+        System.Console.CmdArgs.Test.Implicit.Diffy+        System.Console.CmdArgs.Test.Implicit.HLint+        System.Console.CmdArgs.Test.Implicit.Maker+        System.Console.CmdArgs.Test.Implicit.Tests+        System.Console.CmdArgs.Test.Implicit.Util+        System.Console.CmdArgs.Test.Util

@@ -61,11 +61,7 @@ .cmdargs td { 	padding: 0px; 	margin: 0px;-	padding-right: 1em; }-.cmdargs td.indent {-	padding-left: 1em;-}         </style>     </head>     <body>@@ -77,7 +73,7 @@ </p>  <p>-    <a href="http://community.haskell.org/~ndm/cmdargs/">CmdArgs</a> is a library for defining and parsing command lines. The focus of CmdArgs is allowing the concise definition of fully-featured command line argument processors, in a mainly declarative manner (i.e. little coding needed). CmdArgs also supports multiple mode programs, for example as used in <a href="http://darcs.net/">darcs</a>.+    <a href="http://community.haskell.org/~ndm/cmdargs/">CmdArgs</a> is a library for defining and parsing command lines. The focus of CmdArgs is allowing the concise definition of fully-featured command line argument processors, in a mainly declarative manner (i.e. little coding needed). CmdArgs also supports multiple mode programs, for example as used in <a href="http://darcs.net/">darcs</a> and <a href="http://haskell.org/cabal/">Cabal</a>. </p><p> 	This document explains how to write the "hello world" of command line processors, then how to extend it with features into a complex command line processor. Finally this document gives three samples, which the <tt>cmdargs</tt> program can run. The three samples are: </p>@@ -89,6 +85,10 @@ <p> 	For each example you are encouraged to look at it's source (see the <a href="http://community.haskell.org/~ndm/darcs/hlint">darcs repo</a>, or the bottom of this document) and run it (try <tt>cmdargs hlint --help</tt>). The HLint program is fairly standard in terms of it's argument processing, and previously used the <a href="http://haskell.org/ghc/docs/latest/html/libraries/base/System-Console-GetOpt.html">System.Console.GetOpt</a> library. Using GetOpt required 90 lines and a reasonable amount of duplication. Using CmdArgs the code requires 30 lines, and the logic is much simpler. </p>+<h3>Acknowledgements</h3>+<p>+	Thanks to Kevin Quick for substantial patches, and additional code contributions from Sebastian Fischer.+</p>   <h2>Hello World Example</h2>@@ -103,17 +103,16 @@ data Sample = Sample {hello :: String}               deriving (Show, Data, Typeable) -sample = mode $ Sample{hello = def}+sample = Sample{hello = def} -main = print =<< cmdArgs "Sample v1, (C) Neil Mitchell 2009" [sample]+main = print =<< cmdArgs sample </pre> <p> 	To use the CmdArgs library there are three steps: </p> <ol> 	<li>Define a record data type (<tt>Sample</tt>) that contains a field for each argument. This type needs to have instances for <tt>Show</tt>, <tt>Data</tt> and <tt>Typeable</tt>.</li>-	<li>Give a value of that type (<tt>sample</tt>) with default values (<tt>def</tt> is the default value of any type). This value must be turned into a command line mode by calling the function <tt>mode</tt>.</li>-	<li>Call <tt>cmdArgs</tt> passing the mode, along with some text about the program.</li>+	<li>Give a value of that type (<tt>sample</tt>) with default values (<tt>def</tt> is a default value of any type, but I could also have written <tt>""</tt>). This value is turned into a command line by calling the <tt>cmdArgs</tt> function.</li> </ol> <p> 	Now we have a reasonably functional command line argument processor. Some sample interactions are:@@ -122,44 +121,40 @@ $ runhaskell Sample.hs --hello=world Sample {hello = "world"} +$ runhaskell Sample.hs --version+The sample program+ $ runhaskell Sample.hs --help-Sample v1, (C) Neil Mitchell 2009+The sample program -sample [FLAG]+sample [OPTIONS] -  -? --help[=FORMAT]  Show usage information (optional format)-  -V --version        Show version information-  -v --verbose        Higher verbosity-  -q --quiet          Lower verbosity-  -h --hello=VALUE+  -? --help        Display help message+  -V --version     Print version information+  -h --hello=ITEM </pre> <p>-	The CmdArgs library automatically provides support for:+	CmdArgs uses defaults to automatically infer a command line parser for a value, and provides annotations to override any of the the defaults. CmdArgs automatically supports <tt>--help</tt> and <tt>--version</tt> flags, and optionally supports verbosity flags. </p>-<ul>-	<li>Help - if the user specifies <tt>--help</tt> then a help message is displayed. If <tt>--help=HTML</tt> is specified, then the help message is formatted in HTML, suitable for pasting into a web page (see the bottom of this document).</li>-	<li>Version - if the user specifies <tt>--version</tt> then the first argument passed to <tt>cmdArgs</tt> is written to the screen.</li>-	<li>Verbosity - if the user specifies <tt>--verbose</tt> or <tt>--quiet</tt> then the verbosity is set appropriately. The current verbosity can be queried with the functions <tt>isQuiet</tt>, <tt>isNormal</tt> and <tt>isLoud</tt>.</li>-</ul>  <h2>Specifying Attributes</h2> <p> 	In order to control the behaviour we can add attributes. For example to add an attribute specifying the help text for the <tt>--hello</tt> argument we can write: </p> <pre>-sample = mode $ Sample{hello = def &= text "Who to say hello to"}+sample = Sample{hello = def &= help "Who to say hello to"} </pre> <p> 	We can add additional attributes, for example to specify the type of the value expected by hello: </p> <pre>-sample = mode $ Sample {hello = def &= text "Who to say hello to" & typ "WORLD"}+sample = Sample {hello = def &= help "Who to say hello to" &= typ "WORLD"} </pre> <p> 	Now when running <tt>--help</tt> the final line is: </p> <pre>-  -h --hello=WORLD    Who to say hello to+  -h --hello=WORLD  Who to say hello to </pre> <p> 	There are many more attributes, detailed in the <a href="http://hackage.haskell.org/packages/archive/cmdargs/latest/doc/html/System-Console-CmdArgs.html#2">Haddock documentation</a>.@@ -175,10 +170,10 @@             | Goodbye               deriving (Show, Data, Typeable) -hello = mode $ Hello{whom = def}-goodbye = mode $ Goodbye+hello = Hello{whom = def}+goodbye = Goodbye -main = print =<< cmdArgs "Sample v2, (C) Neil Mitchell 2009" [hello,goodbye]+main = print =<< cmdArgs (modes [hello,goodbye]) </pre> <p> 	Compared to the first example, we now have multiple constructors, and a sample value for each constructor is passed to <tt>cmdArgs</tt>. Some sample interactions with this command line are:@@ -191,19 +186,19 @@ Goodbye  $ runhaskell Sample.hs --help-Sample v2, (C) Neil Mitchell 2009+The sample program -sample hello [FLAG]+sample [OPTIONS] -  -w --whom=VALUE+ Common flags+  -? --help       Display help message+  -V --version    Print version information -sample goodbye [FLAG]+sample hello [OPTIONS] -Common flags:-  -? --help[=FORMAT]  Show usage information (optional format)-  -V --version        Show version information-  -v --verbose        Higher verbosity-  -q --quiet          Lower verbosity+  -w --whom=ITEM++sample goodbye [OPTIONS] </pre> <p> 	As before, the behaviour can be customised using attributes.@@ -239,55 +234,75 @@     ,color :: Bool     ,ignore :: [String]     ,show_ :: Bool-    ,test :: Bool+    ,extension :: [String]+    ,language :: [String]+    ,utf8 :: Bool+    ,encoding :: String+    ,find :: [FilePath]+    ,test_ :: Bool+    ,datadir :: [FilePath]     ,cpp_define :: [String]-    ,cpp_include :: [String]-    ,files :: [String]+    ,cpp_include :: [FilePath]+    ,files :: [FilePath]     }     deriving (Data,Typeable,Show,Eq) -hlint = mode $ HLint-    {report = def &= empty "report.html" & typFile & text "Generate a report in HTML"-    ,hint = def &= typFile & text "Hint/ignore file to use"-    ,color = def &= flag "c" & flag "colour" & text "Color the output (requires ANSI terminal)"-    ,ignore = def &= typ "MESSAGE" & text "Ignore a particular hint"-    ,show_ = def &= text "Show all ignored ideas"-    ,test = def &= text "Run in test mode"-    ,cpp_define = def &= typ "NAME[=VALUE]" & text "CPP #define"-    ,cpp_include = def &= typDir & text "CPP include path"-    ,files = def &= args & typ "FILE/DIR"+hlint = HLint+    {report = def &= opt "report.html" &= typFile &= help "Generate a report in HTML"+    ,hint = def &= typFile &= help "Hint/ignore file to use"+    ,color = def &= name "c" &= name "colour" &= help "Color the output (requires ANSI terminal)"+    ,ignore = def &= typ "MESSAGE" &= help "Ignore a particular hint"+    ,show_ = def &= help "Show all ignored ideas"+    ,extension = def &= typ "EXT" &= help "File extensions to search (defaults to hs and lhs)"+    ,language = def &= name "X" &= typ "LANG" &= help "Language extension (Arrows, NoCPP)"+    ,utf8 = def &= help "Use UTF-8 text encoding"+    ,encoding = def &= typ "ENC" &= help "Choose the text encoding"+    ,find = def &= typFile &= help "Find hints in a Haskell file"+    ,test_ = def &= help "Run in test mode"+    ,datadir = def &= typDir &= help "Override the data directory"+    ,cpp_define = def &= typ "NAME[=VALUE]" &= help "CPP #define"+    ,cpp_include = def &= typDir &= help "CPP include path"+    ,files = def &= args &= typ "FILES/DIRS"     } &=-    prog "hlint" &-    text "Suggest improvements to Haskell source code" &-    helpSuffix ["To check all Haskell files in 'src' and generate a report type:","  hlint src --report"]--modes = [hlint]+    verbosity &=+    help "Suggest improvements to Haskell source code" &=+    summary "HLint v0.0.0, (C) Neil Mitchell 2006-2010" &=+    details ["Hlint gives hints on how to improve Haskell code",""+            ,"To check all Haskell files in 'src' and generate a report type:","  hlint src --report"] -main = print =<< cmdArgs "HLint v1.6.5, (C) Neil Mitchell 2006-2009" modes+mode = cmdArgsMode hlint </pre> <!-- END --> <!-- BEGIN help hlint --> <table class='cmdargs'>-<tr><td colspan='3'>HLint v1.6.5, (C) Neil Mitchell 2006-2009</td></tr>-<tr><td colspan='3'>&nbsp;</td></tr>-<tr><td colspan='3'>hlint [FLAG] [FILE/DIR]</td></tr>-<tr><td colspan='3' class='indent'>Suggest improvements to Haskell source code</td></tr>-<tr><td colspan='3'>&nbsp;</td></tr>-<tr><td class='indent'>-?</td><td>--help[=FORMAT]</td><td>Show usage information (optional format)</td></tr>-<tr><td class='indent'>-V</td><td>--version</td><td>Show version information</td></tr>-<tr><td class='indent'>-v</td><td>--verbose</td><td>Higher verbosity</td></tr>-<tr><td class='indent'>-q</td><td>--quiet</td><td>Lower verbosity</td></tr>-<tr><td class='indent'>-r</td><td>--report[=FILE]</td><td>Generate a report in HTML (default=report.html)</td></tr>-<tr><td class='indent'>-h</td><td>--hint=FILE</td><td>Hint/ignore file to use</td></tr>-<tr><td class='indent'>-c</td><td>--color --colour</td><td>Color the output (requires ANSI terminal)</td></tr>-<tr><td class='indent'>-i</td><td>--ignore=MESSAGE</td><td>Ignore a particular hint</td></tr>-<tr><td class='indent'>-s</td><td>--show</td><td>Show all ignored ideas</td></tr>-<tr><td class='indent'>-t</td><td>--test</td><td>Run in test mode</td></tr>-<tr><td class='indent'></td><td>--cpp-define=NAME[=VALUE]</td><td>CPP #define</td></tr>-<tr><td class='indent'></td><td>--cpp-include=DIR</td><td>CPP include path</td></tr>-<tr><td colspan='3'>&nbsp;</td></tr>-<tr><td colspan='3'>To check all Haskell files in 'src' and generate a report type:</td></tr>-<tr><td colspan='3' class='indent'>hlint src --report</td></tr>+<tr><td colspan='3'>HLint v0.0.0, (C) Neil Mitchell 2006-2010</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td colspan='3'>hlint [OPTIONS] [FILES/DIRS]</td></tr>+<tr><td colspan='3' style='padding-left:1ex;'>Suggest improvements to Haskell source code</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td style='padding-left:2ex;'>-?</td><td style='padding-left:1ex;'>--help</td><td style='padding-left:2ex;'>Display help message</td></tr>+<tr><td style='padding-left:2ex;'>-V</td><td style='padding-left:1ex;'>--version</td><td style='padding-left:2ex;'>Print version information</td></tr>+<tr><td style='padding-left:2ex;'>-v</td><td style='padding-left:1ex;'>--verbose</td><td style='padding-left:2ex;'>Loud verbosity</td></tr>+<tr><td style='padding-left:2ex;'>-q</td><td style='padding-left:1ex;'>--quiet</td><td style='padding-left:2ex;'>Quiet verbosity</td></tr>+<tr><td style='padding-left:2ex;'>-r</td><td style='padding-left:1ex;'>--report[=FILE]</td><td style='padding-left:2ex;'>Generate a report in HTML (default=report.html)</td></tr>+<tr><td style='padding-left:2ex;'>-h</td><td style='padding-left:1ex;'>--hint=FILE</td><td style='padding-left:2ex;'>Hint/ignore file to use</td></tr>+<tr><td style='padding-left:2ex;'>-c</td><td style='padding-left:1ex;'>--color --colour</td><td style='padding-left:2ex;'>Color the output (requires ANSI terminal)</td></tr>+<tr><td style='padding-left:2ex;'>-i</td><td style='padding-left:1ex;'>--ignore=MESSAGE</td><td style='padding-left:2ex;'>Ignore a particular hint</td></tr>+<tr><td style='padding-left:2ex;'>-s</td><td style='padding-left:1ex;'>--show</td><td style='padding-left:2ex;'>Show all ignored ideas</td></tr>+<tr><td style='padding-left:2ex;'>&nbsp;<td style='padding-left:1ex;'>--extension=EXT</td><td style='padding-left:2ex;'>File extensions to search (defaults to hs and lhs)</td></tr>+<tr><td style='padding-left:2ex;'>-X</td><td style='padding-left:1ex;'>--language=LANG</td><td style='padding-left:2ex;'>Language extension (Arrows, NoCPP)</td></tr>+<tr><td style='padding-left:2ex;'>-u</td><td style='padding-left:1ex;'>--utf8</td><td style='padding-left:2ex;'>Use UTF-8 text encoding</td></tr>+<tr><td style='padding-left:2ex;'>&nbsp;<td style='padding-left:1ex;'>--encoding=ENC</td><td style='padding-left:2ex;'>Choose the text encoding</td></tr>+<tr><td style='padding-left:2ex;'>-f</td><td style='padding-left:1ex;'>--find=FILE</td><td style='padding-left:2ex;'>Find hints in a Haskell file</td></tr>+<tr><td style='padding-left:2ex;'>-t</td><td style='padding-left:1ex;'>--test</td><td style='padding-left:2ex;'>Run in test mode</td></tr>+<tr><td style='padding-left:2ex;'>-d</td><td style='padding-left:1ex;'>--datadir=DIR</td><td style='padding-left:2ex;'>Override the data directory</td></tr>+<tr><td style='padding-left:2ex;'>&nbsp;<td style='padding-left:1ex;'>--cpp-define=NAME[=VALUE]</td><td style='padding-left:2ex;'>CPP #define</td></tr>+<tr><td style='padding-left:2ex;'>&nbsp;<td style='padding-left:1ex;'>--cpp-include=DIR</td><td style='padding-left:2ex;'>CPP include path</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td colspan='3' style='padding-left:1ex;'>Hlint gives hints on how to improve Haskell code</td></tr>+<tr><td colspan='3' style='padding-left:1ex;'>&nbsp;</tr>+<tr><td colspan='3' style='padding-left:1ex;'>To check all Haskell files in 'src' and generate a report type:</td></tr>+<tr><td colspan='3' style='padding-left:3ex;'>hlint src --report</td></tr> </table> <!-- END --> @@ -308,60 +323,58 @@ module Diffy where import System.Console.CmdArgs -data Diffy = Create {src :: FilePath, out :: FilePath}+data Diffy = Create {src :: Maybe FilePath, out :: FilePath}            | Diff {old :: FilePath, new :: FilePath, out :: FilePath}              deriving (Data,Typeable,Show,Eq) -outFlags = text "Output file" & typFile--create = mode $ Create-    {src = "." &= text "Source directory" & typDir-    ,out = "ls.txt" &= outFlags-    } &= prog "diffy" & text "Create a fingerprint"+outFlags x = x &= help "Output file" &= typFile -diff = mode $ Diff-    {old = def &= typ "OLDFILE" & argPos 0-    ,new = def &= typ "NEWFILE" & argPos 1-    ,out = "diff.txt" &= outFlags-    } &= text "Perform a diff"+create = Create+    {src = def &= help "Source directory" &= typDir+    ,out = outFlags "ls.txt"+    } &= help "Create a fingerprint" -modes = [create,diff]+diff = Diff+    {old = def &= typ "OLDFILE" &= argPos 0+    ,new = def &= typ "NEWFILE" &= argPos 1+    ,out = outFlags "diff.txt"+    } &= help "Perform a diff" -main = print =<< cmdArgs "Diffy v1.0" modes+mode = cmdArgsMode $ modes [create,diff] &= help "Create and compare differences" &= program "diffy" &= summary "Diffy v1.0" </pre> <!-- END --> <!-- BEGIN help diffy --> <table class='cmdargs'> <tr><td colspan='3'>Diffy v1.0</td></tr>-<tr><td colspan='3'>&nbsp;</td></tr>-<tr><td colspan='3'>diffy create [FLAG]</td></tr>-<tr><td colspan='3' class='indent'>Create a fingerprint</td></tr>-<tr><td colspan='3'>&nbsp;</td></tr>-<tr><td class='indent'>-s</td><td>--src=DIR</td><td>Source directory (default=.)</td></tr>-<tr><td class='indent'>-o</td><td>--out=FILE</td><td>Output file (default=ls.txt)</td></tr>-<tr><td colspan='3'>&nbsp;</td></tr>-<tr><td colspan='3'>diffy diff [FLAG] OLDFILE NEWFILE</td></tr>-<tr><td colspan='3' class='indent'>Perform a diff</td></tr>-<tr><td colspan='3'>&nbsp;</td></tr>-<tr><td class='indent'>-o</td><td>--out=FILE</td><td>Output file (default=diff.txt)</td></tr>-<tr><td colspan='3'>&nbsp;</td></tr>-<tr><td colspan='3'>Common flags:</td></tr>-<tr><td class='indent'>-?</td><td>--help[=FORMAT]</td><td>Show usage information (optional format)</td></tr>-<tr><td class='indent'>-V</td><td>--version</td><td>Show version information</td></tr>-<tr><td class='indent'>-v</td><td>--verbose</td><td>Higher verbosity</td></tr>-<tr><td class='indent'>-q</td><td>--quiet</td><td>Lower verbosity</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td colspan='3'>diffy [OPTIONS]</td></tr>+<tr><td colspan='3' style='padding-left:1ex;'>Create and compare differences</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td colspan='3' style='padding-left:1ex;'>Common flags</td></tr>+<tr><td style='padding-left:2ex;'>-?</td><td style='padding-left:1ex;'>--help</td><td style='padding-left:2ex;'>Display help message</td></tr>+<tr><td style='padding-left:2ex;'>-V</td><td style='padding-left:1ex;'>--version</td><td style='padding-left:2ex;'>Print version information</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td colspan='3'>diffy create [OPTIONS]</td></tr>+<tr><td colspan='3' style='padding-left:1ex;'>Create a fingerprint</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td style='padding-left:2ex;'>-s</td><td style='padding-left:1ex;'>--src=DIR</td><td style='padding-left:2ex;'>Source directory</td></tr>+<tr><td style='padding-left:2ex;'>-o</td><td style='padding-left:1ex;'>--out=FILE</td><td style='padding-left:2ex;'>Output file</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td colspan='3'>diffy diff [OPTIONS] OLDFILE NEWFILE</td></tr>+<tr><td colspan='3' style='padding-left:1ex;'>Perform a diff</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td style='padding-left:2ex;'>-o</td><td style='padding-left:1ex;'>--out=FILE</td><td style='padding-left:2ex;'>Output file</td></tr> </table> <!-- END -->  <h3>Maker</h3>  <p>-	The Maker sample is based around a build system, where we can either build a project, clean the temporary files, or run a test. The test mode is designed to run another program, passing any unknown arguments onwards. Some interesting features are:+	The Maker sample is based around a build system, where we can either build a project, clean the temporary files, or run a test. Some interesting features are: </p> <ul> 	<li>The build mode is the default, so <tt>maker</tt> on it's own will be interpretted as a build command.</li> 	<li>The build method is an enumeration.</li>-	<li>The test mode collects unknown flags in the field <tt>extra</tt>.</li> 	<li>The <tt>threads</tt> field is in two of the constructors, but not all three. It is given the short flag <tt>-j</tt>, rather than the default <tt>-t</tt>.</li> </ul> @@ -381,54 +394,37 @@     | Build {threads :: Int, method :: Method, files :: [FilePath]}       deriving (Data,Typeable,Show,Eq) -threadsMsg = text "Number of threads to use" & flag "j" & typ "NUM"--wipe = mode $ Wipe &= prog "maker" & text "Clean all build objects"--test = mode $ Test-    {threads = def &= threadsMsg-    ,extra = def &= typ "ANY" & args & unknownFlags-    } &= text "Run the test suite"--build = mode $ Build-    {threads = def &= threadsMsg-    ,method = enum Release-        [Debug &= text "Debug build"-        ,Release &= text "Release build"-        ,Profile &= text "Profile build"]-    ,files = def &= args-    } &= text "Build the project" & defMode--modes = [build,wipe,test]+threadsMsg x = x &= help "Number of threads to use" &= name "j" &= typ "NUM" -main = print =<< cmdArgs "Maker v1.0" modes+wipe = Wipe &= help "Clean all build objects" </pre> <!-- END --> <!-- BEGIN help maker --> <table class='cmdargs'> <tr><td colspan='3'>Maker v1.0</td></tr>-<tr><td colspan='3'>&nbsp;</td></tr>-<tr><td colspan='3'>maker [build] [FLAG] [FILE]</td></tr>-<tr><td colspan='3' class='indent'>Build the project</td></tr>-<tr><td colspan='3'>&nbsp;</td></tr>-<tr><td class='indent'>-j</td><td>--threads=NUM</td><td>Number of threads to use</td></tr>-<tr><td class='indent'>-d</td><td>--debug</td><td>Debug build</td></tr>-<tr><td class='indent'>-r</td><td>--release</td><td>Release build</td></tr>-<tr><td class='indent'>-p</td><td>--profile</td><td>Profile build</td></tr>-<tr><td colspan='3'>&nbsp;</td></tr>-<tr><td colspan='3'>maker wipe [FLAG]</td></tr>-<tr><td colspan='3' class='indent'>Clean all build objects</td></tr>-<tr><td colspan='3'>&nbsp;</td></tr>-<tr><td colspan='3'>maker test [FLAG] [ANY]</td></tr>-<tr><td colspan='3' class='indent'>Run the test suite</td></tr>-<tr><td colspan='3'>&nbsp;</td></tr>-<tr><td class='indent'>-j</td><td>--threads=NUM</td><td>Number of threads to use</td></tr>-<tr><td colspan='3'>&nbsp;</td></tr>-<tr><td colspan='3'>Common flags:</td></tr>-<tr><td class='indent'>-?</td><td>--help[=FORMAT]</td><td>Show usage information (optional format)</td></tr>-<tr><td class='indent'>-V</td><td>--version</td><td>Show version information</td></tr>-<tr><td class='indent'>-v</td><td>--verbose</td><td>Higher verbosity</td></tr>-<tr><td class='indent'>-q</td><td>--quiet</td><td>Lower verbosity</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td colspan='3'>maker [OPTIONS] </td></tr>+<tr><td colspan='3' style='padding-left:1ex;'>Build helper program</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td colspan='3' style='padding-left:1ex;'>Common flags</td></tr>+<tr><td style='padding-left:2ex;'>-?</td><td style='padding-left:1ex;'>--help</td><td style='padding-left:2ex;'>Display help message</td></tr>+<tr><td style='padding-left:2ex;'>-V</td><td style='padding-left:1ex;'>--version</td><td style='padding-left:2ex;'>Print version information</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td colspan='3'>maker [build] [OPTIONS] [ITEM]</td></tr>+<tr><td colspan='3' style='padding-left:1ex;'>Build the project</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td style='padding-left:2ex;'>-j</td><td style='padding-left:1ex;'>--threads=NUM</td><td style='padding-left:2ex;'>Number of threads to use</td></tr>+<tr><td style='padding-left:2ex;'>-r</td><td style='padding-left:1ex;'>--release</td><td style='padding-left:2ex;'>Release build</td></tr>+<tr><td style='padding-left:2ex;'>-d</td><td style='padding-left:1ex;'>--debug</td><td style='padding-left:2ex;'>Debug build</td></tr>+<tr><td style='padding-left:2ex;'>-p</td><td style='padding-left:1ex;'>--profile</td><td style='padding-left:2ex;'>Profile build</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td colspan='3'>maker wipe [OPTIONS]</td></tr>+<tr><td colspan='3' style='padding-left:1ex;'>Clean all build objects</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td colspan='3'>maker test [OPTIONS] [ANY]</td></tr>+<tr><td colspan='3' style='padding-left:1ex;'>Run the test suite</td></tr>+<tr><td colspan='3'>&nbsp;</tr>+<tr><td style='padding-left:2ex;'>-j</td><td style='padding-left:1ex;'>--threads=NUM</td><td style='padding-left:2ex;'>Number of threads to use</td></tr> </table> <!-- END -->