summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2017-12-04 06:57:25 +0300
committerdefanor <defanor@uberspace.net>2017-12-04 06:57:25 +0300
commit95c890dbcd07b7355399e122191a362714cd52b9 (patch)
tree26e8ccdb3f9f2537a76b82d80a945f4b5e8adc09
parent8218779504205227f0ea70d0c91270ff504d67a6 (diff)
downloadcoalpit-95c890dbcd07b7355399e122191a362714cd52b9.zip
coalpit-95c890dbcd07b7355399e122191a362714cd52b9.tar.gz
coalpit-95c890dbcd07b7355399e122191a362714cd52b9.tar.bz2
Make record selectors for mandatory arguments optional
-rw-r--r--Coalpit.hs15
-rw-r--r--README.md12
-rw-r--r--test/Test.hs58
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