Add DSV support

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