cmdargs 0.6.7 → 0.6.8

raw patch · 12 files changed

+185/−51 lines, 12 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• System/Console/CmdArgs/Annotate.hs +1/−0
• System/Console/CmdArgs/Explicit/Type.hs +10/−3
• System/Console/CmdArgs/Implicit.hs +44/−6
• System/Console/CmdArgs/Implicit/Global.hs +13/−12
• System/Console/CmdArgs/Implicit/Local.hs +15/−6
• System/Console/CmdArgs/Implicit/Reform.hs +42/−0
• System/Console/CmdArgs/Implicit/Type.hs +12/−8
• System/Console/CmdArgs/Implicit/UI.hs +15/−2
• System/Console/CmdArgs/Test/Implicit/Diffy.hs +1/−1
• System/Console/CmdArgs/Test/Implicit/Tests.hs +5/−1
• System/Console/CmdArgs/Test/Implicit/Util.hs +23/−9
• cmdargs.cabal +4/−3

@@ -210,6 +210,7 @@     | AMany [Annotate ann]     | AAtom Any     | ACtor Any [Annotate ann]+      -- specifically DOES NOT derive Data, to avoid people accidentally including it   -- | Add an annotation to a value.

@@ -78,7 +78,8 @@     {modeGroupModes :: Group (Mode a) -- ^ The available sub-modes     ,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+    ,modeCheck :: a -> Either String a -- ^ Check the value reprsented by a mode is correct, after applying all flags+    ,modeReform :: a -> Maybe [String] -- ^ Given a value, try to generate the input arguments.     ,modeHelp :: Help -- ^ Help text     ,modeHelpSuffix :: [String] -- ^ A longer help suffix displayed after a mode     ,modeArgs :: Maybe (Arg a) -- ^ An unnamed argument@@ -187,6 +188,7 @@         {modeGroupModes = fmap (remap f g) $ modeGroupModes x         ,modeValue = f $ modeValue x         ,modeCheck = \v -> let (a,b) = g v in fmap b $ modeCheck x a+        ,modeReform = modeReform x . fst . g         ,modeArgs = fmap (remap f g) $ modeArgs x         ,modeGroupFlags = fmap (remap f g) $ modeGroupFlags x} @@ -202,14 +204,19 @@ --------------------------------------------------------------------- -- MODE/MODES CREATORS +-- | Create an empty mode specifying only 'modeValue'. All other fields will usually be populated+--   using record updates.+modeEmpty :: a -> Mode a+modeEmpty x = Mode mempty [] x Right (const Nothing) "" [] Nothing mempty+ -- | 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+mode name value help arg flags = (modeEmpty value){modeNames=[name], modeHelp=help, modeArgs=Just arg, modeGroupFlags=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 []+modes name value help xs = (modeEmpty value){modeNames=[name], modeHelp=help, modeGroupModes=toGroup xs}   ---------------------------------------------------------------------

@@ -7,11 +7,10 @@     @data Sample = Sample {hello :: String} deriving (Show, Data, Typeable)@      @sample = Sample{hello = 'def' '&=' 'help' \"World argument\" '&=' 'opt' \"world\"}@-    @         '&=' summary \"Sample v1\"@+    @         '&=' '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'@@ -43,10 +42,27 @@     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.++    /Pure annotations/: Alternatively, you may use pure annotations, which are+    referentially transparent, but less type safe and more verbose. The initial+    example may be written as:++    @sample = 'record' Sample{} [hello := 'def' '+=' 'help' \"World argument\" '+=' 'opt' \"world\"]@+    @         '+=' 'summary' \"Sample v1\"@++    @main = print =<< (cmdArgs_ sample :: IO Sample)@++    All the examples are written using impure annotations. To convert to pure+    annotations follow the rules:+    +    > Ctor {field1 = value1 &= ann1, field2 = value2} &= ann2 ==> record Ctor{} [field1 := value1 += ann1, field2 := value2] += ann2+    > Ctor (value1 &= ann1) value2 &= ann2 ==> record Ctor{} [atom value1 += ann1, atom value2] += ann2+    > many [Ctor1{...}, Ctor2{...}] ==> many_ [record Ctor1{} [...], record Ctor2{} [...]]+    > Ctor {field1 = enum [X &= ann, Y]} ==> record Ctor{} [field1 := enum_ [atom X += ann, atom Y]] -} module System.Console.CmdArgs.Implicit(     -- * Running command lines-    cmdArgs, cmdArgsMode, cmdArgsRun, cmdArgs_, cmdArgsMode_, cmdArgsApply, CmdArgs(..),+    cmdArgs, cmdArgsMode, cmdArgsRun, cmdArgs_, cmdArgsMode_, cmdArgsApply, CmdArgs(..), -- cmdArgsReform,     -- * 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).@@ -66,9 +82,10 @@     ) where  import Data.Data+import Data.Maybe import Data.Generics.Any import System.Exit-import System.Console.CmdArgs.Explicit(Mode,processArgs,remap)+import System.Console.CmdArgs.Explicit(Mode,processArgs,remap,modeReform) import System.Console.CmdArgs.Implicit.Ann import System.Console.CmdArgs.Annotate hiding ((&=)) import qualified System.Console.CmdArgs.Annotate as A((&=))@@ -82,12 +99,18 @@  -- | Take impurely annotated records and run the corresponding command line. --   Shortcut for @'cmdArgsRun' . 'cmdArgsMode'@.+--+--   To use 'cmdArgs' with custom command line arguments see+--   'System.Environment.withArgs'. cmdArgs :: Data a => a -> IO a cmdArgs = cmdArgsRun . cmdArgsMode   -- | Take purely annotated records and run the corresponding command line. --   Shortcut for @'cmdArgsRun' . 'cmdArgsMode_'@.+--+--   To use 'cmdArgs_' with custom command line arguments see+--   'System.Environment.withArgs'. cmdArgs_ :: Data a => Annotate Ann -> IO a cmdArgs_ = cmdArgsRun . cmdArgsMode_ @@ -150,6 +173,21 @@         return cmdArgsValue  +-- | Produce command line arguments that would generate the given value. This+--   function is useful for taking a value resulting from a command line,+--   modifying it (perhaps changing the value of a flag) and generating fresh+--   command line arguments.+--+-- > forall mode values constructed by cmdArgsMode/cmdArgsMode:+-- > forall args which successfully parse with mode+-- > let x = processValue mode args+-- > processValue mode (cmdArgsReform mode $ fromRight x) == x+_cmdArgsReform :: Mode (CmdArgs a) -> CmdArgs a -> [String]+_cmdArgsReform m x = fromMaybe (error err) $ modeReform m x+    where err = "System.Console.CmdArgs.Implicit.cmdArgsReform: cannot reform the arguments, perhaps the mode was not " +++                "generated by cmdArgsMode/cmdArgsMode_ ?"++ -- | 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.@@ -181,10 +219,10 @@ (&=) = (A.&=)  +-- | Like 'enum', but using the pure annotations. enum_ :: (Data c, Data f) => (c -> f) -> [Annotate Ann] -> Annotate Ann enum_ = (:=+) +-- | Like 'modes', but using the pure annotations. modes_ :: [Annotate Ann] -> Annotate Ann modes_ = many_--

@@ -1,8 +1,9 @@-{-# LANGUAGE PatternGuards #-}+{-# LANGUAGE PatternGuards, RecordWildCards #-}  module System.Console.CmdArgs.Implicit.Global(global) where  import System.Console.CmdArgs.Implicit.Local+import System.Console.CmdArgs.Implicit.Reform import System.Console.CmdArgs.Implicit.Type import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Text@@ -17,8 +18,8 @@   global :: Prog_ -> Mode (CmdArgs Any)-global x = setHelp x $ collapse $ assignGroups $ assignNames $ extraFlags x-+global x = setReform (reform y) $ setHelp y $ collapse $ assignGroups y+    where y = assignNames $ extraFlags x  --------------------------------------------------------------------- -- COLLAPSE THE FLAGS/MODES UPWARDS@@ -105,10 +106,6 @@             GT -> take 1 rep ++ f (i+1) (x:xs)  -incArgsSeen x = x{cmdArgsPrivate = CmdArgsPrivate $ getArgsSeen x + 1}-getArgsSeen CmdArgs{cmdArgsPrivate = CmdArgsPrivate i} = i-- --------------------------------------------------------------------- -- DEAL WITH GROUPS @@ -155,15 +152,15 @@                   changeBuiltin_ (fst $ progVerbosityArgs p) (wrap loud) ++                   changeBuiltin_ (snd $ progVerbosityArgs p) (wrap quiet)           [loud,quiet] = flagsVerbosity verb-          vers x = x{cmdArgsVersion = Just $ unlines $ progSumm p}+          vers x = x{cmdArgsVersion = Just $ unlines $ progVersionOutput p}           verb v x = x{cmdArgsVerbosity = Just v}   changeBuiltin :: Maybe Builtin_ -> Flag a -> [Flag a] changeBuiltin Nothing _ = []-changeBuiltin (Just (Builtin_ names explicit help _)) x = [x-    {flagNames = names ++ if explicit then [] else flagNames x-    ,flagHelp = fromMaybe (flagHelp x) help}]+changeBuiltin (Just Builtin_{..}) x = [x+    {flagNames = builtinNames ++ if builtinExplicit then [] else flagNames x+    ,flagHelp = fromMaybe (flagHelp x) builtinHelp}]  changeBuiltin_ :: Maybe Builtin_ -> Flag_ -> [Flag_] changeBuiltin_ Nothing _ = []@@ -178,7 +175,7 @@         mapModes1 f pre m = m{modeGroupModes = fmap (mapModes0 f (pre ++ head (modeNames m) ++ " ")) $ modeGroupModes m}          add pre m = changeHelp p m $ \hlp txt x -> x{cmdArgsHelp=Just $ showText txt $ msg hlp}-            where msg hlp = map Line (progSumm p) ++ Line "" : helpText hlp (prepare m{modeNames = map (pre++) $ modeNames m})+            where msg hlp = map Line (progHelpOutput p) ++ Line "" : helpText hlp (prepare m{modeNames = map (pre++) $ modeNames m})          prepare = mapModes1 (\_ m -> m{modeGroupFlags = groupCommonHide $ modeGroupFlags m}) "" @@ -187,6 +184,10 @@ changeHelp p m upd = m{modeGroupFlags = fmap f $ modeGroupFlags m}     where hlp = changeBuiltin (progHelpArg p) $ flagHelpFormat upd           f flg = if concatMap flagNames hlp == flagNames flg then head hlp else flg+++setReform :: (a -> Maybe [String]) -> Mode a -> Mode a+setReform f m = m{modeReform = f, modeGroupModes = fmap (setReform f) $ modeGroupModes m}   ---------------------------------------------------------------------

@@ -5,7 +5,8 @@ --   constraints. module System.Console.CmdArgs.Implicit.Local(     local, err,-    Prog_(..), progSumm, Builtin_(..), Mode_(..), Flag_(..), isFlag_+    Prog_(..), Builtin_(..), Mode_(..), Flag_(..), isFlag_,+    progHelpOutput, progVersionOutput     ) where  import System.Console.CmdArgs.Implicit.Ann@@ -15,6 +16,7 @@ import System.Console.CmdArgs.Annotate import System.Console.CmdArgs.Default +import Control.Monad import Data.Char import Data.Generics.Any import Data.Maybe@@ -25,22 +27,29 @@     ,progSummary :: Maybe [String]     ,progProgram :: String     ,progHelp :: String -- only for multiple mode programs-    ,progVerbosityArgs :: (Maybe Builtin_, Maybe Builtin_)+    ,progVerbosityArgs :: (Maybe Builtin_, Maybe Builtin_) -- (verbose, quiet)     ,progHelpArg :: Maybe Builtin_     ,progVersionArg :: Maybe Builtin_     } deriving Show instance Default Prog_ where     def = Prog_ def def def def def (Just def) (Just def)-progSumm x = fromMaybe ["The " ++ progProgram x ++ " program"] $ progSummary x +progOutput f x = fromMaybe ["The " ++ progProgram x ++ " program"] $+    (builtinSummary =<< f x) `mplus` progSummary x++progHelpOutput = progOutput progHelpArg+progVersionOutput = progOutput progVersionArg++ data Builtin_ = Builtin_     {builtinNames :: [String]     ,builtinExplicit :: Bool     ,builtinHelp :: Maybe String     ,builtinGroup :: Maybe String+    ,builtinSummary :: Maybe [String]     } deriving Show instance Default Builtin_ where-    def = Builtin_ def def def def+    def = Builtin_ def def def def def  data Mode_ = Mode_     {modeFlags_ :: [Flag_]@@ -50,8 +59,7 @@     ,modeExplicit :: Bool     } deriving Show instance Default Mode_ where-    def = Mode_ [] m def def def-        where m = Mode (toGroup []) [] (error "Mode_ undefined") Right "" [] Nothing (toGroup [])+    def = Mode_ [] (modeEmpty $ error "Mode_ undefined") def def def  data Flag_     = Flag_@@ -157,6 +165,7 @@ builtinAnn (Name a) (Just x) = Just x{builtinNames=a : builtinNames x} builtinAnn (Help a) (Just x) = Just x{builtinHelp=Just a} builtinAnn (GroupName a) (Just x) = Just x{builtinGroup=Just a}+builtinAnn (ProgSummary a) (Just x) = Just x{builtinSummary=Just $ lines a} builtinAnn a x = err "builtin" $ show a  

@@ -0,0 +1,42 @@+{-# LANGUAGE PatternGuards, RecordWildCards #-}++module System.Console.CmdArgs.Implicit.Reform(reform) where++import System.Console.CmdArgs.Implicit.Local+import System.Console.CmdArgs.Implicit.Type+import System.Console.CmdArgs.Verbosity++import Data.Generics.Any+import Data.List+import Data.Maybe+++reform :: Prog_ -> CmdArgs Any -> Maybe [String]+reform Prog_{..} CmdArgs{..} = Just $+    f "help" progHelpArg (isJust cmdArgsHelp) +++    f "version" progVersionArg (isJust cmdArgsVersion) +++    f "verbose" (fst progVerbosityArgs) (cmdArgsVerbosity == Just Loud) +++    f "quiet" (snd progVerbosityArgs) (cmdArgsVerbosity == Just Quiet)+    where+        f ex (Just x) True = pickArg $ builtinNames x ++ [ex]+        f _ _ _ = []+++pickArg :: [String] -> [String]+pickArg xs = case partition ((==) 1 . length) xs of+    (_, x:_) -> ["--" ++ x]+    (x:_, _) -> ["-" ++ x]+    _ -> []++{-++data Prog_ = Prog_+    {progModes :: [Mode_]+    ,progSummary :: Maybe [String]+    ,progProgram :: String+    ,progHelp :: String -- only for multiple mode programs+    ,progVerbosityArgs :: (Maybe Builtin_, Maybe Builtin_)+    ,progHelpArg :: Maybe Builtin_+    ,progVersionArg :: Maybe Builtin_+    } deriving Show+-}

@@ -4,7 +4,8 @@ module System.Console.CmdArgs.Implicit.Type(     -- cmdArgs_privateArgsSeen is exported, otherwise Haddock     -- gets confused when using RecordWildCards-    CmdArgs(..), CmdArgsPrivate(..), cmdArgsHasValue, embed, reembed+    CmdArgs(..), cmdArgsHasValue, embed, reembed,+    CmdArgsPrivate, incArgsSeen, getArgsSeen     ) where  import System.Console.CmdArgs.Verbosity@@ -22,17 +23,11 @@     ,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)+    deriving (Show,Eq,Ord,Data,Typeable)  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"- instance Functor CmdArgs where     fmap f x = x{cmdArgsValue = f $ cmdArgsValue x} @@ -43,3 +38,12 @@ reembed :: CmdArgs a -> (a, a -> CmdArgs a) reembed x = (cmdArgsValue x, \y -> x{cmdArgsValue=y}) ++data CmdArgsPrivate = CmdArgsPrivate+    Int -- ^ The number of arguments that have been seen+    deriving (Eq,Ord,Data,Typeable)++incArgsSeen x@CmdArgs{cmdArgsPrivate = CmdArgsPrivate i} = x{cmdArgsPrivate = CmdArgsPrivate (i+1)}+getArgsSeen CmdArgs{cmdArgsPrivate = CmdArgsPrivate i} = i++instance Show CmdArgsPrivate where show _ = "CmdArgsPrivate"

@@ -11,13 +11,26 @@ import Data.Typeable  --- | Flag: \"I want users to be able to omit the value for this flag.\"+-- | Flag: \"I want users to be able to omit the value associated with 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)+--+--   Note that all flags in CmdArgs are optional, and if omitted will use their default value.+--   Those annotated with @opt@ also allow the flag to be present without an associated value.+--   As an example:+--+-- > {hello = "DEFAULT" &= opt "OPTIONAL"}+--+-- > $ main+-- > {hello = "DEFAULT"}+-- > $ main --hello+-- > {hello = "OPTIONAL"}+-- > $ main --hello=VALUE+-- > {hello = "VALUE"} opt :: (Show a, Typeable a) => a -> Ann opt x = FlagOptional $ case cast x of     Just y -> y@@ -180,7 +193,7 @@  -- | Modes: \"Customise the version argument.\" -----   Add extra options to a version argument, such as 'help', 'name', 'ignore' or 'explicit'.+--   Add extra options to a version argument, such as 'help', 'name', 'ignore', 'summary' or 'explicit'. -- -- > Sample{..} &= versionArg [ignore] versionArg :: [Ann] -> Ann

@@ -29,7 +29,7 @@     isHelp ["create","--help"] []     isHelp ["diff","--help"] []     isHelpNot ["--help"] ["diffy"]-    isVersion ["--version"] "Diffy v1.0\n"+    isVersion ["--version"] "Diffy v1.0"     ["create"] === create     fails ["create","file1"]     fails ["create","--quiet"]

@@ -228,13 +228,15 @@     ["t"] === Test12B  --- the ignore annotation+-- the ignore annotation and versionArg [summary] data Test13 = Test13A {foo13 :: Int, bar13 :: Either Int Int}             | Test13B {foo13 :: Int}             | Test13C {foo13 :: Int}               deriving (Eq,Show,Data,Typeable)  mode13 = cmdArgsMode $ modes [Test13A 1 (Left 1 &= ignore), Test13B 1 &= ignore, Test13C{}]+                       &= versionArg [summary "Version text here"]+                       &= summary "Help text here"  test13 = do     let Tester{..} = tester "Test13" mode13@@ -242,6 +244,8 @@     fails ["test13a --bar13=1"]     ["test13a","--foo13=13"] === Test13A 13 (Left 1)     ["test13c","--foo13=13"] === Test13C 13+    isHelp ["--help"] ["Help text here"]+    isVersion ["--version"] "Version text here"  -- check a list becomes modes not an enum data Test14 = Test14A | Test14B | Test14C deriving (Eq,Show,Data,Typeable)

@@ -45,28 +45,42 @@     where         failed msg args xs = failure msg $ ("Name","Implicit "++name):("Args",show args):xs -        (===) args v = case process m args of+        f args cont = case process m args of+            Left x -> cont $ Left x+            Right x -> cont $ Right x+{-+            o@(Right x)+                | x2 == Right x -> cont $ Right x+                | otherwise -> do+                    failed "Reform failed" args [("Reformed",show args2),("Expected",show o),("Got",show x2)]+                    error "failure!"+                    cont $ Right x+                where args2 = cmdArgsReform m x+                      x2 = process m args2+-}++        (===) args v = f args $ \x -> case x 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+        fails args = f args $ \x -> case x of             Left x -> success-            Right x -> failed "Succeeded when should have failed" args [("Result",show x)]+            Right x -> failed "Succeeded 52 should have failed" args [("Result",show x)] -        isHelp args want = case process m args of+        isHelp args want = f args $ \x -> case x of             Right x | Just got <- cmdArgsHelp x, match want (lines got) -> success             _ -> failed "Failed on isHelp" args [] -        isHelpNot args want = case process m args of+        isHelpNot args want = f args $ \x -> case x 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 []+        isVersion args want = f args $ \x -> case x of+            Right x | Just got <- cmdArgsVersion x, match [want] (lines got) -> success+            _ -> failed "Failed on isVersion" args [("Want",want)] -        isVerbosity args v = case process m args of+        isVerbosity args v = f args $ \x -> case x of             Right x | fromMaybe Normal (cmdArgsVerbosity x) == v -> success             _ -> failed "Failed on isVerbosity" args [] 

@@ -1,7 +1,7 @@ cabal-version:      >= 1.6 build-type:         Simple name:               cmdargs-version:            0.6.7+version:            0.6.8 license:            BSD3 license-file:       LICENSE category:           Console@@ -59,9 +59,10 @@         System.Console.CmdArgs.Explicit.Process         System.Console.CmdArgs.Explicit.Type         System.Console.CmdArgs.Implicit.Ann-        System.Console.CmdArgs.Implicit.Read-        System.Console.CmdArgs.Implicit.Local         System.Console.CmdArgs.Implicit.Global+        System.Console.CmdArgs.Implicit.Local+        System.Console.CmdArgs.Implicit.Read+        System.Console.CmdArgs.Implicit.Reform         System.Console.CmdArgs.Implicit.Type         System.Console.CmdArgs.Implicit.UI