From 95c890dbcd07b7355399e122191a362714cd52b9 Mon Sep 17 00:00:00 2001 From: defanor Date: Mon, 4 Dec 2017 06:57:25 +0300 Subject: Make record selectors for mandatory arguments optional --- Coalpit.hs | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) (limited to 'Coalpit.hs') diff --git a/Coalpit.hs b/Coalpit.hs index d05cc7c..99eb1f9 100644 --- a/Coalpit.hs +++ b/Coalpit.hs @@ -87,11 +87,14 @@ data Modifiers = Modifiers { conNameMod :: String -> String -- ^ Constructor name modifier. , selNameMod :: String -> String -- ^ Record selector name modifier. + , alwaysAddSelName :: Bool + -- ^ Add record selector name always, not + -- just for optional arguments. } -- | Default modifiers. defMod :: Modifiers -defMod = Modifiers (map toLower) (("--" ++) . map toLower) +defMod = Modifiers (map toLower) (("--" ++) . map toLower) False -- Core classes @@ -188,13 +191,15 @@ instance (GArgParser a, Selector c) => GArgParser (S1 c a) where gArgParser m = M1 <$> do let sname = case selName (undefined :: S1 c a f) of "" -> pure () - name -> pS (string (selNameMod m name) >> pure ()) + name -> optional (pS (string (selNameMod m name))) + >> pure () sname *> gArgParser m instance (GToArgs a, Selector c) => GToArgs (S1 c a) where - gToArgs m s@(M1 x) = case selName s of - "" -> gToArgs m x - name -> selNameMod m name : gToArgs m x + gToArgs m s@(M1 x) = case (selName s, alwaysAddSelName m) of + ("", _) -> gToArgs m x + (_, False) -> gToArgs m x + (name, True) -> selNameMod m name : gToArgs m x -- Optional arguments -- cgit v1.2.3