From 95c890dbcd07b7355399e122191a362714cd52b9 Mon Sep 17 00:00:00 2001
From: defanor <defanor@uberspace.net>
Date: Mon, 4 Dec 2017 06:57:25 +0300
Subject: Make record selectors for mandatory arguments optional

---
 Coalpit.hs   | 15 ++++++++++-----
 README.md    | 12 ++++++++++--
 test/Test.hs | 58 +++++++++++++++++++++++++++++++++++-----------------------
 3 files changed, 55 insertions(+), 30 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
diff --git a/README.md b/README.md
index 6992749..27c0bd1 100644
--- a/README.md
+++ b/README.md
@@ -32,14 +32,22 @@ Input { something = Nothing
       , fooBar2 = Bar}
 ```
 
-Its serialized version should look like this:
+With the default modifiers, its serialized version should look like
+this:
 
 ```haskell
-["--foobar","foo","--arg1","1","--arg2","a string","--foobar2","bar"]
+["--foobar","foo","1","a string","bar"]
 ```
 
 What would look like this in a shell:
 
+```sh
+--foobar foo 1 'a string' bar
+```
+
+A more verbose version can be produced with `alwaysAddSelName = True`,
+while parsing would accept either version:
+
 ```sh
 --foobar foo --arg1 1 --arg2 'a string' --foobar2 bar
 ```
diff --git a/test/Test.hs b/test/Test.hs
index 4589f04..a467ceb 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -98,32 +98,44 @@ instance Arbitrary RecursiveRecordMaybe2 where arbitrary = genericArbitraryU
 
 
 printAndParse :: (ArgParser a, ToArgs a, Eq a)
-              => Proxy a -> a -> Bool
-printAndParse _ r = Right r == fromArgs defMod (toArgs defMod r)
+              => Modifiers -> Proxy a -> a -> Bool
+printAndParse m _ r = Right r == fromArgs m (toArgs m r)
 
 mkTest :: (ArgParser a, ToArgs a, Eq a, Show a, Arbitrary a)
-       => Proxy a -> String -> TestTree
-mkTest p n = QC.testProperty ("id == parse . print for " ++ n) (printAndParse p)
-
-main :: IO ()
-main = travisTestReporter defaultConfig [] qcProps
-
-qcProps :: TestTree
-qcProps = testGroup "Quickcheck properties"
-  [ mkTest (Proxy :: Proxy Basic) "Basic"
-  , mkTest (Proxy :: Proxy WithLists) "WithLists"
-  , mkTest (Proxy :: Proxy Record) "Record"
-  , mkTest (Proxy :: Proxy Sum) "Sum"
-  , mkTest (Proxy :: Proxy Nested) "Nested"
-  , mkTest (Proxy :: Proxy (Polymorphic Int Double))
+       => Modifiers -> Proxy a -> String -> TestTree
+mkTest m p n = QC.testProperty n (printAndParse m p)
+
+idEqToAndFrom :: Modifiers -> TestTree
+idEqToAndFrom m = testGroup "id == parse . print"
+  [ mkTest m (Proxy :: Proxy Basic) "Basic"
+  , mkTest m (Proxy :: Proxy WithLists) "WithLists"
+  , mkTest m (Proxy :: Proxy Record) "Record"
+  , mkTest m (Proxy :: Proxy Sum) "Sum"
+  , mkTest m (Proxy :: Proxy Nested) "Nested"
+  , mkTest m (Proxy :: Proxy (Polymorphic Int Double))
     "Polymorphic Int Double"
-  , mkTest (Proxy :: Proxy (Polymorphic Basic Record))
+  , mkTest m (Proxy :: Proxy (Polymorphic Basic Record))
     "Polymorphic Basic Record"
-  , mkTest (Proxy :: Proxy (Polymorphic Nested (Polymorphic Basic Sum)))
+  , mkTest m (Proxy :: Proxy (Polymorphic Nested (Polymorphic Basic Sum)))
     "Polymorphic Nested (Polymorphic Basic Sum)"
-  , mkTest (Proxy :: Proxy Recursive) "Recursive"
-  , mkTest (Proxy :: Proxy NestedRecord) "NestedRecord"
-  , mkTest (Proxy :: Proxy NestedSum) "NestedSum"
-  , mkTest (Proxy :: Proxy RecursiveRecordMaybe) "RecursiveRecordMaybe"
-  , mkTest (Proxy :: Proxy RecursiveRecordMaybe2) "RecursiveRecordMaybe2"
+  , mkTest m (Proxy :: Proxy Recursive) "Recursive"
+  , mkTest m (Proxy :: Proxy NestedRecord) "NestedRecord"
+  , mkTest m (Proxy :: Proxy NestedSum) "NestedSum"
+  , mkTest m (Proxy :: Proxy RecursiveRecordMaybe) "RecursiveRecordMaybe"
+  , mkTest m (Proxy :: Proxy RecursiveRecordMaybe2) "RecursiveRecordMaybe2"
+  ]
+
+variousModifiers :: (Modifiers -> TestTree) -> TestTree
+variousModifiers tt = testGroup "Various modifiers"
+  [ testGroup "alwaysAddSelName = True"
+    [tt defMod { alwaysAddSelName = True }]
+  , testGroup "alwaysAddSelName = False"
+    [tt defMod { alwaysAddSelName = False }]
   ]
+
+qcProps :: TestTree
+qcProps = testGroup "Quickcheck properties"
+  [ variousModifiers idEqToAndFrom ]
+
+main :: IO ()
+main = travisTestReporter defaultConfig [] qcProps
-- 
cgit v1.2.3