summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Coalpit.hs12
-rw-r--r--README.md4
-rw-r--r--test/Test.hs17
3 files changed, 21 insertions, 12 deletions
diff --git a/Coalpit.hs b/Coalpit.hs
index 99eb1f9..246f036 100644
--- a/Coalpit.hs
+++ b/Coalpit.hs
@@ -87,7 +87,7 @@ data Modifiers = Modifiers { conNameMod :: String -> String
-- ^ Constructor name modifier.
, selNameMod :: String -> String
-- ^ Record selector name modifier.
- , alwaysAddSelName :: Bool
+ , alwaysUseSelName :: Bool
-- ^ Add record selector name always, not
-- just for optional arguments.
}
@@ -189,14 +189,14 @@ instance (Constructor c1, Constructor c2, GToArgs f1, GToArgs f2) =>
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 -> optional (pS (string (selNameMod m name)))
- >> pure ()
+ let sname = case (selName (undefined :: S1 c a f), alwaysUseSelName m) of
+ ("", _) -> pure ()
+ (_, False) -> pure ()
+ (name, True) -> 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, alwaysAddSelName m) of
+ gToArgs m s@(M1 x) = case (selName s, alwaysUseSelName m) of
("", _) -> gToArgs m x
(_, False) -> gToArgs m x
(name, True) -> selNameMod m name : gToArgs m x
diff --git a/README.md b/README.md
index 27c0bd1..898bb9e 100644
--- a/README.md
+++ b/README.md
@@ -45,8 +45,8 @@ What would look like this in a shell:
--foobar foo 1 'a string' bar
```
-A more verbose version can be produced with `alwaysAddSelName = True`,
-while parsing would accept either version:
+A more verbose version can be produced and parsed with
+`alwaysUseSelName = True`:
```sh
--foobar foo --arg1 1 --arg2 'a string' --foobar2 bar
diff --git a/test/Test.hs b/test/Test.hs
index a467ceb..d5860d4 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -96,6 +96,14 @@ instance ArgParser RecursiveRecordMaybe2
instance ToArgs RecursiveRecordMaybe2
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
+instance Arbitrary RecordStrings where arbitrary = genericArbitraryU
printAndParse :: (ArgParser a, ToArgs a, Eq a)
=> Modifiers -> Proxy a -> a -> Bool
@@ -123,14 +131,15 @@ idEqToAndFrom m = testGroup "id == parse . print"
, mkTest m (Proxy :: Proxy NestedSum) "NestedSum"
, mkTest m (Proxy :: Proxy RecursiveRecordMaybe) "RecursiveRecordMaybe"
, mkTest m (Proxy :: Proxy RecursiveRecordMaybe2) "RecursiveRecordMaybe2"
+ , mkTest m (Proxy :: Proxy RecordStrings) "RecordStrings"
]
variousModifiers :: (Modifiers -> TestTree) -> TestTree
variousModifiers tt = testGroup "Various modifiers"
- [ testGroup "alwaysAddSelName = True"
- [tt defMod { alwaysAddSelName = True }]
- , testGroup "alwaysAddSelName = False"
- [tt defMod { alwaysAddSelName = False }]
+ [ testGroup "alwaysUseSelName = True"
+ [tt defMod { alwaysUseSelName = True }]
+ , testGroup "alwaysUseSelName = False"
+ [tt defMod { alwaysUseSelName = False }]
]
qcProps :: TestTree