From e7489043d8bf2a406a910adcb93280e83d6d2faa Mon Sep 17 00:00:00 2001 From: defanor Date: Wed, 20 Dec 2017 00:22:25 +0300 Subject: 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). --- Coalpit.hs | 4 ++-- Coalpit/Core.hs | 7 +------ Coalpit/DSV.hs | 33 ++++++++------------------------- Example.hs | 2 +- README.md | 3 +-- test/Test.hs | 9 +++++---- 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)) ] -- cgit v1.2.3