cmdargs 0.6.8 → 0.6.9
raw patch · 7 files changed
+130/−150 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Data/Generics/Any/Prelude.hs +4/−0
- System/Console/CmdArgs/Implicit.hs +4/−2
- System/Console/CmdArgs/Implicit/Local.hs +7/−6
- System/Console/CmdArgs/Implicit/Read.hs +0/−138
- System/Console/CmdArgs/Implicit/Reader.hs +97/−0
- System/Console/CmdArgs/Test/Implicit/Tests.hs +16/−2
- cmdargs.cabal +2/−2
Data/Generics/Any/Prelude.hs view
@@ -25,12 +25,16 @@ nil_ :: AnyT [a] -> AnyT [a] nil_ w = compose w "[]" [] +list_ :: AnyT [a] -> AnyT a -> AnyT [a]+list_ w x = cons x $ nil_ 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) +isString x = typeName x == "[Char]" isList x = typeShell x == "[]" isMaybe x = typeShell x == "Maybe" isTuple x = isJust $ readTupleType $ typeShell x
System/Console/CmdArgs/Implicit.hs view
@@ -6,8 +6,10 @@ @data Sample = Sample {hello :: String} deriving (Show, Data, Typeable)@ - @sample = Sample{hello = 'def' '&=' 'help' \"World argument\" '&=' 'opt' \"world\"}@- @ '&=' 'summary' \"Sample v1\"@+@+sample = Sample{hello = 'def' '&=' 'help' \"World argument\" '&=' 'opt' \"world\"}+ '&=' 'summary' \"Sample v1\"+@ @main = print =<< 'cmdArgs' sample@
System/Console/CmdArgs/Implicit/Local.hs view
@@ -11,7 +11,7 @@ import System.Console.CmdArgs.Implicit.Ann import System.Console.CmdArgs.Implicit.Type-import System.Console.CmdArgs.Implicit.Read+import System.Console.CmdArgs.Implicit.Reader import System.Console.CmdArgs.Explicit import System.Console.CmdArgs.Annotate import System.Console.CmdArgs.Default@@ -130,14 +130,15 @@ value_ :: String -> Any -> Flag Any value_ name x | isNothing mty = errFlag name $ show x- | isReadBool ty =- let upd b x = setField (name,addContainer ty (getField name x) (Any b)) 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 "" | otherwise =- let upd s x = fmap (\c -> setField (name,c) x) $ reader ty s $ getField name x- in flagReq [] upd (readHelp ty) ""+ let upd s x = fmap (\c -> setField (name,c) x) $ readerRead ty (getField name x) s+ in flagReq [] upd (readerHelp ty) "" where- mty = toReadContainer x+ mty = reader x ty = fromJust mty
− System/Console/CmdArgs/Implicit/Read.hs
@@ -1,138 +0,0 @@-{-# LANGUAGE PatternGuards #-}-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)- | Just (_,el) <- find (\x -> a == fst x) ys = Right el- | 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
+ System/Console/CmdArgs/Implicit/Reader.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE PatternGuards #-}++module System.Console.CmdArgs.Implicit.Reader(Reader(..), reader) where++import Data.Generics.Any+import qualified Data.Generics.Any.Prelude as A+import System.Console.CmdArgs.Explicit+import Data.Char+import Data.List+++data Reader = Reader+ {readerHelp :: String+ ,readerBool :: Bool+ ,readerParts :: Int+ ,readerRead :: Any -> String -> Either String Any+ }++-- reader tries to use the first argument to readerRead, but reader_ doesn't+readerRead_ r = readerRead r $ error "Invariant broken: reader/reader_"+++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}+reader x = reader_ x+++reader_ :: Any -> Maybe Reader+reader_ x | A.isString x = Just $ Reader "ITEM" False 1 $ const $ Right . Any+++reader_ x | typeName x == "Bool" = Just $ Reader "BOOL" True 1 $ const $ \s ->+ maybe (Left $ "Could not read as boolean, " ++ show s) (Right . Any) $ parseBool s+++reader_ x+ | ty == "Int" = f "INT" (0::Int)+ | ty == "Integer" = f "INT" (0::Integer)+ | ty == "Float" = f "NUM" (0::Float)+ | ty == "Double" = f "NUM" (0::Double)+ where+ ty = typeName x+ f hlp t = Just $ Reader hlp False 1 $ const $ \s -> case reads s of+ [(x,"")] -> Right $ Any $ x `asTypeOf` t+ _ -> Left $ "Could not read as type " ++ show (typeOf $ Any t) ++ ", " ++ show s+++reader_ x | A.isList x = do+ r <- reader_ $ A.fromList x+ return $ r{readerRead = const $ fmap (A.list_ x) . readerRead_ r}+++reader_ x | A.isMaybe x = do+ r <- reader_ $ A.fromMaybe x+ return $ r{readerRead = const $ fmap (A.just_ x) . readerRead_ r}+++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+ where+ xs = [(map toLower c, compose0 x c) | c <- ctors x]++ rd s | null ys = Left $ "Could not read, expected one of: " ++ unwords (map fst xs)+ | Just (_,x) <- find ((==) s . fst) ys = Right x+ | length ys > 1 = Left $ "Ambiguous read, could be any of: " ++ unwords (map fst ys)+ | otherwise = Right $ snd $ head ys+ where ys = filter (isPrefixOf s . fst) xs+++reader_ x | [c] <- ctors x, x <- compose0 x c = do+ 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 ->+ 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"+ else fmap (recompose x) $ sequenceEither $ zipWith readerRead_ rs $ map uncommas $ takes (map readerParts rs) ss+++reader_ _ = Nothing+++uncommas = intercalate ","+commas = lines . map (\x -> if x == ',' then '\n' else x)+++takes [] _ = []+takes (i:is) xs = a : takes is b+ where (a,b) = splitAt i xs++sequenceEither = foldr f (Right [])+ where f (Left x) _ = Left x+ f _ (Left x) = Left x+ f (Right x) (Right xs) = Right (x:xs)
System/Console/CmdArgs/Test/Implicit/Tests.hs view
@@ -9,11 +9,11 @@ test = test1 >> test2 >> test3 >> test4 >> test5 >> test6 >> test7 >> test8 >> test9 >> test10 >>- test11 >> test12 >> test13 >> test14 >> test15+ test11 >> test12 >> test13 >> test14 >> test15 >> test16 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 mode13, toDemo mode14, toDemo mode15, toDemo mode16] where f i x = x{modeHelp = "Testing various corner cases (" ++ show i ++ ")"} @@ -278,3 +278,17 @@ fails ["--verbose"] fails ["--quiet"] isVerbosity ["--help","--silent"] Quiet++-- check newtype support+newtype MyInt = MyInt Int deriving (Eq,Show,Data,Typeable)++data Test16 = Test16 {test16a :: MyInt, test16b :: [MyInt]} deriving (Eq,Show,Data,Typeable)++mode16 = cmdArgsMode $ Test16 (MyInt 12) []++test16 = do+ let Tester{..} = tester "Test16" mode16+ [] === Test16 (MyInt 12) []+ fails ["--test16a"]+ ["--test16a=5"] === Test16 (MyInt 5) []+ ["--test16b=5","--test16b=82"] === Test16 (MyInt 12) [MyInt 5, MyInt 82]
cmdargs.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.6 build-type: Simple name: cmdargs-version: 0.6.8+version: 0.6.9 license: BSD3 license-file: LICENSE category: Console@@ -61,7 +61,7 @@ System.Console.CmdArgs.Implicit.Ann System.Console.CmdArgs.Implicit.Global System.Console.CmdArgs.Implicit.Local- System.Console.CmdArgs.Implicit.Read+ System.Console.CmdArgs.Implicit.Reader System.Console.CmdArgs.Implicit.Reform System.Console.CmdArgs.Implicit.Type System.Console.CmdArgs.Implicit.UI