cmdargs 0.10.3 → 0.10.4

raw patch · 6 files changed

+60/−19 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Generics/Any/Prelude.hs +14/−2
• System/Console/CmdArgs/Implicit/Global.hs +6/−0
• System/Console/CmdArgs/Implicit/Local.hs +17/−8
• System/Console/CmdArgs/Implicit/Reader.hs +7/−6
• System/Console/CmdArgs/Test/Implicit/Tests.hs +15/−2
• cmdargs.cabal +1/−1

@@ -16,6 +16,11 @@ cons :: AnyT a -> AnyT [a] -> AnyT [a] cons x y = compose y "(:)" [x,y] +uncons :: AnyT [a] -> Maybe (AnyT a, AnyT [a])+uncons x = case decompose x of+    ("[]",[]) -> Nothing+    ("(:)",[a,b]) -> Just (a,b)+ null :: AnyT [a] -> Bool null x | isList x = ctor x == "[]" @@ -30,8 +35,15 @@  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)+    where f x y = case uncons x of+                       Nothing -> y+                       Just (a,b) -> cons a $ f b y++reverse :: AnyT [a] -> AnyT [a]+reverse xs | isList xs = rev xs (nil_ xs)+    where rev xs acc = case uncons xs of+                           Nothing -> acc+                           Just (x,xs) -> rev xs (cons x acc)   isString x = typeName x == "[Char]"

@@ -61,9 +61,15 @@  collapseMode :: Mode_ -> Mode (CmdArgs Any) collapseMode x =+    applyFixups (map flagFixup $ modeFlags_ x) $     collapseArgs [x | x@Arg_{} <- modeFlags_ x] $     collapseFlags [x | x@Flag_{} <- modeFlags_ x] $     modeMode x+++applyFixups :: [Fixup] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)+applyFixups xs m = m{modeCheck = either Left (Right . fmap fix) . modeCheck m}+    where fix a = foldr ($) a [x | Fixup x <- xs]   collapseFlags :: [Flag_] -> Mode (CmdArgs Any) -> Mode (CmdArgs Any)

@@ -5,7 +5,7 @@ --   constraints. module System.Console.CmdArgs.Implicit.Local(     local, err,-    Prog_(..), Builtin_(..), Mode_(..), Flag_(..), isFlag_,+    Prog_(..), Builtin_(..), Mode_(..), Flag_(..), Fixup(..), isFlag_,     progHelpOutput, progVersionOutput     ) where @@ -70,16 +70,23 @@         ,flagExplicit :: Bool         ,flagGroup :: Maybe String         ,flagEnum :: Maybe String -- if you are an enum, what is your string value+        ,flagFixup :: Fixup         }     | Arg_         {flagArg_ :: Arg (CmdArgs Any)         ,flagArgPos :: Maybe Int         ,flagArgOpt :: Maybe String+        ,flagFixup :: Fixup         }       deriving Show instance Default Flag_ where-    def = Flag_ "" (error "Flag_ undefined") def def def+    def = Flag_ "" (error "Flag_ undefined") def def def def +newtype Fixup = Fixup (Any -> Any)++instance Default Fixup where def = Fixup id+instance Show Fixup where show _ = "Fixup"+ isFlag_ Flag_{} = True isFlag_ _ = False @@ -116,7 +123,7 @@ flag_ :: String -> Capture Ann -> [Flag_] flag_ name (Ann Ignore _) = [] flag_ name (Ann a b) = map (flagAnn a) $ flag_ name b-flag_ name (Value x) = [def{flagField=name, flagFlag = remap embed reembed $ value_ name x}]+flag_ name (Value x) = let (fix,flg) = value_ name x in [def{flagField=name, flagFlag=remap embed reembed flg, flagFixup=fix}] flag_ name x@Ctor{} = flag_ name $ Value $ fromCapture x flag_ name (Many xs) = concatMap (enum_ name) xs flag_ name x = errFlag name $ show x@@ -132,19 +139,21 @@ enum_ name x = errFlag name $ show x  -value_ :: String -> Any -> Flag Any+-- Fixup (ends up in modeCheck) and the flag itself+value_ :: String -> Any -> (Fixup, Flag Any) value_ name x     | isNothing mty = errFlag name $ show x     | readerBool ty =         let f (Right x) = x             upd b x = setField (name, f $ readerRead ty (getField name x) $ show b) x-        in flagBool [] upd ""+        in (fixup, flagBool [] upd "")     | otherwise =         let upd s x = fmap (\c -> setField (name,c) x) $ readerRead ty (getField name x) s-        in flagReq [] upd (readerHelp ty) ""+        in (fixup, flagReq [] upd (readerHelp ty) "")     where         mty = reader x         ty = fromJust mty+        fixup = Fixup $ \x -> setField (name,readerFixup ty $ getField name x) x   ---------------------------------------------------------------------@@ -200,9 +209,9 @@ flagAnn a x = errFlag (head $ words $ show x) $ show a  toArg :: Flag_ -> Maybe Int -> Flag_-toArg (Flag_ fld x False Nothing Nothing) pos+toArg (Flag_ fld x False Nothing Nothing fix) pos     | null (flagNames x), null (flagHelp x), Just y <- opt $ flagInfo x-    = Arg_ (Arg (flagValue x) (flagType x) (isNothing y)) pos y+    = Arg_ (Arg (flagValue x) (flagType x) (isNothing y)) pos y fix     where         opt FlagReq = Just Nothing         opt (FlagOpt x) = Just (Just x)

