summaryrefslogtreecommitdiff
path: root/Coalpit.hs
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2017-12-04 06:57:25 +0300
committerdefanor <defanor@uberspace.net>2017-12-04 06:57:25 +0300
commit95c890dbcd07b7355399e122191a362714cd52b9 (patch)
tree26e8ccdb3f9f2537a76b82d80a945f4b5e8adc09 /Coalpit.hs
parent8218779504205227f0ea70d0c91270ff504d67a6 (diff)
Make record selectors for mandatory arguments optional
Diffstat (limited to 'Coalpit.hs')
-rw-r--r--Coalpit.hs15
1 files changed, 10 insertions, 5 deletions
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