diff --git a/Data/Csv.hs b/Data/Csv.hs --- a/Data/Csv.hs +++ b/Data/Csv.hs @@ -92,7 +92,7 @@ -- A short encoding usage example: -- -- > >>> encode [("John" :: Text, 27), ("Jane", 28)] --- > Chunk "John,27\r\nJane,28\r\n" Empty +-- > "John,27\r\nJane,28\r\n" -- -- Since string literals are overloaded we have to supply a type -- signature as the compiler couldn't deduce which string type (i.e. @@ -103,7 +103,7 @@ -- A short decoding usage example: -- -- > >>> decode NoHeader "John,27\r\nJane,28\r\n" :: Either String (Vector (Text, Int)) --- > Right (fromList [("John",27),("Jane",28)]) +-- > Right [("John",27),("Jane",28)] -- -- We pass 'NoHeader' as the first argument to indicate that the CSV -- input data isn't preceded by a header. @@ -120,7 +120,7 @@ -- record to a @'Vector' 'ByteString'@ value, like so: -- -- > decode NoHeader "John,27\r\nJane,28\r\n" :: Either String (Vector (Vector ByteString)) --- > Right (fromList [fromList ["John","27"],fromList ["Jane","28"]]) +-- > Right [["John","27"],["Jane","28"]] -- -- As the example output above shows, all the fields are returned as -- uninterpreted 'ByteString' values. diff --git a/Data/Csv/Conversion.hs b/Data/Csv/Conversion.hs --- a/Data/Csv/Conversion.hs +++ b/Data/Csv/Conversion.hs @@ -34,7 +34,7 @@ import Control.Applicative (Alternative, Applicative, (<*>), (<$>), (<|>), empty, pure) import Control.Monad (MonadPlus, mplus, mzero) -import Data.Attoparsec.Char8 (double, parseOnly) +import Data.Attoparsec.Char8 (double) import qualified Data.Attoparsec.Char8 as A8 import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 @@ -624,6 +624,19 @@ Left err -> typeError typ s (Just err) Right n -> pure n {-# INLINE parseUnsigned #-} + +------------------------------------------------------------------------ +-- Custom version of attoparsec @parseOnly@ function which fails if +-- there is leftover content after parsing a field. +parseOnly :: A8.Parser a -> B.ByteString -> Either String a +parseOnly parser input = go (A8.parse parser input) where + go (A8.Fail _ _ err) = Left err + go (A8.Partial f) = go (f B.empty) + go (A8.Done leftover result) + | B.null leftover = Right result + | otherwise = Left ("incomplete field parse, leftover: " + ++ show (B.unpack leftover)) +{-# INLINE parseOnly #-} typeError :: String -> B.ByteString -> Maybe String -> Parser a typeError typ s mmsg = diff --git a/Data/Csv/Encoding.hs b/Data/Csv/Encoding.hs --- a/Data/Csv/Encoding.hs +++ b/Data/Csv/Encoding.hs @@ -153,12 +153,22 @@ data EncodeOptions = EncodeOptions { -- | Field delimiter. encDelimiter :: {-# UNPACK #-} !Word8 + + -- | Record separator selection. @True@ for CRLF (@\\r\\n@) and + -- @False@ for LF (@\\n@). + , encUseCrLf :: !Bool + + -- | Include a header row when encoding @ToNamedRecord@ + -- instances. + , encIncludeHeader :: !Bool } deriving (Eq, Show) -- | Encoding options for CSV files. defaultEncodeOptions :: EncodeOptions defaultEncodeOptions = EncodeOptions - { encDelimiter = 44 -- comma + { encDelimiter = 44 -- comma + , encUseCrLf = True + , encIncludeHeader = True } -- | Like 'encode', but lets you customize how the CSV data is @@ -167,7 +177,7 @@ encodeWith opts | validDelim (encDelimiter opts) = toLazyByteString - . unlines + . unlines (recordSep (encUseCrLf opts)) . map (encodeRecord (encDelimiter opts) . toRecord) | otherwise = encodeOptionsError {-# INLINE encodeWith #-} @@ -222,11 +232,13 @@ -> L.ByteString encodeByNameWith opts hdr v | validDelim (encDelimiter opts) = - toLazyByteString ((encodeRecord (encDelimiter opts) hdr) <> - fromByteString "\r\n" <> records) + toLazyByteString (rows (encIncludeHeader opts)) | otherwise = encodeOptionsError where - records = unlines + rows False = records + rows True = encodeRecord (encDelimiter opts) hdr <> + recordSep (encUseCrLf opts) <> records + records = unlines (recordSep (encUseCrLf opts)) . map (encodeRecord (encDelimiter opts) . namedRecordToRecord hdr . toNamedRecord) $ v @@ -246,9 +258,13 @@ moduleError func msg = error $ "Data.Csv.Encoding." ++ func ++ ": " ++ msg {-# NOINLINE moduleError #-} -unlines :: [Builder] -> Builder -unlines [] = mempty -unlines (b:bs) = b <> fromString "\r\n" <> unlines bs +recordSep :: Bool -> Builder +recordSep False = fromWord8 10 -- new line (\n) +recordSep True = fromString "\r\n" + +unlines :: Builder -> [Builder] -> Builder +unlines _ [] = mempty +unlines sep (b:bs) = b <> sep <> unlines sep bs intersperse :: Builder -> [Builder] -> [Builder] intersperse _ [] = [] diff --git a/cassava.cabal b/cassava.cabal --- a/cassava.cabal +++ b/cassava.cabal @@ -1,5 +1,5 @@ Name: cassava -Version: 0.3.0.1 +Version: 0.4.0.0 Synopsis: A CSV parsing and encoding library Description: A CSV parsing and encoding library optimized for ease of use and high diff --git a/tests/UnitTests.hs b/tests/UnitTests.hs --- a/tests/UnitTests.hs +++ b/tests/UnitTests.hs @@ -54,6 +54,12 @@ namedEncodesAs hdr input expected = encodeByName (V.fromList hdr) (map HM.fromList input) @?= expected +namedEncodesWithAs :: EncodeOptions -> [B.ByteString] + -> [[(B.ByteString, B.ByteString)]] + -> BL.ByteString -> Assertion +namedEncodesWithAs opts hdr input expected = + encodeByNameWith opts (V.fromList hdr) (map HM.fromList input) @?= expected + namedDecodesAs :: BL.ByteString -> [B.ByteString] -> [[(B.ByteString, B.ByteString)]] -> Assertion namedDecodesAs input ehdr expected = case decodeByName input of @@ -113,6 +119,8 @@ , testGroup "encodeWith" [ testCase "tab-delim" $ encodesWithAs (defEnc { encDelimiter = 9 }) [["1", "2"]] "1\t2\r\n" + , testCase "newline" $ encodesWithAs (defEnc {encUseCrLf = False}) + [["1", "2"], ["3", "4"]] "1,2\n3,4\n" ] , testGroup "decode" $ map decodeTest decodeTests , testGroup "decodeWith" $ map decodeWithTest decodeWithTests @@ -168,6 +176,10 @@ , ("twoRecords", ["field"], [[("field", "abc")], [("field", "def")]], "field\r\nabc\r\ndef\r\n") ] + , testGroup "encodeWith" $ map encodeWithTest + [ ("no header", defEnc {encIncludeHeader = False}, ["field"], + [[("field", "abc")]], "abc\r\n") + ] , testGroup "decode" $ map decodeTest decodeTests , testGroup "streaming" [ testGroup "decode" $ map streamingDecodeTest decodeTests @@ -184,10 +196,13 @@ encodeTest (name, hdr, input, expected) = testCase name $ namedEncodesAs hdr input expected + encodeWithTest (name, opts, hdr, input, expected) = + testCase name $ namedEncodesWithAs opts hdr input expected decodeTest (name, input, hdr, expected) = testCase name $ namedDecodesAs input hdr expected streamingDecodeTest (name, input, hdr, expected) = testCase name $ namedDecodesStreamingAs input hdr expected + defEnc = defaultEncodeOptions ------------------------------------------------------------------------ -- Conversion tests @@ -208,7 +223,7 @@ -- empty line (which we will ignore.) We therefore encode at least two -- columns. roundTrip :: (Eq a, FromField a, ToField a) => a -> Bool -roundTrip x = Right (V.fromList record) == decode NoHeader (encode record) +roundTrip x = Right (V.fromList record) == decode NoHeader (encode record) where record = [(x, dummy)] dummy = 'a' @@ -221,6 +236,11 @@ boundary :: forall a. (Bounded a, Eq a, FromField a, ToField a) => a -> Bool boundary _dummy = roundTrip (minBound :: a) && roundTrip (maxBound :: a) +partialDecode :: Parser a -> Assertion +partialDecode p = case runParser p of + Left _ -> return () + Right _ -> assertFailure "expected partial field decode" + conversionTests :: [TF.Test] conversionTests = [ testGroup "roundTrip" @@ -260,6 +280,16 @@ "Sævör grét áðan því úlpan var ónýt.") , testCase "Turkish" (roundTripUnicode "Cam yiyebilirim, bana zararı dokunmaz.") + ] + , testGroup "Partial Decodes" + [ testCase "Int" (partialDecode + (parseField "12.7" :: Parser Int)) + , testCase "Word" (partialDecode + (parseField "12.7" :: Parser Word)) + , testCase "Double" (partialDecode + (parseField "1.0+" :: Parser Double)) + , testCase "Integer" (partialDecode + (parseField "1e6" :: Parser Integer)) ] ]