diff options
author | defanor <defanor@uberspace.net> | 2017-12-04 06:57:25 +0300 |
---|---|---|
committer | defanor <defanor@uberspace.net> | 2017-12-04 06:57:25 +0300 |
commit | 95c890dbcd07b7355399e122191a362714cd52b9 (patch) | |
tree | 26e8ccdb3f9f2537a76b82d80a945f4b5e8adc09 /Coalpit.hs | |
parent | 8218779504205227f0ea70d0c91270ff504d67a6 (diff) |
Make record selectors for mandatory arguments optional
Diffstat (limited to 'Coalpit.hs')
-rw-r--r-- | Coalpit.hs | 15 |
1 files changed, 10 insertions, 5 deletions
@@ -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 |