cassava 0.5.4.1 → 0.5.5.0

raw patch · 10 files changed

+146/−91 lines, 10 filesdep ~basenew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGES.md +8/−0
• cassava.cabal +2/−1
• examples/NamedRecord.hs +0/−10
• src/Data/Csv.hs +2/−0
• src/Data/Csv/Builder.hs +1/−1
• src/Data/Csv/Encoding.hs +83/−60
• src/Data/Csv/Incremental.hs +14/−10
• src/Data/Csv/Parser.hs +4/−4
• src/Data/Csv/Util.hs +7/−5
• tests/UnitTests.hs +25/−0

@@ -1,3 +1,11 @@+## Version 0.5.5.0++_Michael Chavinda, 2026-02-22_++ * `Data.Csv.Incremental`: Fixed the `type role`s of `Builder` and `NamedBuilder`; they're now `nominal` in their parameters.+ * `Faster encoding`: Reduce intermediate allocations in encoding logic.+ * `Default values for encoding missing fields`: Provides a way to either specify per-column defaults or a general fallback value.+ ## Version 0.5.4.1  _Andreas Abel, 2025-09-02_

@@ -1,6 +1,6 @@ cabal-version:       1.18 Name:                cassava-Version:             0.5.4.1+Version:             0.5.5.0  Synopsis:            A CSV parsing and encoding library Description: {@@ -76,6 +76,7 @@     FlexibleContexts     FlexibleInstances     KindSignatures+    RoleAnnotations     MultiParamTypeClasses     OverloadedStrings     PolyKinds

@@ -1,10 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--import Data.Text (Text)-import Data.Csv--data Person = Person { name :: !Text, age :: !Int }--instance ToNamedRecord Person where-    toNamedRecord (Person name age) = namedRecord [-        "name" .= name, "age" .= age]

@@ -56,6 +56,8 @@     , decodeByNameWithP     , EncodeOptions(..)     , Quoting(..)+    , MissingFieldPolicy(..)+    , defaultMissingFieldPolicy     , defaultEncodeOptions     , encodeWith     , encodeByNameWith

@@ -60,7 +60,7 @@ encodeNamedRecordWith :: ToNamedRecord a =>                          EncodeOptions -> Header -> a -> Builder.Builder encodeNamedRecordWith opts hdr nr =-    Encoding.encodeNamedRecord hdr (encQuoting opts) (encDelimiter opts)+    Encoding.encodeNamedRecord hdr (encQuoting opts) (encDelimiter opts) (encMissingFieldPolicy opts)     (toNamedRecord nr) Mon.<> Encoding.recordSep (encUseCrLf opts)  -- | Like 'encodeDefaultOrderedNamedRecord', but lets you customize

@@ -16,6 +16,8 @@     , decode     , decodeByName     , Quoting(..)+    , MissingFieldPolicy(..)+    , defaultMissingFieldPolicy     , encode     , encodeByName     , encodeDefaultOrderedByName@@ -40,14 +42,18 @@     ) where  import Data.ByteString.Builder-import Control.Applicative as AP (Applicative(..), (<|>))++import Control.Applicative as AP ((<|>)) import Data.Attoparsec.ByteString.Char8 (endOfInput) import qualified Data.Attoparsec.ByteString.Lazy as AL import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as BL8+import Data.Foldable (asum)+import qualified Data.ByteString.Builder.Prim as P import qualified Data.HashMap.Strict as HM+import Data.Maybe (fromMaybe) import Data.Vector (Vector) import qualified Data.Vector as V import Data.Word (Word8)@@ -62,10 +68,8 @@ import qualified Data.Csv.Parser as Parser import Data.Csv.Types hiding (toNamedRecord) import qualified Data.Csv.Types as Types-import Data.Csv.Util (blankLine, endOfLine, toStrict)----- TODO: 'encode' isn't as efficient as it could be.+import Data.Csv.Util (blankLine, endOfLine, doubleQuote, cr, newline, comma)+import Data.Functor (($>))  ------------------------------------------------------------------------ -- * Encoding and decoding@@ -182,6 +186,23 @@     | QuoteAll         -- ^ Always quote.     deriving (Eq, Show) +-- | How to encode missing fields.+data MissingFieldPolicy = MissingFieldPolicy+    { -- | Specify a default field value for each column.+      mfpDefaultByColumn :: NamedRecord++      -- | Specify a default field value to use for columns unspecified in+      -- 'mfpDefaultByColumn'. If 'Nothing', this situation results in an+      -- exception.+    , mfpOtherwise :: Maybe Field+    } deriving (Eq, Show)++defaultMissingFieldPolicy :: MissingFieldPolicy+defaultMissingFieldPolicy = MissingFieldPolicy+    { mfpDefaultByColumn = HM.empty+    , mfpOtherwise = Nothing+    }+ -- | Options that controls how data is encoded. These options can be -- used to e.g. encode data in a tab-separated format instead of in a -- comma-separated format.@@ -211,15 +232,19 @@        -- | What kind of quoting should be applied to text fields.     , encQuoting :: !Quoting++      -- | How to encode missing fields.+    , encMissingFieldPolicy :: MissingFieldPolicy     } deriving (Eq, Show)  -- | Encoding options for CSV files. defaultEncodeOptions :: EncodeOptions defaultEncodeOptions = EncodeOptions-    { encDelimiter     = 44  -- comma-    , encUseCrLf       = True-    , encIncludeHeader = True-    , encQuoting       = QuoteMinimal+    { encDelimiter          = comma+    , encUseCrLf            = True+    , encIncludeHeader      = True+    , encQuoting            = QuoteMinimal+    , encMissingFieldPolicy = defaultMissingFieldPolicy     }  -- | Like 'encode', but lets you customize how the CSV data is@@ -236,11 +261,7 @@  -- | Check if the delimiter is valid. validDelim :: Word8 -> Bool-validDelim delim = delim `notElem` [cr, nl, dquote]-  where-    nl = 10-    cr = 13-    dquote = 34+validDelim delim = delim /= cr && delim /= newline && delim /= doubleQuote  -- | Raises an exception indicating that the provided delimiter isn't -- valid. See 'validDelim'.@@ -256,37 +277,43 @@ -- | Encode a single record, without the trailing record separator -- (i.e. newline). encodeRecord :: Quoting -> Word8 -> Record -> Builder-encodeRecord qtng delim = mconcat . intersperse (word8 delim)-                     . map byteString . map (escape qtng delim) . V.toList+encodeRecord qtng delim rec' =+  case V.uncons rec' of+    Nothing      -> mempty+    Just (x, xs) -> escape qtng delim x <>+                    V.foldl' (\acc b -> acc <> d <> escape qtng delim b) mempty xs+  where+    d = word8 delim {-# INLINE encodeRecord #-}  -- | Encode a single named record, without the trailing record -- separator (i.e. newline), using the given field order.-encodeNamedRecord :: Header -> Quoting -> Word8 -> NamedRecord -> Builder-encodeNamedRecord hdr qtng delim =-    encodeRecord qtng delim . namedRecordToRecord hdr+encodeNamedRecord :: Header -> Quoting -> Word8 -> MissingFieldPolicy -> NamedRecord -> Builder+encodeNamedRecord hdr qtng delim missingFieldPolicy =+    encodeRecord qtng delim . namedRecordToRecord missingFieldPolicy hdr --- TODO: Optimize-escape :: Quoting -> Word8 -> B.ByteString -> B.ByteString+escape :: Quoting -> Word8 -> B.ByteString -> Builder escape !qtng !delim !s-    | (qtng == QuoteMinimal &&-        B.any (\ b -> b == dquote || b == delim || b == nl || b == cr) s-      ) || qtng == QuoteAll-         = toStrict . toLazyByteString $-            word8 dquote-            <> B.foldl-                (\ acc b -> acc <> if b == dquote-                    then byteString "\"\""-                    else word8 b)-                mempty-                s-            <> word8 dquote-    | otherwise = s+    | qtng == QuoteAll = buildQuoted+    | qtng == QuoteMinimal && needsQuoting = buildQuoted+    | otherwise = byteString s   where-    dquote = 34-    nl     = 10-    cr     = 13+    needsQuoting = B.any (\b -> b == doubleQuote || b == delim || b == newline || b == cr) s +    dquote :: P.BoundedPrim Word8+    dquote =+        P.liftFixedToBounded $ const (doubleQuote, doubleQuote) P.>$< (P.word8 P.>*< P.word8)++    escaper :: P.BoundedPrim Word8+    escaper = P.condB (== doubleQuote)+        dquote+        (P.liftFixedToBounded P.word8)++    buildQuoted =+        word8 doubleQuote <>+        P.primMapByteStringBounded escaper s <>+        word8 doubleQuote+ -- | Like 'encodeByName', but lets you customize how the CSV data is -- encoded. encodeByNameWith :: ToNamedRecord a => EncodeOptions -> Header -> [a]@@ -300,7 +327,7 @@     rows True  = encodeRecord (encQuoting opts) (encDelimiter opts) hdr <>                  recordSep (encUseCrLf opts) <> records     records = unlines (recordSep (encUseCrLf opts))-              . map (encodeNamedRecord hdr (encQuoting opts) (encDelimiter opts)+              . map (encodeNamedRecord hdr (encQuoting opts) (encDelimiter opts) (encMissingFieldPolicy opts)                      . toNamedRecord)               $ v {-# INLINE encodeByNameWith #-}@@ -315,25 +342,29 @@         toLazyByteString (rows (encIncludeHeader opts))     | otherwise = encodeOptionsError   where-    hdr = (Conversion.headerOrder (undefined :: a))+    hdr = Conversion.headerOrder (undefined :: a)     rows False = records     rows True  = encodeRecord (encQuoting opts) (encDelimiter opts) hdr <>                  recordSep (encUseCrLf opts) <> records     records = unlines (recordSep (encUseCrLf opts))-              . map (encodeNamedRecord hdr (encQuoting opts) (encDelimiter opts)+              . map (encodeNamedRecord hdr (encQuoting opts) (encDelimiter opts) (encMissingFieldPolicy opts)                      . toNamedRecord)               $ v {-# INLINE encodeDefaultOrderedByNameWith #-} -namedRecordToRecord :: Header -> NamedRecord -> Record-namedRecordToRecord hdr nr = V.map find hdr+namedRecordToRecord :: MissingFieldPolicy -> Header -> NamedRecord -> Record+namedRecordToRecord missingFieldPolicy hdr nr = V.map find hdr   where-    find n = case HM.lookup n nr of-        Nothing -> moduleError "namedRecordToRecord" $-                   "header contains name " ++ show (B8.unpack n) ++-                   " which is not present in the named record"-        Just v  -> v+    find n = fromMaybe (fallbackError n) $ asum+        [ HM.lookup n nr+        , HM.lookup n $ mfpDefaultByColumn missingFieldPolicy+        , mfpOtherwise missingFieldPolicy+        ] +    fallbackError n = moduleError "namedRecordToRecord" $+                                  "header contains name " ++ show (B8.unpack n) +++                                  " which is not present in the named record"+ moduleError :: String -> String -> a moduleError func msg = error $ "Data.Csv.Encoding." ++ func ++ ": " ++ msg {-# NOINLINE moduleError #-}@@ -346,14 +377,6 @@ unlines _ [] = mempty unlines sep (b:bs) = b <> sep <> unlines sep bs -intersperse :: Builder -> [Builder] -> [Builder]-intersperse _   []      = []-intersperse sep (x:xs)  = x : prependToAll sep xs--prependToAll :: Builder -> [Builder] -> [Builder]-prependToAll _   []     = []-prependToAll sep (x:xs) = sep <> x : prependToAll sep xs- decodeWithP' :: AL.Parser a -> L.ByteString -> Either String a decodeWithP' p s =     case AL.parse p s of@@ -362,7 +385,7 @@         where           errMsg = "parse error (" ++ msg ++ ") at " ++                    (if BL8.length left > 100-                    then (take 100 $ BL8.unpack left) ++ " (truncated)"+                    then take 100 (BL8.unpack left) ++ " (truncated)"                     else show (BL8.unpack left)) {-# INLINE decodeWithP' #-} @@ -386,11 +409,11 @@     records = do         !r <- record (decDelimiter opts)         if blankLine r-            then (endOfInput *> pure []) <|> (endOfLine *> records)+            then (endOfInput $> []) <|> (endOfLine *> records)             else case runParser (_parseRecord r) of                 Left msg  -> fail $ "conversion error: " ++ msg                 Right val -> do-                    !vals <- (endOfInput *> AP.pure []) <|> (endOfLine *> records)+                    !vals <- (endOfInput $> []) <|> (endOfLine *> records)                     return (val : vals) {-# INLINE csv #-} @@ -406,11 +429,11 @@     records hdr = do         !r <- record (decDelimiter opts)         if blankLine r-            then (endOfInput *> pure []) <|> (endOfLine *> records hdr)+            then (endOfInput $> []) <|> (endOfLine *> records hdr)             else case runParser (convert hdr r) of                 Left msg  -> fail $ "conversion error: " ++ msg                 Right val -> do-                    !vals <- (endOfInput *> pure []) <|> (endOfLine *> records hdr)+                    !vals <- (endOfInput $> []) <|> (endOfLine *> records hdr)                     return (val : vals)      convert hdr = _parseNamedRecord . Types.toNamedRecord hdr

