diff options
-rw-r--r-- | Coalpit.hs | 19 | ||||
-rw-r--r-- | Example.hs | 6 |
2 files changed, 22 insertions, 3 deletions
@@ -11,6 +11,7 @@ import Data.List import GHC.Generics import Text.Megaparsec import Text.Megaparsec.Char +import Data.Maybe type Parser = Parsec String String @@ -53,6 +54,15 @@ instance (GToArgs a, GToArgs b) => GToArgs (a :+: b) where gToArgs c@(L1 x) = gToArgs x gToArgs c@(R1 x) = gToArgs x +instance {-#OVERLAPPING#-} + (ArgParser a, Selector c) => GArgParser (S1 c (Rec0 (Maybe a))) where + gArgParser = do + case selName (undefined :: S1 c (Rec0 (Maybe a)) f) of + "" -> M1 <$> gArgParser + name -> do + x <- optional $ string ("--" ++ name) *> space *> argParser + pure $ M1 $ K1 x + instance (GArgParser a, Selector c) => GArgParser (S1 c a) where gArgParser = M1 <$> do let sname = case selName (undefined :: S1 c a f) of @@ -61,6 +71,13 @@ instance (GArgParser a, Selector c) => GArgParser (S1 c a) where sname *> gArgParser -- record selectors +instance {-#OVERLAPPING#-} + (ToArgs a, Selector c) => GToArgs (S1 c (Rec0 (Maybe a))) where + gToArgs s@(M1 (K1 x)) = case (selName s, x) of + ("", _) -> toArgs x + (_, Nothing) -> [] + (name, Just x') -> ("--" ++ selName s) : toArgs x' + instance (GToArgs a, Selector c) => GToArgs (S1 c a) where gToArgs s@(M1 x) = case selName s of "" -> gToArgs x @@ -104,3 +121,5 @@ instance ArgParser Double where instance ToArgs Double where toArgs i = [show i] +instance ArgParser a => ArgParser (Maybe a) +instance ToArgs a => ToArgs (Maybe a) @@ -6,7 +6,7 @@ import GHC.Generics import Text.Megaparsec import Coalpit -data RecTest = RecTest { a :: Int, b :: Double } +data RecTest = RecTest { a :: Maybe Int, b :: Maybe Double, c :: Maybe Int } deriving (Generic, Show) instance ArgParser RecTest @@ -14,7 +14,7 @@ instance ToArgs RecTest data Foo = Bar Int | Baz Int - | Qux RecTest + | Qux (Maybe Int) (Maybe Int) RecTest (Maybe Double) deriving (Generic, Show) instance ToArgs Foo @@ -22,7 +22,7 @@ instance ArgParser Foo main :: IO () main = do - let val = Qux (RecTest 1 2.3) + let val = Qux Nothing (Just 1) (RecTest Nothing (Just 2.3) Nothing) Nothing a = args val print val putStrLn a |