packages feed

cmdargs 0.2 → 0.3

raw patch · 12 files changed

+278/−64 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

- System.Console.CmdArgs.Explicit: groupHiden :: Group a -> [a]
+ System.Console.CmdArgs.Explicit: groupHidden :: Group a -> [a]

Files

System/Console/CmdArgs/Explicit.hs view
@@ -1,11 +1,43 @@ --- | 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.+{-|+    This module constructs command lines. You may either use the helper functions+    ('flagNone', 'flagOpt', 'mode' etc.) or construct the type directly. These+    types are intended to give all the necessary power to the person constructing+    a command line parser.++    For people constructing simpler command line parsers, the module+    "System.Console.CmdArgs.Implicit" may be more appropriate.++    As an example of a parser:++  > arguments :: Mode [(String,String)]+  > arguments = mode "explicit" [] "Explicit sample program" (flagArg (upd "file") "FILE")+  >     [flagOpt "world" ["hello","h"] (upd "world") "WHO" "World argument"+  >     ,flagReq ["greeting","g"] (upd "greeting") "MSG" "Greeting to give"+  >     ,flagHelpSimple (("help",""):)]+  >     where upd msg x v = Right $ (msg,x):v++    And this can be invoked by:++  > main = do+  >     x <- processArgs arguments+  >     if ("help","") `elem` xs then+  >         print $ helpText def arguments+  >      else+  >         print x++    /Groups/: The 'Group' structure allows flags/modes to be grouped for the purpose of+    displaying help. When processing command lines, the group structure is ignored.++    /Modes/: The Explicit module allows multiple mode programs by placing additional modes+    in 'modeGroupModes'. Every mode is allowed sub-modes, and thus multiple levels of mode+    may be created. Given a mode @x@ with sub-modes @xs@, if the first argument corresponds+    to the name of a sub-mode, then that sub-mode will be applied. If not, then the arguments+    will be processed by mode @x@. Consequently, if you wish to force the user to explicitly+    enter a mode, simply give sub-modes, and leave 'modeArgs' as @Nothing@. Alternatively, if+    you want one sub-mode to be selected by default, place all it's flags both in the sub-mode+    and the outer mode.+-} module System.Console.CmdArgs.Explicit(     -- * Running command lines     module System.Console.CmdArgs.Explicit.Process,
System/Console/CmdArgs/Explicit/Help.hs view
@@ -1,4 +1,47 @@+{-+Sample renderings: +-- ONE MODE+Program description++programname [OPTIONS] FILE1 FILE2 [FILES]+  Program to perform some action+  +  -f --flag     description+Flag grouping:+  -a --another  description+++-- MANY MODES WITH ONE SHOWN+Program description++programname [COMMAND] [OPTIONS] ...+  Program to perform some action++Commands:+  [build]  Build action here+  test     Test action here++Flags:+  -s --special  Special for the root only+Common flags:+  -? --help     Build action here+++-- MANY MODES WITH ALL SHOWN+Program description++programname [COMMAND] [OPTIONS] ...+  Program to perform some action++  -s --special  Special for the root only+Common flags:+  -? --help     Build action here++programname [build] [OPTIONS] [FILES}+  Action to perform here+-}+ module System.Console.CmdArgs.Explicit.Help(HelpFormat(..), helpText) where  import System.Console.CmdArgs.Explicit.Type@@ -58,23 +101,27 @@ 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]+        ms = space $ [Line "Commands:" | 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)+helpTextMode x@Mode{modeGroupFlags=flags,modeGroupModes=modes} = (pre,suf)     where-        pre = [Line $ unwords $ take 1 (modeNames x) ++ ["[OPTIONS]" | not $ null $ modeFlags x] +++        pre = [Line $ unwords $ take 1 (modeNames x) +++                  ["[COMMAND] ..." | notNullGroup modes] +++                  ["[OPTIONS]" | not $ null $ fromGroup flags] ++                   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)+              [Line $ "  " ++ modeHelp x | not $ null $ modeHelp x]+        suf = space+                  ([Line "Flags:" | mixedGroup flags] +++                   (helpGroup helpFlag $ modeGroupFlags x)) +++              space (map Line $ 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+    where g (a,b) = Line (a ++ ":") : concatMap f b   helpFlag :: Flag a -> [Text]@@ -91,3 +138,8 @@  cols (x:xs) = Cols $ ("  "++x) : map (' ':) xs space xs = [Line "" | not $ null xs] ++ xs+++nullGroup x = null (groupUnnamed x) && null (groupNamed x)+notNullGroup = not . nullGroup+mixedGroup x = not $ null (groupUnnamed x) || null (groupNamed x) -- has both unnamed and named
System/Console/CmdArgs/Explicit/Type.hs view
@@ -40,7 +40,7 @@ --   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).+    ,groupHidden :: [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  @@ -72,7 +72,7 @@ --   * 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+    ,modeNames :: [Name] -- ^ The names assigned to this mode (for the root mode, this name is used as the program name)     ,modeValue :: a -- ^ Value to start with     ,modeCheck :: a -> Either String a -- checking a value is correct     ,modeHelp :: Help -- ^ Help text
System/Console/CmdArgs/Implicit.hs view
@@ -24,19 +24,26 @@      * 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.+    /Supported Types/: Each field in the record must be one of the supported+    atomic types (@String@, @Int@, @Integer@, @Float@, @Double@, @Bool@, an+    enumeration, a tuple of atomic types) or a list (@[]@) or @Maybe@ wrapping+    at atomic type. -    [Missing Fields] If a field is shared by multiple modes, it may be omitted+    /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'.--}+    /Purity/: Values created with annotations are not pure - the first+    time they are computed they will include the annotations, but subsequently+    they will not. If you wish to run the above example in a more robust way: +    @sample = 'cmdArgsMode' $ Sample{hello = ... -- as before@++    @main = print =<< 'cmdArgsRun' sample@++    Even using this scheme, sometimes GHC's optimisations may share values who+    have the same annotation. To disable sharing you may need to specify+    @\{\-\# OPTIONS_GHC -fno-cse \#\-\}@ in the module you define the flags.+-} module System.Console.CmdArgs.Implicit(     -- * Running command lines     cmdArgs, cmdArgsMode, cmdArgsRun, cmdArgsApply, CmdArgs(..),
System/Console/CmdArgs/Implicit/Capture.hs view
@@ -7,6 +7,28 @@     Capture(..), capture, many, (&=)     ) where +{-+Notes on purity:++There is a risk that things that are unsafe will be inlined. That can generally be+removed by NOININE on everything.++There is also a risk that things get commoned up. For example:++foo = trace "1" 1+bar = trace "1" 1+main = do+    evaluate foo+    evaluate bar++Will print "1" only once, since foo and bar share the same pattern. However, if+anything in the value is a lambda they are not seen as equal. We exploit this by+defining const_ and id_ as per this module.++Now anything wrapped in id_ looks different from anything else.+-}++ import Data.Data(Data) import Data.IORef import System.IO.Unsafe@@ -46,6 +68,7 @@   -- | Collapse multiple values in to one.+{-# NOINLINE many #-} many :: Data a => [a] -> a many xs = unsafePerformIO $ do     ys <- mapM (force . Any) xs@@ -55,13 +78,15 @@  -- | 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+{-# NOINLINE addAnn #-}+addAnn :: Data a => a -> Ann -> a+addAnn x y = unsafePerformIO $ do     add (Ann y)     evaluate x     return x  +{-# NOINLINE capture #-} capture :: Any -> Capture capture x = unsafePerformIO $ force x @@ -78,3 +103,18 @@                | otherwise -> do             cs <- mapM force $ children x             return $ f $ Ctor x cs+++{-# INLINE (&=) #-}+(&=) :: Data a => a -> Ann -> a+(&=) x y = addAnn (id_ x) (id_ y)+++{-# NOINLINE const_ #-}+const_ :: a -> b -> b+const_ f x = x++{-# INLINE id_ #-}+id_ :: a -> a+id_ x = const_ (\() -> ()) x+
System/Console/CmdArgs/Implicit/Step1.hs view
@@ -11,7 +11,6 @@  import Data.Char import Data.List-import Data.Maybe   data Prog1 = Prog1 [Ann] [Mode1] deriving Show@@ -92,22 +91,22 @@     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+        f ask (x:xs) = x2 : f (\s -> let c = [b | b@(Flag1 _ a _) <- cs, a == s] in if null c then ask s else c) 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+inheritMode :: (String -> [Flag1]) -> Mode1 -> Mode1+inheritMode ask (Mode1 a b c) = Mode1 a (foldr ($) b upd) (concat c2)     where (c2,upd) = unzip $ map (inheritFlag ask) c  -inheritFlag :: (String -> Flag1) -> Flag1 -> (Flag1, Any -> Any)+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-+    | FlagInherit `notElem` a = ([Flag1 a b c], id)+    | or [typeOf c /= typeOf c2 | Flag1 _ _ c2 <- ys] = err $ "Field missing and previous instance has a different type:" ++ show b+    | Flag1 a2 b2 c2 : _ <- ys = (ys, setField (b2,c2))+    where ys = ask b  --------------------------------------------------------------------- -- FLATTEN
System/Console/CmdArgs/Test/Explicit.hs view
@@ -1,11 +1,24 @@  module System.Console.CmdArgs.Test.Explicit(test, demo) where +import System.Console.CmdArgs.Default import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Test.Util  -demo = []+demo = [newDemo act dem]++act xs | ("help","") `elem` xs = print $ helpText def dem+       | otherwise = print xs++dem :: Mode [(String,String)]+dem = mode "explicit" [] "Explicit sample program" (flagArg (upd "file") "FILE")+      [flagOpt "world" ["hello","h"] (upd "world") "WHO" "World argument"+      ,flagReq ["greeting","g"] (upd "greeting") "MSG" "Greeting to give"+      ,flagHelpSimple (("help",""):)+      ]+    where upd msg x v = Right $ (msg,x):v+  test :: IO () test = do
System/Console/CmdArgs/Test/Implicit/Diffy.hs view
@@ -25,10 +25,11 @@ test = do     let Tester{..} = tester "Diffy" mode     fails []-    isHelp ["--help"]-    isHelp ["create","--help"]-    isHelp ["diff","--help"]-    isVersion ["--version"]+    isHelp ["--help"] []+    isHelp ["create","--help"] []+    isHelp ["diff","--help"] []+    isHelpNot ["--help"] ["diffy"]+    isVersion ["--version"] "Diffy v1.0"     ["create"] === create     fails ["create","file1"]     fails ["create","--quiet"]
System/Console/CmdArgs/Test/Implicit/Maker.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable, NamedFieldPuns #-}+{-# OPTIONS_GHC -fno-cse #-} module System.Console.CmdArgs.Test.Implicit.Maker where import System.Console.CmdArgs import System.Console.CmdArgs.Test.Implicit.Util
System/Console/CmdArgs/Test/Implicit/Tests.hs view
@@ -1,5 +1,5 @@-{-# LANGUAGE DeriveDataTypeable, NamedFieldPuns #-}-{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-missing-fields -fno-warn-unused-binds #-}  module System.Console.CmdArgs.Test.Implicit.Tests where @@ -7,10 +7,10 @@ import System.Console.CmdArgs.Explicit(modeHelp) import System.Console.CmdArgs.Test.Implicit.Util -test = test1 >> test2 >> test3 >> test4 >> test5 >> test6 >> test7 >> test8+test = test1 >> test2 >> test3 >> test4 >> test5 >> test6 >> test7 >> test8 >> test9 >> test10 >> test11 demos = zipWith f [1..]         [toDemo mode1, toDemo mode2, toDemo mode3, toDemo mode4, toDemo mode5, toDemo mode6-        ,toDemo mode7, toDemo mode8]+        ,toDemo mode7, toDemo mode8, toDemo mode9, toDemo mode10, toDemo mode11]     where f i x = x{modeHelp = "Testing various corner cases (" ++ show i ++ ")"}  @@ -24,7 +24,7 @@ mode1 = cmdArgsMode $ def1  test1 = do-    let Tester{fails,(===)} = tester "Test1" mode1+    let Tester{..} = tester "Test1" mode1     [] === def1     ["--maybeint=12"] === def1{maybeInt = Just 12}     ["--maybeint=12","--maybeint=14"] === def1{maybeInt = Just 14}@@ -51,7 +51,7 @@ mode2 = cmdArgsMode $ modes [Cmd1 [], Cmd2 42]  test2 = do-    let Tester{fails,(===)} = tester "Test2" mode2+    let Tester{..} = tester "Test2" mode2     fails []     ["cmd1","-btest"] === Cmd1 ["test"]     ["cmd2","-b14"] === Cmd2 14@@ -64,7 +64,7 @@ mode3 = cmdArgsMode $ Test3 (def &= argPos 1) (def &= argPos 2 &= opt "foo") (def &= args)  test3 = do-    let Tester{fails,(===)} = tester "Test3" mode3+    let Tester{..} = tester "Test3" mode3     fails []     fails ["a"]     ["a","1"] === Test3 [1] ["foo"] ["a"]@@ -79,7 +79,7 @@ mode4 = cmdArgsMode $ Test4 (def &= opt "hello" &= args)  test4 = do-    let Tester{(===)} = tester "Test4" mode4+    let Tester{..} = tester "Test4" mode4     [] === Test4 ["hello"]     ["a"] === Test4 ["a"]     ["a","b"] === Test4 ["a","b"]@@ -92,7 +92,7 @@ mode5 = cmdArgsMode $ Test5 B  test5 = do-    let Tester{(===),fails} = tester "Test5" mode5+    let Tester{..} = tester "Test5" mode5     [] === Test5 B     fails ["--choice=A"]     ["--choice=c"] === Test5 C@@ -108,7 +108,7 @@ mode6 = cmdArgsMode val6  test6 = do-    let Tester{(===),fails} = tester "Test6" mode6+    let Tester{..} = tester "Test6" mode6     [] === val6     ["--val1=1,True"] === val6{val1=(1,True)}     ["--val1=84,off"] === val6{val1=(84,False)}@@ -125,7 +125,7 @@ mode7 = cmdArgsMode $ modes [Test71{shared = def &= name "rename"}, Test72{unique=def}, Test73{}]  test7 = do-    let Tester{(===),fails} = tester "Test7" mode7+    let Tester{..} = tester "Test7" mode7     fails []     ["test71","--rename=2"] === Test71 2     ["test72","--rename=2"] === Test72 0 2@@ -139,11 +139,56 @@            | Test82              deriving (Eq,Show,Data,Typeable) -mode8 = cmdArgsMode $ modes [Test8 1 (2 &= groupname "Flags") 3 &= groupname "Mode1", Test81, Test82 &= groupname "Mode2"]+mode8 = cmdArgsMode $ modes [Test8 1 (2 &= groupname "More 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+    let Tester{..} = tester "Test8" mode8+    isHelp ["-?"] ["Flags:","  --test8a=INT","More flags:","  --test8b=INT"]     fails []     ["test8","--test8a=18"] === Test8 18 2 3 +-- bug from Sebastian Fischer, enums with multiple fields+data XYZ = X | Y | Z deriving (Eq,Show,Data,Typeable)+data Test9 = Test91 {foo :: XYZ}+           | Test92 {foo :: XYZ}+             deriving (Eq,Show,Data,Typeable)++mode9 = cmdArgsMode $ modes [Test91 {foo = enum [X &= help "pick X (default)", Y &= help "pick Y"] &= opt "Y"} &= auto, Test92{}]++test9 = do+    let Tester{..} = tester "Test9" mode9+    [] === Test91 X+    ["test91","-x"] === Test91 X+    ["test91","-y"] === Test91 Y+    fails ["test91","-z"]+    ["test92","-x"] === Test92 X+    ["test92","-y"] === Test92 Y+    ["test92"] === Test92 X++-- share common fields in the help message+data Test10 = Test101 {food :: Int}+            | Test102 {food :: Int, bard :: Int}+              deriving (Eq,Show,Data,Typeable)++mode10 = cmdArgsMode $ modes [Test101 def, Test102 def def]++test10 = do+    let Tester{..} = tester "Test10" mode10+    -- FIXME: isHelp ["-?=one"] ["  -f --food=INT"]+    isHelpNot ["-?=one"] ["  -b --bard=INT"]++-- test for GHC over-optimising++data Test11 = Test11A {test111 :: String}+            | Test11B {test111 :: String}+              deriving (Eq,Show,Data,Typeable)++test11A = Test11A { test111 = def &= argPos 0 }+test11B = Test11B { test111 = def &= argPos 0 }+mode11 = cmdArgsMode $ modes [test11A, test11B]++test11 = do+    let Tester{..} = tester "Test11" mode11+    fails []+    ["test11a","test"] === Test11A "test"+    ["test11b","test"] === Test11B "test"
System/Console/CmdArgs/Test/Implicit/Util.hs view
@@ -1,9 +1,12 @@+{-# LANGUAGE PatternGuards #-}  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.Char+import Data.List import Data.Maybe  toDemo :: (Typeable a, Show a) => Mode (CmdArgs a) -> Mode Demo@@ -13,14 +16,15 @@ data Tester a = Tester     {(===) :: [String] -> a -> IO ()     ,fails :: [String] -> IO ()-    ,isHelp :: [String] -> IO ()-    ,isVersion :: [String] -> IO ()+    ,isHelp :: [String] -> [String] -> IO ()+    ,isHelpNot :: [String] -> [String] -> IO ()+    ,isVersion :: [String] -> 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+tester name m = Tester (===) fails isHelp isHelpNot isVersion isVerbosity     where         failed msg args xs = failure msg $ ("Name","Implicit "++name):("Args",show args):xs @@ -33,14 +37,31 @@             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+        isHelp args want = case process m args of+            Right x | Just got <- cmdArgsHelp x, match want (lines got) -> success             _ -> failed "Failed on isHelp" args [] -        isVersion args = case process m args of-            Right x | isJust $ cmdArgsVersion x -> success+        isHelpNot args want = case process m args of+            Right x | Just got <- cmdArgsHelp x, not $ match want (lines got) -> success+            _ -> failed "Failed on isHelpNot" args []++        isVersion args want = case process m args of+            Right x | Just got <- cmdArgsVersion x, match [want] [got] -> 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 []+++match :: [String] -> [String] -> Bool+match want got = any f $ tails got+    where f xs = length xs >= length want && and (zipWith matchLine want xs)+++matchLine :: String -> String -> Bool+matchLine (' ':' ':x) (' ':' ':y) = matchLine (dropWhile isSpace x) (dropWhile isSpace y)+matchLine (x:xs) (y:ys) | x == y = matchLine xs ys+matchLine [] [] = True+matchLine _ _ = False+
cmdargs.cabal view
@@ -1,7 +1,7 @@ cabal-version:      >= 1.6 build-type:         Simple name:               cmdargs-version:            0.2+version:            0.3 license:            BSD3 license-file:       LICENSE category:           Console@@ -25,6 +25,9 @@     .     * "System.Console.CmdArgs.GetOpt" provides a wrapper allowing compatiblity       with existing getopt parsers, mapping to the Explicit data type.+    .+    For a general reference on what command line flags are commonly used,+    see <http://www.faqs.org/docs/artu/ch10s05.html>. homepage:           http://community.haskell.org/~ndm/cmdargs/ stability:          Beta extra-source-files: