summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordefanor <defanor@uberspace.net>2017-12-20 00:22:25 +0300
committerdefanor <defanor@uberspace.net>2017-12-20 00:22:25 +0300
commite7489043d8bf2a406a910adcb93280e83d6d2faa (patch)
treeb080cab07394cc02ffd3ebbcd815813e5dc2de69
parent62aa7bb8ba54c2a0f480e122c46d967f2102dac5 (diff)
downloadcoalpit-e7489043d8bf2a406a910adcb93280e83d6d2faa.zip
coalpit-e7489043d8bf2a406a910adcb93280e83d6d2faa.tar.gz
coalpit-e7489043d8bf2a406a910adcb93280e83d6d2faa.tar.bz2
Prepare for IO
DSV functions operate on individual lines now, unit type gets printed/parsed as nothing (handier for argument parsing to set '()' when there's none, and that's what it should be anyway).
-rw-r--r--Coalpit.hs4
-rw-r--r--Coalpit/Core.hs7
-rw-r--r--Coalpit/DSV.hs33
-rw-r--r--Example.hs2
-rw-r--r--README.md3
-rw-r--r--test/Test.hs9
6 files changed, 18 insertions, 40 deletions
diff --git a/Coalpit.hs b/Coalpit.hs
index 27df1bb..6eb7f06 100644
--- a/Coalpit.hs
+++ b/Coalpit.hs
@@ -43,12 +43,12 @@ Then, in a shell:
> Foo {bar = Nothing, baz = "a string"}
> ["a string"]
> "a string"
-> [Right (Foo {bar = Nothing, baz = "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"})]
+> Right (Foo {bar = Just 42, baz = "a string"})
> $ ./Example --bar foo
> arguments:1:3:
> Failed to read: foo
diff --git a/Coalpit/Core.hs b/Coalpit/Core.hs
index 3e84b23..ac2b03c 100644
--- a/Coalpit/Core.hs
+++ b/Coalpit/Core.hs
@@ -366,12 +366,6 @@ instance {-#OVERLAPPING#-} Coalpit String where
toArgs _ i = [i]
argHelper _ _ _ = "STRING"
--- | A dot (".").
-instance Coalpit () where
- argParser _ = pS (char '.') *> pure ()
- toArgs _ () = ["."]
- argHelper _ _ _ = "."
-
instance Coalpit Scientific where
argParser _ = try $ do
x <- token (Right . unArg) Nothing
@@ -453,6 +447,7 @@ instance Coalpit DiffTime where
argHelper _ _ _ = "DIFF_TIME"
+instance Coalpit ()
instance Coalpit Bool
instance Coalpit Ordering
instance Coalpit ExitCode
diff --git a/Coalpit/DSV.hs b/Coalpit/DSV.hs
index 4940843..2ba9464 100644
--- a/Coalpit/DSV.hs
+++ b/Coalpit/DSV.hs
@@ -31,15 +31,6 @@ composeDSVLine fs = intercalate [fs] . map escapeVal
then inner
else init $ tail inner
--- | Composes DSV out of values.
-composeDSV :: Char
- -- ^ Field separator.
- -> [[String]]
- -- ^ Lines of values.
- -> String
-composeDSV fs = unlines . map (composeDSVLine fs)
-
-
pStr :: Char -> Parsec Void String String
pStr fs = do
s <- try (between (char '"') (char '"')
@@ -54,23 +45,15 @@ pStr fs = do
pDSVLine :: Char -> Parsec Void String [String]
pDSVLine fs = pStr fs `sepBy` char fs
--- | Parses values out of DSV.
-parseDSV :: Char
- -- ^ Field separator
- -> String
- -- ^ A string containing lines.
- -> [Either String [String]]
-parseDSV fs = map parseLine . lines
- where parseLine :: String -> Either String [String]
- parseLine l = case parse (pDSVLine fs) "line" l of
- Left err -> Left $ parseErrorPretty err
- Right x -> Right x
-
+parseDSVLine :: Char -> String -> Either String [String]
+parseDSVLine fs l = case parse (pDSVLine fs) "line" l of
+ Left err -> Left $ parseErrorPretty err
+ Right x -> Right x
-- | Shows values in DSV format.
-showDSV :: Coalpit a => Options -> [a] -> String
-showDSV opt = composeDSV (fieldSeparator opt) . map (toArgs opt)
+showDSV :: Coalpit a => Options -> a -> String
+showDSV opt = composeDSVLine (fieldSeparator opt) . (toArgs opt)
-- | Reads values from DSV format.
-readDSV :: Coalpit a => Options -> String -> [Either String a]
-readDSV opt = map (>>= fromArgs opt) . parseDSV (fieldSeparator opt)
+readDSV :: Coalpit a => Options -> String -> Either String a
+readDSV opt = (>>= fromArgs opt) . parseDSVLine (fieldSeparator opt)
diff --git a/Example.hs b/Example.hs
index 5fc19ee..a08730d 100644
--- a/Example.hs
+++ b/Example.hs
@@ -34,7 +34,7 @@ data Test = Test { foo :: [Int], bar :: Maybe String }
help :: IO ()
help = do
- mapM_ (\(o, x, y) -> print o >> putStr x >> putStrLn y) $
+ mapM_ (\(o, x, y) -> print o >> putStrLn x >> putStrLn y) $
[ let opts = defOpt { alwaysUseSelName = ausn
, omitNamedOptions = ono }
in ( (ausn, ono)
diff --git a/README.md b/README.md
index 26e77d4..f9e3d7f 100644
--- a/README.md
+++ b/README.md
@@ -17,8 +17,7 @@ but the aim here is to handle more or less arbitrary types.
Warning: it is possible to run into ambiguity by defining a recursive
structure with optional named elements while using default options.
-Unit type can be used to avoid that, or `omitNamedOptions` can be
-disabled.
+`omitNamedOptions` can be disabled to avoid that.
Not production-ready yet, merely a prototype.
diff --git a/test/Test.hs b/test/Test.hs
index 8ef6a3a..0836220 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -67,7 +67,7 @@ instance Arbitrary NestedSum where arbitrary = genericArbitraryU
data RecursiveRecordMaybe = RecursiveRecordMaybe
{ rrm :: Maybe RecursiveRecordMaybe
, record :: Maybe Record
- , guard :: ()
+ , guard :: Word8
} deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary RecursiveRecordMaybe where arbitrary = genericArbitraryU
@@ -75,7 +75,7 @@ data RecursiveRecordMaybe2 = RecursiveRecordMaybe2
{ record1' :: Maybe Record
, rrm' :: Maybe (Maybe RecursiveRecordMaybe2)
, record2' :: Maybe Record
- , guard' :: ()
+ , guard' :: Word8
} deriving (Generic, Eq, Show, Coalpit)
instance Arbitrary RecursiveRecordMaybe2 where arbitrary = genericArbitraryU
@@ -96,7 +96,7 @@ printAndParseDSV :: (Coalpit a, Eq a)
=> 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))
+ in xs == (rights . map (readDSV opt) . lines . unlines . map (showDSV opt) $ xs)
variousTypes :: (forall a. (Coalpit a, Eq a, Show a, Arbitrary a) =>
@@ -135,7 +135,8 @@ qcProps = testGroup "Quickcheck properties"
[ testGroup "Right == fromArgs opt . toArgs opt"
(variousOptions $ \opt ->
variousTypes $ \p n -> QC.testProperty n (printAndParse opt p))
- , testGroup "id == rights . readDSV opt . showDSV opt"
+ , testGroup
+ "id == rights . map (readDSV opt) . lines . unlines . map (showDSV opt)"
(variousOptions $ \opt ->
variousTypes $ \p n -> QC.testProperty n (printAndParseDSV opt p))
]