summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Coalpit.hs28
-rw-r--r--Example.hs4
-rw-r--r--README.md21
-rw-r--r--coalpit.cabal13
-rw-r--r--test/Test.hs76
5 files changed, 88 insertions, 54 deletions
diff --git a/Coalpit.hs b/Coalpit.hs
index 42fb1ae..a0a7ac2 100644
--- a/Coalpit.hs
+++ b/Coalpit.hs
@@ -1,5 +1,5 @@
{- |
-Description : Command-line options parsing and printing
+Description : Command-line options and DSV parsing and printing
Maintainer : defanor <defanor@uberspace.net>
Stability : unstable
Portability : non-portable (uses GHC extensions)
@@ -33,6 +33,8 @@ main = do
Right x -> do
print (x :: Foo)
print $ 'toArgs' 'defOpt' x
+ putStr $ 'showDSV' 'defOpt' [x]
+ print ('readDSV' 'defOpt' $ 'showDSV' 'defOpt' [x] :: [Either String Foo])
@
Then, in a shell:
@@ -40,9 +42,13 @@ Then, in a shell:
> $ ./Example 'a string'
> Foo {bar = Nothing, baz = "a string"}
> ["a string"]
+> "a string"
+> [Right (Foo {bar = Nothing, baz = "a string"})]
> $ ./Example --bar 42 'a string'
> Foo {bar = Just 42, baz = "a string"}
> ["--bar","42","a string"]
+> --bar 42 "a string"
+> [Right (Foo {bar = Just 42, baz = "a string"})]
> $ ./Example --bar foo
> arguments:1:3:
> Failed to read: foo
@@ -64,6 +70,8 @@ module Coalpit (
-- * Utility functions
, fromArgs
, usage
+ , showDSV
+ , readDSV
-- * Options
, Options(..)
, defOpt
@@ -91,10 +99,14 @@ import System.Exit (ExitCode)
import Network.URI (URI, parseURIReference, uriToString)
import Coalpit.Parsing
+import Coalpit.DSV
-- | Printing and parsing options.
-data Options = Options { conNameMod :: String -> String
+data Options = Options { fieldSeparator :: Char
+ -- ^ DSV field separator ('showDSV',
+ -- 'readDSV').
+ , conNameMod :: String -> String
-- ^ Constructor name modifier.
, selNameMod :: String -> String
-- ^ Record selector name modifier.
@@ -112,12 +124,12 @@ data Options = Options { conNameMod :: String -> String
, scientificFormat :: FPFormat
, scientificDecimals :: Maybe Int
, uriUserInfo :: String -> String
- -- ^ Used to map the userinfo part of the URI.
+ -- ^ Used to map userinfo parts of URIs.
}
-- | Default options.
defOpt :: Options
-defOpt = Options (map toLower) (("--" ++) . map toLower) False True
+defOpt = Options ' ' (map toLower) (("--" ++) . map toLower) False True
defaultTimeLocale (iso8601DateFormat Nothing) "%H:%M:%S"
(iso8601DateFormat (Just "%H:%M:%S")) Generic Nothing id
@@ -151,6 +163,14 @@ fromArgs opt args = case parse (argParser opt) "arguments" (map CLArg args) of
usage :: Coalpit a => Options -> Proxy a -> String
usage opt = argHelper opt []
+-- | Shows values in DSV format.
+showDSV :: Coalpit a => Options -> [a] -> String
+showDSV opt = composeDSV (fieldSeparator opt) . map (toArgs opt)
+
+-- | Reads values from DSV format.
+readDSV :: Coalpit a => Options -> String -> [Either String a]
+readDSV opt = map (>>= fromArgs opt) . parseDSV (fieldSeparator opt)
+
-- Units
instance GCoalpit U1 where
diff --git a/Example.hs b/Example.hs
index 9fb9e0b..5fc19ee 100644
--- a/Example.hs
+++ b/Example.hs
@@ -34,11 +34,11 @@ data Test = Test { foo :: [Int], bar :: Maybe String }
help :: IO ()
help = do
- mapM_ (\(o, x, y) -> print o >> print x >> putStrLn y) $
+ mapM_ (\(o, x, y) -> print o >> putStr x >> putStrLn y) $
[ let opts = defOpt { alwaysUseSelName = ausn
, omitNamedOptions = ono }
in ( (ausn, ono)
- , toArgs opts (Test [] vals)
+ , showDSV opts [Test [1,2,3] vals]
, argHelper opts [] (Proxy :: Proxy Test))
| ausn <- [True, False]
, ono <- [True, False]
diff --git a/README.md b/README.md
index cb38e87..26e77d4 100644
--- a/README.md
+++ b/README.md
@@ -8,8 +8,9 @@ while keeping them language-agnostic and more user- and shell
scripting-friendly than JSON and similar formats.
Given a type, it derives instances to print and parse it as
-command-line arguments, as well as to compose usage instructions. The
-resulting deserialization wouldn't be as nice as that of
+command-line arguments or DSVs, as well as to compose usage
+instructions. The resulting deserialization wouldn't be as nice as
+that of
e.g.
[optparse-generic](https://hackage.haskell.org/package/optparse-generic),
but the aim here is to handle more or less arbitrary types.
@@ -66,27 +67,27 @@ the (alwaysUseSelName, omitNamedOptions) combinations:
```
(True,True)
-["--foo","[]","--bar","a string"]
+--foo : 1 : 2 : 3 [] --bar "a string"
--foo ([] | : INT ([] | :...)) [--bar STRING]
(True,True)
-["--foo","[]"]
+--foo : 1 : 2 : 3 []
--foo ([] | : INT ([] | :...)) [--bar STRING]
(True,False)
-["--foo","[]","--bar","just","a string"]
+--foo : 1 : 2 : 3 [] --bar just "a string"
--foo ([] | : INT ([] | :...)) --bar (nothing | just STRING)
(True,False)
-["--foo","[]","--bar","nothing"]
+--foo : 1 : 2 : 3 [] --bar nothing
--foo ([] | : INT ([] | :...)) --bar (nothing | just STRING)
(False,True)
-["[]","--bar","a string"]
+: 1 : 2 : 3 [] --bar "a string"
([] | : INT ([] | :...)) [--bar STRING]
(False,True)
-["[]"]
+: 1 : 2 : 3 []
([] | : INT ([] | :...)) [--bar STRING]
(False,False)
-["[]","just","a string"]
+: 1 : 2 : 3 [] just "a string"
([] | : INT ([] | :...)) (nothing | just STRING)
(False,False)
-["[]","nothing"]
+: 1 : 2 : 3 [] nothing
([] | : INT ([] | :...)) (nothing | just STRING)
```
diff --git a/coalpit.cabal b/coalpit.cabal
index 51507e0..3b8f664 100644
--- a/coalpit.cabal
+++ b/coalpit.cabal
@@ -1,12 +1,12 @@
name: coalpit
-version: 0.1.0.2
-synopsis: Command-line options parsing and printing
+version: 0.1.0.3
+synopsis: Command-line options and DSV parsing and printing
description: This library generates parsers and printers for
given data types, in the form of command-line
- arguments – so that they can be used to quickly
- get program interfaces via a shared library,
- while being suitable for scripting and as user
- interfaces.
+ arguments or DSVs – so that they can be used to
+ quickly get program interfaces via a shared
+ library, while being suitable for scripting and
+ as user interfaces.
license: BSD3
license-file: LICENSE
author: defanor
@@ -26,6 +26,7 @@ source-repository head
library
exposed-modules: Coalpit
, Coalpit.Parsing
+ , Coalpit.DSV
build-depends: base >= 4.9 && < 5
, megaparsec >= 6.2 && < 7
, scientific >= 0.3 && < 1
diff --git a/test/Test.hs b/test/Test.hs
index c1559fe..1ed55b8 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric, DeriveAnyClass, RankNTypes #-}
import GHC.Generics
import Generic.Random
@@ -9,6 +9,7 @@ import Test.Tasty.Travis
import Data.Word
import Data.Int
import Data.Complex
+import Data.Either
import Coalpit
@@ -40,7 +41,7 @@ data Nested = Nested Record Basic WithLists Sum
deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary Nested where arbitrary = genericArbitraryU
-data Polymorphic a b = Polymorphic (Maybe a) [b] (Either a b)
+data Polymorphic a b = Polymorphic (Maybe a) (Either a b)
deriving (Generic, Eq, Show)
instance (Coalpit a, Coalpit b) => Coalpit (Polymorphic a b)
instance (Arbitrary a, Arbitrary b) => Arbitrary (Polymorphic a b) where
@@ -72,7 +73,7 @@ instance Arbitrary RecursiveRecordMaybe where arbitrary = genericArbitraryU
data RecursiveRecordMaybe2 = RecursiveRecordMaybe2
{ record1' :: Maybe Record
- , rrm' :: Maybe RecursiveRecordMaybe2
+ , rrm' :: Maybe (Maybe RecursiveRecordMaybe2)
, record2' :: Maybe Record
, guard' :: ()
} deriving (Generic, Eq, Show, Coalpit)
@@ -87,46 +88,57 @@ instance Arbitrary RecordStrings where arbitrary = genericArbitraryU
printAndParse :: (Coalpit a, Eq a)
=> Options -> Proxy a -> a -> Bool
-printAndParse m _ r = Right r == fromArgs m (toArgs m r)
-
-mkTest :: (Coalpit a, Eq a, Show a, Arbitrary a)
- => Options -> Proxy a -> String -> TestTree
-mkTest m p n = QC.testProperty n (printAndParse m p)
-
-idEqToAndFrom :: Options -> 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 m (Proxy :: Proxy (Polymorphic Basic Record))
- "Polymorphic Basic Record"
- , mkTest m (Proxy :: Proxy (Polymorphic Nested (Polymorphic Basic Sum)))
+printAndParse opt _ r = Right r == fromArgs opt (toArgs opt r)
+
+printAndParseDSV :: (Coalpit a, Eq a)
+ -- It would take a long time to test with [a], so
+ -- just repeating it 0--2 times.
+ => Options -> Proxy a -> (a, Int) -> Bool
+printAndParseDSV opt _ (x, n) =
+ let xs = (replicate (n `mod` 3) x)
+ in xs == rights (readDSV opt (showDSV opt xs))
+
+
+variousTypes :: (forall a. (Coalpit a, Eq a, Show a, Arbitrary a) =>
+ Proxy a -> String -> TestTree)
+ -> [TestTree]
+variousTypes f =
+ [ f (Proxy :: Proxy Basic) "Basic"
+ , f (Proxy :: Proxy WithLists) "WithLists"
+ , f (Proxy :: Proxy Record) "Record"
+ , f (Proxy :: Proxy Sum) "Sum"
+ , f (Proxy :: Proxy Nested) "Nested"
+ , f (Proxy :: Proxy (Polymorphic Int Double)) "Polymorphic Int Double"
+ , f (Proxy :: Proxy (Polymorphic Basic Record)) "Polymorphic Basic Record"
+ , f (Proxy :: Proxy (Polymorphic Nested (Polymorphic Basic Sum)))
"Polymorphic Nested (Polymorphic Basic Sum)"
- , 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"
- , mkTest m (Proxy :: Proxy RecordStrings) "RecordStrings"
+ , f (Proxy :: Proxy Recursive) "Recursive"
+ , f (Proxy :: Proxy NestedRecord) "NestedRecord"
+ , f (Proxy :: Proxy NestedSum) "NestedSum"
+ , f (Proxy :: Proxy RecursiveRecordMaybe) "RecursiveRecordMaybe"
+ , f (Proxy :: Proxy RecursiveRecordMaybe2) "RecursiveRecordMaybe2"
+ , f (Proxy :: Proxy RecordStrings) "RecordStrings"
]
-variousOptions :: (Options -> TestTree) -> TestTree
-variousOptions tt = testGroup "Various modifiers"
+variousOptions :: (Options -> [TestTree]) -> [TestTree]
+variousOptions tt =
[ testGroup (concat [ "alwaysUseSelName = ", show ausn
, ", omitNamedOptions = ", show ono])
- [tt defOpt { alwaysUseSelName = ausn
- , omitNamedOptions = ono }]
+ (tt defOpt { alwaysUseSelName = ausn
+ , omitNamedOptions = ono })
| ausn <- [True, False]
, ono <- [True, False]
]
qcProps :: TestTree
qcProps = testGroup "Quickcheck properties"
- [ variousOptions idEqToAndFrom ]
+ [ testGroup "Right == fromARgs opt . toArgs opt"
+ (variousOptions $ \opt ->
+ variousTypes $ \p n -> QC.testProperty n (printAndParse opt p))
+ , testGroup "xs == rights (readDSV opt (showDSV opt xs))"
+ (variousOptions $ \opt ->
+ variousTypes $ \p n -> QC.testProperty n (printAndParseDSV opt p))
+ ]
main :: IO ()
main = travisTestReporter defaultConfig [] qcProps