From 1de2f778183a8890c0aa8e1f0486002f504649b5 Mon Sep 17 00:00:00 2001 From: defanor Date: Sun, 17 Dec 2017 00:44:06 +0300 Subject: Add DSV support --- Coalpit.hs | 28 ++++++++++++++++++---- Example.hs | 4 ++-- README.md | 21 +++++++++-------- coalpit.cabal | 13 +++++----- test/Test.hs | 76 ++++++++++++++++++++++++++++++++++------------------------- 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 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 -- cgit v1.2.3