@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns, CPP, DeriveFunctor, ScopedTypeVariables #-}+{-# LANGUAGE RoleAnnotations, KindSignatures #-}  -- | This module allows for incremental decoding and encoding of CSV -- data. This is useful if you e.g. want to interleave I\/O with@@ -81,6 +82,7 @@     , NamedBuilder     ) where +import Data.Kind (Type) import Control.Applicative ((<|>)) import qualified Data.Attoparsec.ByteString as A import Data.Attoparsec.ByteString.Char8 (endOfInput)@@ -95,7 +97,7 @@                                    toNamedRecord) import qualified Data.Csv.Conversion as Conversion import qualified Data.Csv.Encoding as Encoding-import Data.Csv.Encoding (EncodeOptions(..), Quoting(..), recordSep)+import Data.Csv.Encoding (EncodeOptions(..), Quoting(..), MissingFieldPolicy(..), recordSep) import Data.Csv.Parser import Data.Csv.Types import Data.Csv.Util (endOfLine)@@ -357,7 +359,8 @@ -- right-associative, 'foldr' style. Using '<>' to compose builders in -- a left-associative, `foldl'` style makes the building not be -- incremental.-newtype Builder a = Builder {+type role Builder  nominal+newtype   Builder (a :: Type) = Builder {       runBuilder :: Quoting -> Word8 -> Bool -> Builder.Builder     } @@ -396,7 +399,7 @@     Builder.toLazyByteString $     encHdr <>     runNamedBuilder b hdr (encQuoting opts) (encDelimiter opts)-    (encUseCrLf opts)+    (encMissingFieldPolicy opts) (encUseCrLf opts)   where     encHdr       | encIncludeHeader opts =@@ -413,7 +416,7 @@     Builder.toLazyByteString $     encHdr <>     runNamedBuilder b hdr (encQuoting opts)-    (encDelimiter opts) (encUseCrLf opts)+    (encDelimiter opts) (encMissingFieldPolicy opts) (encUseCrLf opts)   where     hdr = Conversion.headerOrder (undefined :: a) @@ -425,8 +428,8 @@  -- | Encode a single named record. encodeNamedRecord :: ToNamedRecord a => a -> NamedBuilder a-encodeNamedRecord nr = NamedBuilder $ \ hdr qtng delim useCrLf ->-    Encoding.encodeNamedRecord hdr qtng delim+encodeNamedRecord nr = NamedBuilder $ \ hdr qtng delim missingFieldPolicy useCrLf ->+    Encoding.encodeNamedRecord hdr qtng delim missingFieldPolicy     (Conversion.toNamedRecord nr) <> recordSep useCrLf  -- | A builder for building the CSV data incrementally. Just like the@@ -434,15 +437,16 @@ -- right-associative, 'foldr' style. Using '<>' to compose builders in -- a left-associative, `foldl'` style makes the building not be -- incremental.-newtype NamedBuilder a = NamedBuilder {-      runNamedBuilder :: Header -> Quoting -> Word8 -> Bool -> Builder.Builder+type role NamedBuilder  nominal+newtype   NamedBuilder (a :: Type) = NamedBuilder {+      runNamedBuilder :: Header -> Quoting -> Word8 -> MissingFieldPolicy -> Bool -> Builder.Builder     }  -- | @since 0.5.0.0 instance Semigroup (NamedBuilder a) where     NamedBuilder f <> NamedBuilder g =-        NamedBuilder $ \ hdr qtng delim useCrlf ->-        f hdr qtng delim useCrlf <> g hdr qtng delim useCrlf+        NamedBuilder $ \ hdr qtng delim missing useCrlf ->+        f hdr qtng delim missing useCrlf <> g hdr qtng delim missing useCrlf  instance Monoid (NamedBuilder a) where     mempty = NamedBuilder (\ _ _ _ _ -> mempty)

