summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2017-12-16 07:55:35 +0300
committerdefanor <defanor@uberspace.net>2017-12-16 08:42:20 +0300
commitfa15e16722ece1b429a6f45d6f57d77e528fe825 (patch)
tree38f900588d6613eedbd18d0a7d66fba88569bcb1
parent6ca0662862dffcc67ff4016aaa04cf314d81608e (diff)
downloadcoalpit-fa15e16722ece1b429a6f45d6f57d77e528fe825.zip
coalpit-fa15e16722ece1b429a6f45d6f57d77e528fe825.tar.gz
coalpit-fa15e16722ece1b429a6f45d6f57d77e528fe825.tar.bz2
Refactor
- Unify the naming - Merge all the classes into one
-rw-r--r--Coalpit.hs429
-rw-r--r--Example.hs27
-rw-r--r--coalpit.cabal2
-rw-r--r--test/Test.hs53
4 files changed, 186 insertions, 325 deletions
diff --git a/Coalpit.hs b/Coalpit.hs
index 114181a..381e7be 100644
--- a/Coalpit.hs
+++ b/Coalpit.hs
@@ -13,7 +13,7 @@ scripting-friendly than JSON and similar formats.
== Example
@
-\{\-\# LANGUAGE DeriveGeneric \#\-\}
+\{\-\# LANGUAGE DeriveGeneric, DeriveAnyClass \#\-\}
import GHC.Generics
import Data.Proxy
import System.Environment
@@ -21,10 +21,7 @@ import Coalpit
data Foo = Foo { bar :: Maybe Int
, baz :: String
- } deriving (Generic, Show)
-instance 'ArgParser' Foo
-instance 'ToArgs' Foo
-instance 'ArgHelper' Foo
+ } deriving (Show, Generic, Coalpit)
main :: IO ()
main = do
@@ -63,9 +60,7 @@ Then, in a shell:
module Coalpit (
-- * Core classes
- ArgParser(..)
- , ToArgs(..)
- , ArgHelper(..)
+ Coalpit(..)
-- * Utility functions
, fromArgs
, usage
@@ -150,273 +145,214 @@ data Options = Options { conNameMod :: String -> String
defOpt :: Options
defOpt = Options (map toLower) (("--" ++) . map toLower) False True
-
--- Core classes
-
--- | Arguments parser class.
-class ArgParser a where
+-- | Coalpit class: parsing, printing, usage strings.
+class Coalpit a where
argParser :: Options -> Parser a
- default argParser :: (Generic a, GArgParser (Rep a)) => Options -> Parser a
- argParser o = to <$> gArgParser o
-
-class GArgParser f where
- gArgParser :: Options -> Parser (f a)
-
--- | Parses arguments.
-fromArgs :: ArgParser a => Options -> [String] -> Either String a
-fromArgs o args = case parse (argParser o) "arguments" (map CLArg args) of
- Left err -> Left $ parseErrorPretty err
- Right x -> Right x
+ default argParser :: (Generic a, GCoalpit (Rep a)) => Options -> Parser a
+ argParser opt = to <$> gArgParser opt
--- | Arguments serializer class.
-class ToArgs a where
toArgs :: Options -> a -> [String]
- default toArgs :: (Generic a, GToArgs (Rep a)) => Options -> a -> [String]
- toArgs o a = gToArgs o (from a)
-
-class GToArgs f where
- gToArgs :: Options -> f a -> [String]
+ default toArgs :: (Generic a, GCoalpit (Rep a)) => Options -> a -> [String]
+ toArgs opt a = gToArgs opt (from a)
--- | Helper class.
-class ArgHelper a where
argHelper :: Options -> [String] -> Proxy a -> String
- default argHelper :: (GArgHelper (Rep a))
+ default argHelper :: (GCoalpit (Rep a))
=> Options -> [String] -> Proxy a -> String
- argHelper o path Proxy = gArgHelper o path (Proxy :: Proxy (Rep a f))
+ argHelper opt path Proxy = gArgHelper opt path (Proxy :: Proxy (Rep a p))
-class GArgHelper f where
- gArgHelper :: Options -> [String] -> Proxy (f a) -> String
+class GCoalpit a where
+ gArgParser :: Options -> Parser (a p)
+ gToArgs :: Options -> a p -> [String]
+ gArgHelper :: Options -> [String] -> Proxy (a p) -> String
+
+-- | Parses arguments.
+fromArgs :: Coalpit a => Options -> [String] -> Either String a
+fromArgs opt args = case parse (argParser opt) "arguments" (map CLArg args) of
+ Left err -> Left $ parseErrorPretty err
+ Right x -> Right x
-- | Composes a usage string.
-usage :: ArgHelper a => Options -> Proxy a -> String
-usage o = argHelper o []
+usage :: Coalpit a => Options -> Proxy a -> String
+usage opt = argHelper opt []
--- Units
-instance GArgParser U1 where
+-- Units
+instance GCoalpit U1 where
gArgParser _ = pure U1
-
-instance GToArgs U1 where
gToArgs _ U1 = []
-
-instance GArgHelper U1 where
gArgHelper _ _ (Proxy :: Proxy (U1 f)) = ""
--- Products
-
-instance (GArgParser a, GArgParser b) => GArgParser (a :*: b) where
- gArgParser m = (:*:) <$> gArgParser m <*> gArgParser m
-
-instance (GToArgs a, GToArgs b) => GToArgs (a :*: b) where
- gToArgs m (a :*: b) = gToArgs m a ++ gToArgs m b
-instance (GArgHelper a, GArgHelper b) => GArgHelper (a :*: b) where
- gArgHelper m path (Proxy :: Proxy ((a :*: b) f)) =
- concat [ gArgHelper m path (Proxy :: Proxy (a f))
+-- Products
+instance (GCoalpit a, GCoalpit b) => GCoalpit (a :*: b) where
+ gArgParser opt = (:*:) <$> gArgParser opt <*> gArgParser opt
+ gToArgs opt (x :*: y) = gToArgs opt x ++ gToArgs opt y
+ gArgHelper opt path (Proxy :: Proxy ((a :*: b) p)) =
+ concat [ gArgHelper opt path (Proxy :: Proxy (a p))
, " "
- , gArgHelper m path (Proxy :: Proxy (b f))]
+ , gArgHelper opt path (Proxy :: Proxy (b p))]
-- Sums
-instance (Constructor c1, GArgParser f1, GArgParser (f :+: g)) =>
- GArgParser ((f :+: g) :+: C1 c1 f1) where
- gArgParser m =
- L1 <$> gArgParser m
- <|>
- R1 <$> (pS (string (conNameMod m $ conName (undefined :: C1 c1 f a)))
- *> gArgParser m)
-
-instance (Constructor c1, GArgParser f1, GArgParser (f :+: g)) =>
- GArgParser (C1 c1 f1 :+: (f :+: g)) where
- gArgParser m =
- L1 <$> (pS (string (conNameMod m $ conName (undefined :: C1 c1 f a)))
- *> gArgParser m)
- <|>
- R1 <$> gArgParser m
-
-instance (Constructor c1, Constructor c2, GArgParser f1, GArgParser f2) =>
- GArgParser (C1 c1 f1 :+: C1 c2 f2) where
- gArgParser m =
- L1 <$> (pS (string (conNameMod m $ conName (undefined :: C1 c1 f a)))
- *> gArgParser m)
+instance (Constructor conA, GCoalpit a, GCoalpit (b :+: c)) =>
+ GCoalpit ((b :+: c) :+: C1 conA a) where
+ gArgParser opt =
+ L1 <$> gArgParser opt
<|>
- R1 <$> (pS (string (conNameMod m $ conName (undefined :: C1 c2 f a)))
- *> gArgParser m)
-
-instance (Constructor c1, GToArgs f1, GToArgs (f :+: g)) =>
- GToArgs ((f :+: g) :+: C1 c1 f1) where
- gToArgs m (L1 x) = gToArgs m x
- gToArgs m (R1 x) = conNameMod m (conName x) : gToArgs m x
-
-instance (Constructor c1, GToArgs f1, GToArgs (f :+: g)) =>
- GToArgs (C1 c1 f1 :+: (f :+: g)) where
- gToArgs m (L1 x) = conNameMod m (conName x) : gToArgs m x
- gToArgs m (R1 x) = gToArgs m x
-
-instance (Constructor c1, Constructor c2, GToArgs f1, GToArgs f2) =>
- GToArgs (C1 c1 f1 :+: C1 c2 f2) where
- gToArgs m (L1 x) = conNameMod m (conName x) : gToArgs m x
- gToArgs m (R1 x) = conNameMod m (conName x) : gToArgs m x
-
-spaceNonEmpty :: String -> String
-spaceNonEmpty "" = ""
-spaceNonEmpty s = ' ' : s
-
-instance (Constructor c1, GArgHelper f1, GArgHelper (f :+: g)) =>
- GArgHelper ((f :+: g) :+: C1 c1 f1) where
- gArgHelper m path (Proxy :: Proxy (((f :+: g) :+: C1 c1 f1) p)) =
- let cName1 = conName (undefined :: C1 c1 f a)
+ R1 <$> (pS (string (conNameMod opt $ conName (undefined :: C1 conA a p)))
+ *> gArgParser opt)
+ gToArgs opt (L1 x) = gToArgs opt x
+ gToArgs opt (R1 x) = conNameMod opt (conName x) : gToArgs opt x
+ gArgHelper opt path (Proxy :: Proxy (((b :+: c) :+: C1 conA a) p)) =
+ let nameA = conName (undefined :: C1 conA f p)
in concat [ "("
- , gArgHelper m path (Proxy :: Proxy ((f :+: g) p))
+ , gArgHelper opt path (Proxy :: Proxy ((b :+: c) p))
, " | "
- , conNameMod m cName1
- , if cName1 `elem` path
+ , conNameMod opt nameA
+ , if nameA `elem` path
then "..."
else spaceNonEmpty $
- gArgHelper m (cName1 : path) (Proxy :: Proxy (f1 p))
+ gArgHelper opt (nameA : path) (Proxy :: Proxy (a p))
, ")"]
-instance (Constructor c1, GArgHelper f1, GArgHelper (f :+: g)) =>
- GArgHelper (C1 c1 f1 :+: (f :+: g)) where
- gArgHelper m path (Proxy :: Proxy ((C1 c1 f1 :+: (f :+: g)) p)) =
- let cName1 = conName (undefined :: C1 c1 f a)
+
+instance (Constructor conA, GCoalpit a, GCoalpit (b :+: c)) =>
+ GCoalpit (C1 conA a :+: (b :+: c)) where
+ gArgParser opt =
+ L1 <$> (pS (string (conNameMod opt $ conName (undefined :: C1 conA a p)))
+ *> gArgParser opt)
+ <|>
+ R1 <$> gArgParser opt
+ gToArgs opt (L1 x) = conNameMod opt (conName x) : gToArgs opt x
+ gToArgs opt (R1 x) = gToArgs opt x
+ gArgHelper opt path (Proxy :: Proxy ((C1 conA a :+: (b :+: c)) p)) =
+ let nameA = conName (undefined :: C1 conA a p)
in concat [ "("
- , conNameMod m cName1
- , if cName1 `elem` path
+ , conNameMod opt nameA
+ , if nameA `elem` path
then "..."
else spaceNonEmpty $
- gArgHelper m (cName1 : path) (Proxy :: Proxy (f1 p))
+ gArgHelper opt (nameA : path) (Proxy :: Proxy (a p))
, " | "
- , gArgHelper m path (Proxy :: Proxy ((f :+: g) p))
+ , gArgHelper opt path (Proxy :: Proxy ((b :+: c) p))
, ")"]
-instance (Constructor c1, Constructor c2, GArgHelper f1, GArgHelper f2) =>
- GArgHelper (C1 c1 f1 :+: C1 c2 f2) where
- gArgHelper m path (Proxy :: Proxy ((C1 c1 f1 :+: C1 c2 f2) p)) =
- let cName1 = conName (undefined :: C1 c1 f a)
- cName2 = conName (undefined :: C1 c2 f a)
+instance (Constructor conA, Constructor conB, GCoalpit a, GCoalpit b) =>
+ GCoalpit (C1 conA a :+: C1 conB b) where
+ gArgParser opt =
+ L1 <$> (pS (string (conNameMod opt $
+ conName (undefined :: C1 conA a p)))
+ *> gArgParser opt)
+ <|>
+ R1 <$> (pS (string (conNameMod opt $
+ conName (undefined :: C1 conB b p)))
+ *> gArgParser opt)
+ gToArgs opt (L1 x) = conNameMod opt (conName x) : gToArgs opt x
+ gToArgs opt (R1 x) = conNameMod opt (conName x) : gToArgs opt x
+ gArgHelper opt path (Proxy :: Proxy ((C1 conA a :+: C1 conB b) p)) =
+ let nameA = conName (undefined :: C1 conA a p)
+ nameB = conName (undefined :: C1 conB b p)
in concat [ "("
- , conNameMod m cName1
- , if cName1 `elem` path
+ , conNameMod opt nameA
+ , if nameA `elem` path
then "..."
else spaceNonEmpty $
- gArgHelper m (cName1 : path) (Proxy :: Proxy (f1 p))
+ gArgHelper opt (nameA : path) (Proxy :: Proxy (a p))
, " | "
- , conNameMod m cName2
- , if cName2 `elem` path
+ , conNameMod opt nameB
+ , if nameB `elem` path
then "..."
else spaceNonEmpty $
- gArgHelper m (cName2 : path) (Proxy :: Proxy (f2 p))
+ gArgHelper opt (nameB : path) (Proxy :: Proxy (b p))
, ")"]
+spaceNonEmpty :: String -> String
+spaceNonEmpty "" = ""
+spaceNonEmpty s = ' ' : s
+
-- Record Selectors
-parseS1 :: (GArgParser a) => String -> Options -> Parser (S1 c a f)
-parseS1 n o =
- let sname = case (n, alwaysUseSelName o) of
+parseS1 :: (GCoalpit a) => String -> Options -> Parser (S1 selA a p)
+parseS1 nameA opt =
+ let sName = case (nameA, alwaysUseSelName opt) of
("", _) -> pure ()
(_, False) -> pure ()
- (name, True) -> pS (string (selNameMod o name)) >> pure ()
- in M1 <$> (sname *> gArgParser o)
-
-printS1 :: (GToArgs f, Selector c) => Options -> S1 c f a -> [String]
-printS1 o s@(M1 x) = case (selName s, alwaysUseSelName o) of
- ("", _) -> gToArgs o x
- (_, False) -> gToArgs o x
- (name, True) -> selNameMod o name : gToArgs o x
-
-helpS1 :: (GArgHelper a)
- => String -> Options -> [String] -> Proxy (S1 c a f) -> String
-helpS1 n o path (Proxy :: Proxy ((S1 c a) f)) =
- case (n, alwaysUseSelName o) of
- ("", _) -> gArgHelper o path (Proxy :: Proxy (a f))
- (_, False) -> gArgHelper o path (Proxy :: Proxy (a f))
- (name, True) -> concat [ selNameMod o name
- , " "
- , gArgHelper o path (Proxy :: Proxy (a f))]
-
-instance (GArgParser a, Selector c) => GArgParser (S1 c a) where
- gArgParser = parseS1 (selName (undefined :: S1 c a f))
-
-instance (GToArgs a, Selector c) => GToArgs (S1 c a) where
+ (_, True) -> pS (string (selNameMod opt nameA)) >> pure ()
+ in M1 <$> (sName *> gArgParser opt)
+
+printS1 :: (GCoalpit a, Selector selA) => Options -> S1 selA a p -> [String]
+printS1 opt sel@(M1 x) = case (selName sel, alwaysUseSelName opt) of
+ ("", _) -> gToArgs opt x
+ (_, False) -> gToArgs opt x
+ (name, True) -> selNameMod opt name : gToArgs opt x
+
+helpS1 :: (GCoalpit a)
+ => String -> Options -> [String] -> Proxy (S1 selA a p) -> String
+helpS1 nameA opt path (Proxy :: Proxy (S1 selA a p)) =
+ case (nameA, alwaysUseSelName opt) of
+ ("", _) -> gArgHelper opt path (Proxy :: Proxy (a p))
+ (_, False) -> gArgHelper opt path (Proxy :: Proxy (a p))
+ (_, True) -> concat [ selNameMod opt nameA
+ , " "
+ , gArgHelper opt path (Proxy :: Proxy (a p))]
+
+instance (GCoalpit a, Selector selA) => GCoalpit (S1 selA a) where
+ gArgParser = parseS1 (selName (undefined :: S1 selA a p))
gToArgs = printS1
-
-instance (GArgHelper a, Selector c) => GArgHelper (S1 c a) where
- gArgHelper = helpS1 (selName (undefined :: S1 c a f))
-
+ gArgHelper = helpS1 (selName (undefined :: S1 selA a p))
-- Optional arguments
-
instance {-#OVERLAPPING#-}
- (ArgParser a, Selector c) => GArgParser (S1 c (Rec0 (Maybe a))) where
- gArgParser m =
- let n = selName (undefined :: S1 c (Rec0 (Maybe a)) f)
- in case (omitNamedOptions m, null n) of
- (True, True) -> M1 <$> gArgParser m
+ (Coalpit a, Selector selA) => GCoalpit (S1 selA (Rec0 (Maybe a))) where
+ gArgParser opt =
+ let nameA = selName (undefined :: S1 selA (Rec0 (Maybe a)) p)
+ in case (omitNamedOptions opt, null nameA) of
+ (True, True) -> M1 <$> gArgParser opt
(True, False) ->
- M1 . K1 <$> optional (pS (string (selNameMod m n)) *> argParser m)
- _ -> parseS1 n m
-
-instance {-#OVERLAPPING#-}
- (ToArgs a, Selector c) => GToArgs (S1 c (Rec0 (Maybe a))) where
- gToArgs m s@(M1 (K1 x))
- | omitNamedOptions m = case (selName s, x) of
- ("", _) -> toArgs m x
+ M1 . K1
+ <$> optional (pS (string (selNameMod opt nameA)) *> argParser opt)
+ _ -> parseS1 nameA opt
+ gToArgs opt sel@(M1 (K1 x))
+ | omitNamedOptions opt = case (selName sel, x) of
+ ("", _) -> toArgs opt x
(_, Nothing) -> []
- (name, Just x') -> selNameMod m name : toArgs m x'
- | otherwise = printS1 m s
-
-instance {-#OVERLAPPING#-}
- (ArgHelper a, Selector c) => GArgHelper (S1 c (Rec0 (Maybe a))) where
- gArgHelper m path (Proxy :: Proxy (S1 c (Rec0 (Maybe a)) f)) =
- let n = selName (undefined :: S1 c (Rec0 (Maybe a)) f)
- in case (omitNamedOptions m, null n) of
- (True, True) -> gArgHelper m path (Proxy :: Proxy (Rec0 (Maybe a) f))
+ (nameA, Just x') -> selNameMod opt nameA : toArgs opt x'
+ | otherwise = printS1 opt sel
+ gArgHelper opt path (Proxy :: Proxy (S1 selA (Rec0 (Maybe a)) p)) =
+ let nameA = selName (undefined :: S1 selA (Rec0 (Maybe a)) p)
+ in case (omitNamedOptions opt, null nameA) of
+ (True, True) -> gArgHelper opt path (Proxy :: Proxy (Rec0 (Maybe a) p))
(True, False) -> concat [ "["
- , selNameMod m n
+ , selNameMod opt nameA
, " "
- , gArgHelper m path (Proxy :: Proxy (Rec0 a f))
+ , gArgHelper opt path (Proxy :: Proxy (Rec0 a p))
, "]"]
- _ -> helpS1 n m path (Proxy :: Proxy (S1 c (Rec0 (Maybe a)) f))
+ _ -> helpS1 nameA opt path (Proxy :: Proxy (S1 selA (Rec0 (Maybe a)) p))
-- Constructors
-instance (GArgParser a) => GArgParser (C1 c a) where
- gArgParser m = M1 <$> gArgParser m
-
-instance (GToArgs a) => GToArgs (C1 c a) where
- gToArgs m (M1 x) = gToArgs m x
-
-instance (GArgHelper a) => GArgHelper (C1 c a) where
- gArgHelper m path (Proxy :: Proxy (C1 c a f)) =
- gArgHelper m path (Proxy :: Proxy (a f))
+instance (GCoalpit a) => GCoalpit (C1 conA a) where
+ gArgParser = fmap M1 . gArgParser
+ gToArgs opt (M1 x) = gToArgs opt x
+ gArgHelper opt path (Proxy :: Proxy (C1 conA a p)) =
+ gArgHelper opt path (Proxy :: Proxy (a p))
-- Data types
-
-instance (GArgParser a) => GArgParser (D1 c a) where
- gArgParser m = M1 <$> gArgParser m
-
-instance (GToArgs a) => GToArgs (D1 c a) where
- gToArgs m (M1 x) = gToArgs m x
-
-instance (GArgHelper a) => GArgHelper (D1 c a) where
- gArgHelper m path (Proxy :: Proxy (D1 c a f)) =
- gArgHelper m path (Proxy :: Proxy (a f))
+instance (GCoalpit a) => GCoalpit (D1 conA a) where
+ gArgParser = fmap M1 . gArgParser
+ gToArgs opt (M1 x) = gToArgs opt x
+ gArgHelper opt path (Proxy :: Proxy (D1 conA a p)) =
+ gArgHelper opt path (Proxy :: Proxy (a p))
-- Constraints and such
-
-instance (ArgParser a) => GArgParser (K1 i a) where
- gArgParser m = K1 <$> argParser m
-
-instance (ToArgs a) => GToArgs (K1 i a) where
- gToArgs m (K1 x) = toArgs m x
-
-instance (ArgHelper a) => GArgHelper (K1 i a) where
- gArgHelper m path (Proxy :: Proxy (K1 x a f)) =
- argHelper m path (Proxy :: Proxy a)
+instance (Coalpit a) => GCoalpit (K1 i a) where
+ gArgParser = fmap K1 . argParser
+ gToArgs opt (K1 x) = toArgs opt x
+ gArgHelper opt path (Proxy :: Proxy (K1 x a p)) =
+ argHelper opt path (Proxy :: Proxy a)
-- Common types
@@ -429,83 +365,42 @@ readArg = do
[(n, "")] -> pure n
_ -> fail $ "Failed to read: " ++ x
-instance ArgParser Int where
+instance Coalpit Int where
argParser _ = readArg
-instance ToArgs Int where
toArgs _ i = [show i]
-instance ArgHelper Int where
argHelper _ _ _ = "INT"
-instance ArgParser Integer where
+instance Coalpit Integer where
argParser _ = readArg
-instance ToArgs Integer where
toArgs _ i = [show i]
-instance ArgHelper Integer where
argHelper _ _ _ = "INTEGER"
-instance ArgParser Rational where
+instance Coalpit Rational where
argParser _ = readArg
-instance ToArgs Rational where
toArgs _ i = [show i]
-instance ArgHelper Rational where
argHelper _ _ _ = "RATIONAL"
-instance ArgParser Double where
+instance Coalpit Double where
argParser _ = readArg
-instance ToArgs Double where
toArgs _ i = [show i]
-instance ArgHelper Double where
argHelper _ _ _ = "DOUBLE"
-instance {-#OVERLAPPING#-} ArgParser String where
+instance {-#OVERLAPPING#-} Coalpit String where
argParser _ = token (Right . unArg) Nothing
-instance {-#OVERLAPPING#-} ToArgs String where
toArgs _ i = [i]
-instance {-#OVERLAPPING#-} ArgHelper String where
argHelper _ _ _ = "STRING"
-instance ArgParser Bool
-instance ToArgs Bool
-instance ArgHelper Bool
-
-instance ArgParser a => ArgParser (Maybe a)
-instance ToArgs a => ToArgs (Maybe a)
-instance ArgHelper a => ArgHelper (Maybe a)
-
-instance ArgParser a => ArgParser [a]
-instance ToArgs a => ToArgs [a]
-instance ArgHelper a => ArgHelper [a]
-
-instance (ArgParser a, ArgParser b) => ArgParser (Either a b)
-instance (ToArgs a, ToArgs b) => ToArgs (Either a b)
-instance (ArgHelper a, ArgHelper b) => ArgHelper (Either a b)
-
--- | Expects a dot.
-instance ArgParser () where
+instance Coalpit () where
argParser _ = pS (char '.') *> pure ()
--- | Shows a dot.
-instance ToArgs () where
toArgs _ () = ["."]
-instance ArgHelper () where
argHelper _ _ _ = "."
-instance (ArgParser a, ArgParser b) => ArgParser (a, b)
-instance (ToArgs a, ToArgs b) => ToArgs (a, b)
-instance (ArgHelper a, ArgHelper b) => ArgHelper (a, b)
-
-instance (ArgParser a, ArgParser b, ArgParser c) => ArgParser (a, b, c)
-instance (ToArgs a, ToArgs b, ToArgs c) => ToArgs (a, b, c)
-instance (ArgHelper a, ArgHelper b, ArgHelper c) => ArgHelper (a, b, c)
-
-instance (ArgParser a, ArgParser b, ArgParser c, ArgParser d) =>
- ArgParser (a, b, c, d)
-instance (ToArgs a, ToArgs b, ToArgs c, ToArgs d) => ToArgs (a, b, c, d)
-instance (ArgHelper a, ArgHelper b, ArgHelper c, ArgHelper d) =>
- ArgHelper (a, b, c, d)
-
-instance (ArgParser a, ArgParser b, ArgParser c, ArgParser d, ArgParser e) =>
- ArgParser (a, b, c, d, e)
-instance (ToArgs a, ToArgs b, ToArgs c, ToArgs d, ToArgs e) =>
- ToArgs (a, b, c, d, e)
-instance (ArgHelper a, ArgHelper b, ArgHelper c, ArgHelper d, ArgHelper e) =>
- ArgHelper (a, b, c, d, e)
+instance Coalpit Bool
+instance Coalpit a => Coalpit (Maybe a)
+instance Coalpit a => Coalpit [a]
+instance (Coalpit a, Coalpit b) => Coalpit (Either a b)
+instance (Coalpit a, Coalpit b) => Coalpit (a, b)
+instance (Coalpit a, Coalpit b, Coalpit c) => Coalpit (a, b, c)
+instance (Coalpit a, Coalpit b, Coalpit c, Coalpit d) => Coalpit (a, b, c, d)
+instance (Coalpit a, Coalpit b, Coalpit c, Coalpit d, Coalpit e) =>
+ Coalpit (a, b, c, d, e)
diff --git a/Example.hs b/Example.hs
index a1af925..9fb9e0b 100644
--- a/Example.hs
+++ b/Example.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
module Main where
import GHC.Generics
@@ -7,25 +7,16 @@ import Data.Proxy
data FooArgs = FooArgs { arg1 :: Int
, arg2 :: String
- } deriving (Generic, Show)
-instance ArgParser FooArgs
-instance ToArgs FooArgs
-instance ArgHelper FooArgs
+ } deriving (Show, Generic, Coalpit)
data FooBar = Foo FooArgs
| Bar
- deriving (Generic, Show)
-instance ArgParser FooBar
-instance ToArgs FooBar
-instance ArgHelper FooBar
+ deriving (Show, Generic, Coalpit)
data Input = Input { something :: Maybe String
, fooBar :: Maybe FooBar
, fooBar2 :: FooBar
- } deriving (Generic, Show)
-instance ArgParser Input
-instance ToArgs Input
-instance ArgHelper Input
+ } deriving (Show, Generic, Coalpit)
main :: IO ()
main = do
@@ -39,18 +30,16 @@ main = do
print (fromArgs defOpt args :: Either String Input)
data Test = Test { foo :: [Int], bar :: Maybe String }
- deriving (Generic, Show)
-
-instance ArgParser Test
-instance ToArgs Test
-instance ArgHelper Test
+ deriving (Show, Generic, Coalpit)
help :: IO ()
help = do
mapM_ (\(o, x, y) -> print o >> print x >> putStrLn y) $
[ let opts = defOpt { alwaysUseSelName = ausn
, omitNamedOptions = ono }
- in ((ausn, ono), toArgs opts (Test [] vals), argHelper opts [] (Proxy :: Proxy Test))
+ in ( (ausn, ono)
+ , toArgs opts (Test [] vals)
+ , argHelper opts [] (Proxy :: Proxy Test))
| ausn <- [True, False]
, ono <- [True, False]
, vals <- [Just "a string", Nothing]]
diff --git a/coalpit.cabal b/coalpit.cabal
index de4b26c..b093652 100644
--- a/coalpit.cabal
+++ b/coalpit.cabal
@@ -1,5 +1,5 @@
name: coalpit
-version: 0.1.0.1
+version: 0.1.0.2
synopsis: Command-line options parsing and printing
description: This library generates parsers and printers for given
data types, in the form of command-line arguments -- so
diff --git a/test/Test.hs b/test/Test.hs
index ffcae8e..9b92993 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
import GHC.Generics
import Generic.Random
@@ -11,15 +11,11 @@ import Coalpit
data Basic = Basic Int String Double
- deriving (Generic, Eq, Show)
-instance ArgParser Basic
-instance ToArgs Basic
+ deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary Basic where arbitrary = genericArbitraryU
data WithLists = WithLists [Int] [String] [Double]
- deriving (Generic, Eq, Show)
-instance ArgParser WithLists
-instance ToArgs WithLists
+ deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary WithLists where arbitrary = genericArbitraryU
data Record = Record { maybeInt :: Maybe Int
@@ -28,62 +24,47 @@ data Record = Record { maybeInt :: Maybe Int
, listOfStrings :: [String]
, maybeListOfNumbers :: Maybe [Integer]
, otherString :: String
- } deriving (Generic, Eq, Show)
-instance ArgParser Record
-instance ToArgs Record
+ } deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary Record where arbitrary = genericArbitraryU
data Sum = Foo Int Bool
| Bar
| Baz (String, (Double, Integer), Rational)
- deriving (Generic, Eq, Show)
-instance ArgParser Sum
-instance ToArgs Sum
+ deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary Sum where arbitrary = genericArbitraryU
data Nested = Nested Record Basic WithLists Sum
- deriving (Generic, Eq, Show)
-instance ArgParser Nested
-instance ToArgs Nested
+ deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary Nested where arbitrary = genericArbitraryU
data Polymorphic a b = Polymorphic (Maybe a) [b] (Either a b)
deriving (Generic, Eq, Show)
-instance (ArgParser a, ArgParser b) => ArgParser (Polymorphic a b)
-instance (ToArgs a, ToArgs b) => ToArgs (Polymorphic a b)
+instance (Coalpit a, Coalpit b) => Coalpit (Polymorphic a b)
instance (Arbitrary a, Arbitrary b) => Arbitrary (Polymorphic a b) where
arbitrary = genericArbitraryU
data Recursive = RecursiveA
| RecursiveB Recursive
- deriving (Generic, Eq, Show)
-instance ArgParser Recursive
-instance ToArgs Recursive
+ deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary Recursive where arbitrary = genericArbitraryU
data NestedRecord = NestedRecord { record1 :: Maybe Record
, record2 :: Maybe Record
, record3 :: Maybe Record
- } deriving (Generic, Eq, Show)
-instance ArgParser NestedRecord
-instance ToArgs NestedRecord
+ } deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary NestedRecord where arbitrary = genericArbitraryU
data NestedSum = NestedFoo Record
| NestedBar Sum Basic Nested
| NestedBaz (Polymorphic Int Double)
- deriving (Generic, Eq, Show)
-instance ArgParser NestedSum
-instance ToArgs NestedSum
+ deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary NestedSum where arbitrary = genericArbitraryU
data RecursiveRecordMaybe = RecursiveRecordMaybe
{ rrm :: Maybe RecursiveRecordMaybe
, record :: Maybe Record
, guard :: ()
- } deriving (Generic, Eq, Show)
-instance ArgParser RecursiveRecordMaybe
-instance ToArgs RecursiveRecordMaybe
+ } deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary RecursiveRecordMaybe where arbitrary = genericArbitraryU
data RecursiveRecordMaybe2 = RecursiveRecordMaybe2
@@ -91,25 +72,21 @@ data RecursiveRecordMaybe2 = RecursiveRecordMaybe2
, rrm' :: Maybe RecursiveRecordMaybe2
, record2' :: Maybe Record
, guard' :: ()
- } deriving (Generic, Eq, Show)
-instance ArgParser RecursiveRecordMaybe2
-instance ToArgs RecursiveRecordMaybe2
+ } deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary RecursiveRecordMaybe2 where arbitrary = genericArbitraryU
data RecordStrings = RecordStrings
{ s1 :: String
, s2 :: String
, s3 :: String
- } deriving (Generic, Eq, Show)
-instance ArgParser RecordStrings
-instance ToArgs RecordStrings
+ } deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary RecordStrings where arbitrary = genericArbitraryU
-printAndParse :: (ArgParser a, ToArgs a, Eq a)
+printAndParse :: (Coalpit a, Eq a)
=> Options -> Proxy a -> a -> Bool
printAndParse m _ r = Right r == fromArgs m (toArgs m r)
-mkTest :: (ArgParser a, ToArgs a, Eq a, Show a, Arbitrary a)
+mkTest :: (Coalpit a, Eq a, Show a, Arbitrary a)
=> Options -> Proxy a -> String -> TestTree
mkTest m p n = QC.testProperty n (printAndParse m p)