diff options
| -rw-r--r-- | Coalpit.hs | 12 | ||||
| -rw-r--r-- | README.md | 4 | ||||
| -rw-r--r-- | test/Test.hs | 17 |
3 files changed, 21 insertions, 12 deletions
@@ -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 @@ -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 |