From 967ae182b0a6852cc37e77cb88ee53a53526f027 Mon Sep 17 00:00:00 2001
From: defanor <defanor@uberspace.net>
Date: Mon, 4 Dec 2017 07:28:42 +0300
Subject: Be more strict on record selector name parsing

Ambiguity is possible if the parser accepts those optionally, so it
should accept them depending on the provided options.
---
 Coalpit.hs   | 12 ++++++------
 README.md    |  4 ++--
 test/Test.hs | 17 +++++++++++++----
 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
-- 
cgit v1.2.3