@@ -36,7 +36,7 @@ import Data.Word (Word8)  import Data.Csv.Types-import Data.Csv.Util ((<$!>), blankLine, endOfLine, liftM2', cr, newline, doubleQuote, toStrict)+import Data.Csv.Util ((<$!>), blankLine, endOfLine, liftM2', cr, comma, newline, doubleQuote, toStrict)  -- | Options that controls how data is decoded. These options can be -- used to e.g. decode tab-separated data instead of comma-separated@@ -57,7 +57,7 @@ -- | Decoding options for parsing CSV files. defaultDecodeOptions :: DecodeOptions defaultDecodeOptions = DecodeOptions-    { decDelimiter = 44  -- comma+    { decDelimiter = comma     }  -- | Parse a CSV file that does not include a header.@@ -179,8 +179,8 @@     h <- Z.takeWhile (/= doubleQuote)     let rest = do           start <- Z.take 2-          if (S.unsafeHead start == doubleQuote &&-              S.unsafeIndex start 1 == doubleQuote)+          if S.unsafeHead start == doubleQuote &&+              S.unsafeIndex start 1 == doubleQuote               then go (acc `mappend` byteString h `mappend` charUtf8 '"')               else fail "invalid CSV escape sequence"     done <- Z.atEnd

@@ -8,10 +8,12 @@     , doubleQuote     , newline     , cr+    , comma     , toStrict     ) where  import Control.Applicative ((<|>))+import Data.Functor ( ($>) ) import Data.Word (Word8) import Data.Attoparsec.ByteString.Char8 (string) import qualified Data.Attoparsec.ByteString as A@@ -31,15 +33,14 @@  -- | Is this an empty record (i.e. a blank line)? blankLine :: V.Vector B.ByteString -> Bool-blankLine v = V.length v == 1 && (B.null (V.head v))+blankLine v = V.length v == 1 && B.null (V.head v)  -- | A version of 'liftM2' that is strict in the result of its first -- action. liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c liftM2' f a b = do     !x <- a-    y <- b-    return (f x y)+    f x <$> b {-# INLINE liftM2' #-}  @@ -47,10 +48,11 @@ -- return followed by a newline character @\"\\r\\n\"@, or a single -- carriage return @\'\\r\'@. endOfLine :: Parser ()-endOfLine = (A.word8 newline *> return ()) <|> (string "\r\n" *> return ()) <|> (A.word8 cr *> return ())+endOfLine = (A.word8 newline $> ()) <|> (string "\r\n" $> ()) <|> (A.word8 cr $> ()) {-# INLINE endOfLine #-} -doubleQuote, newline, cr :: Word8+doubleQuote, newline, cr, comma :: Word8 doubleQuote = 34 newline = 10 cr = 13+comma = 44