@@ -16,6 +16,7 @@     {readerHelp :: String     ,readerBool :: Bool     ,readerParts :: Int+    ,readerFixup :: Any -> Any -- If a list, then 'reverse', otherwise nothing, so we can build up using cons in O(n)     ,readerRead :: Any -> String -> Either String Any     } @@ -26,15 +27,15 @@ reader :: Any -> Maybe Reader reader x | A.isList x && not (A.isString x) = do     r <- reader_ $ A.fromList x-    return r{readerRead = \o s -> fmap (A.append o . A.list_ x) $ readerRead_ r s}+    return r{readerRead = \o s -> fmap (`A.cons` o) $ readerRead_ r s, readerFixup = A.reverse} reader x = reader_ x   reader_ :: Any -> Maybe Reader-reader_ x | A.isString x = Just $ Reader "ITEM" False 1 $ const $ Right . Any+reader_ x | A.isString x = Just $ Reader "ITEM" False 1 id $ const $ Right . Any  -reader_ x | typeName x == "Bool" = Just $ Reader "BOOL" True 1 $ const $ \s ->+reader_ x | typeName x == "Bool" = Just $ Reader "BOOL" True 1 id $ const $ \s ->     maybe (Left $ "Could not read as boolean, " ++ show s) (Right . Any) $ parseBool s  @@ -46,7 +47,7 @@     where         ty = typeOf x         f hlp t | typeOf (Any t) /= ty = Nothing-                | otherwise = Just $ Reader hlp False 1 $ const $ \s -> case reads s of+                | otherwise = Just $ Reader hlp False 1 id $ const $ \s -> case reads s of             [(x,"")] -> Right $ Any $ x `asTypeOf` t             _ -> Left $ "Could not read as type " ++ show (typeOf $ Any t) ++ ", " ++ show s @@ -62,7 +63,7 @@   reader_ x | isAlgType x && length xs > 1 && all ((==) 0 . arity . snd) xs-    = Just $ Reader (map toUpper $ typeShell x) (typeName x == "Bool") 1 $ const $ rd . map toLower+    = Just $ Reader (map toUpper $ typeShell x) (typeName x == "Bool") 1 id $ const $ rd . map toLower     where         xs = [(map toLower c, compose0 x c) | c <- ctors x] @@ -77,7 +78,7 @@     let cs = children x     rs <- mapM reader_ cs     let n = sum $ map readerParts rs-    return $ Reader (uncommas $ map readerHelp rs) (map readerBool rs == [True]) n $ const $ \s ->+    return $ Reader (uncommas $ map readerHelp rs) (map readerBool rs == [True]) n id $ const $ \s ->         let ss = commas s in         if n == 1 then fmap (recompose x . return) $ readerRead_ (head $ filter ((==) 1 . readerParts) rs) s         else if length ss /= n then Left "Incorrect number of commas for fields"

@@ -324,15 +324,28 @@     [] === Test18 []     ["--debug-this","--debug-that","--debug-this"] === Test18 [This,That,This] +-- #610, check performance for long lists (took ~20s before)++data Test19 = Test19 {test19_ :: [String]} deriving (Eq,Show,Data,Typeable)++mode19 = cmdArgsMode $ Test19 ([] &= args)++test19 = do+    let Tester{..} = tester "Test19" mode19+    let args = map show [1..1000]+    args === Test19 args++ -- For some reason, these must be at the end, otherwise the Template Haskell -- stage restriction kicks in.  test = test1 >> test2 >> test3 >> test4 >> test5 >> test6 >> test7 >> test8 >> test9 >> test10 >>-       test11 >> test12 >> test13 >> test14 >> test15 >> test16 >> test18+       test11 >> test12 >> test13 >> test14 >> test15 >> test16 >> test18 >> test19 demos = zipWith f [1..]         [toDemo mode1, toDemo mode2, toDemo mode3, toDemo mode4, toDemo mode5, toDemo mode6         ,toDemo mode7, toDemo mode8, toDemo mode9, toDemo mode10, toDemo mode11, toDemo mode12-        ,toDemo mode13, toDemo mode14, toDemo mode15, toDemo mode16, toDemo mode17, toDemo mode18]+        ,toDemo mode13, toDemo mode14, toDemo mode15, toDemo mode16, toDemo mode17, toDemo mode18+        ,toDemo mode19]     where f i x = x{modeHelp = "Testing various corner cases (" ++ show i ++ ")"}  

@@ -1,7 +1,7 @@ cabal-version:      >= 1.6 build-type:         Simple name:               cmdargs-version:            0.10.3+version:            0.10.4 license:            BSD3 license-file:       LICENSE category:           Console