@@ -383,9 +383,34 @@     cr = 13     dquote = 34 +customMissing :: Assertion+customMissing = encodeByNameWith encOpts hdr nrs @?= ex+  where+    encOpts = defaultEncodeOptions+        { encMissingFieldPolicy = defaultMissingFieldPolicy+            { mfpDefaultByColumn = HM.fromList+                [ ("abc", "abc default")+                , ("def", "def default")+                , ("jkl", "ghi default")+                ]+            , mfpOtherwise = Just "fallback"+            }+        }+    hdr = V.fromList ["abc", "def", "ghi"]+    nrs :: [NamedRecord]+    nrs =+      [ HM.fromList [("abc", "123")]+      , HM.fromList [("def", "456")]+      , HM.fromList [("abc", "234"), ("def", "567")]+      , HM.fromList [("abc", "234"), ("def", "567"), ("ghi", "890")]+      , HM.fromList []+      ]+    ex = "abc,def,ghi\r\n123,def default,fallback\r\nabc default,456,fallback\r\n234,567,fallback\r\n234,567,890\r\nabc default,def default,fallback\r\n"+ customOptionsTests :: [TF.Test] customOptionsTests =     [ testProperty "customDelim" customDelim+    , testCase "customMissing" customMissing     ]  ------------------------------------------------------------------------