cassava 0.5.3.2 → 0.5.5.0
raw patch · 11 files changed
Files
- CHANGES.md +44/−0
- cassava.cabal +32/−30
- 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/Streaming.hs +29/−4
- src/Data/Csv/Util.hs +7/−5
- tests/UnitTests.hs +25/−0
CHANGES.md view
@@ -1,5 +1,31 @@+## 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_++ * Bump dependency lower bounds to at least GHC 8.0 and Stackage LTS 7.0.+ * Build tested with GHC 8.0 - 9.14 alpha1.+ * Functionality tested with GHC 8.4 - 9.14 alpha1.++## Version 0.5.4.0++_Andreas Abel, 2025-06-10_++ * Add `decodeWithP` and `decodeByNameWithP` to `Streaming` interface ([PR #237](https://github.com/haskell-hvr/cassava/pull/237)).+ * Build tested with GHC 8.0 - 9.12.2.+ * Functionality tested with GHC 8.4 - 9.12.2.+ ## Version 0.5.3.2 +_Andreas Abel, 2024-08-03_+ * Proper exception on hanging doublequote ([PR #222](https://github.com/haskell-hvr/cassava/pull/222)). * Allow latest `hashable`. * Build tested with GHC 8.0 - 9.10.1.@@ -7,6 +33,8 @@ ## Version 0.5.3.1 +_Andreas Abel, 2024-04-23_+ * Remove support for GHC 7. * Remove cabal flag `bytestring--LT-0_10_4` and support for `bytestring < 0.10.4`. * Tested with GHC 8.0 - 9.10 alpha3@@ -23,6 +51,8 @@ ## Version 0.5.3.0 +_Andreas Abel, 2022-07-10_+ * Improve error messages for `lookup` and NamedRecord parsers (#197) * Fix bug (infinite loop) in `FromField Const` instance (#185) * Turn flag `bytestring--LT-0_10_4` off by default (#183)@@ -32,12 +62,16 @@ ## Version 0.5.2.0 +_Herbert Valerio Riedel, 2019-09-01_+ * Add `FromField`/`ToField` instances for `Identity` and `Const` (#158) * New `typeclass`-less decoding functions `decodeWithP` and `decodeByNameWithP` (#67,#167) * Support for final phase of MFP / base-4.13 ## Version 0.5.1.0 +_Herbert Valerio Riedel, 2017-08-12_+ * Add `FromField`/`ToField` instance for `Natural` (#141,#142) * Add `FromField`/`ToField` instances for `Scientific` (#143,#144) * Add support for modifying Generics-based instances (adding@@ -48,6 +82,8 @@ ## Version 0.5.0.0 +_Herbert Valerio Riedel, 2017-06-19_+ ### Semantic changes * Don't unecessarily quote spaces with `QuoteMinimal` (#118,#122,#86)@@ -66,10 +102,14 @@ ## Version 0.4.5.1 +_Herbert Valerio Riedel, 2016-11-10_+ * Restore GHC 7.4 support (#124) ## Version 0.4.5.0 +_Herbert Valerio Riedel, 2016-01-19_+ * Support for GHC 8.0 added; support for GHC 7.4 dropped * Fix defect in `Foldable(foldr)` implementation failing to skip@@ -81,6 +121,8 @@ ## Version 0.4.4.0 +_Johan Tibell, 2015-08-30_+ * Added record instances for larger tuples. * Support attoparsec 0.13.@@ -88,6 +130,8 @@ * Add field instances for short bytestrings. ## Version 0.4.3.0++_Johan Tibell, 2015-06-02_ * Documentation overhaul with more examples.
cassava.cabal view
@@ -1,6 +1,7 @@-cabal-version: 1.12+cabal-version: 1.18 Name: cassava-Version: 0.5.3.2+Version: 0.5.5.0+ Synopsis: A CSV parsing and encoding library Description: { @@ -39,13 +40,15 @@ Maintainer: https://github.com/haskell-hvr/cassava Category: Text, Web, CSV Build-type: Simple-Extra-source-files: examples/*.hs,- CHANGES.md,+Extra-source-files: examples/*.hs+Extra-doc-files: CHANGES.md README.md Tested-with:- GHC == 9.10.1- GHC == 9.8.2- GHC == 9.6.6+ GHC == 9.14.1+ GHC == 9.12.2+ GHC == 9.10.2+ GHC == 9.8.4+ GHC == 9.6.7 GHC == 9.4.8 GHC == 9.2.8 GHC == 9.0.2@@ -73,6 +76,7 @@ FlexibleContexts FlexibleInstances KindSignatures+ RoleAnnotations MultiParamTypeClasses OverloadedStrings PolyKinds@@ -97,21 +101,21 @@ Data.Csv.Types Data.Csv.Util + -- Lower bounds from GHC 8.0 and Stackage LTS 7.0 Build-depends:- base >= 4.9 && < 5- , array >= 0.4 && < 0.6- , attoparsec >= 0.11.3.0 && < 0.15- , bytestring >= 0.10.4 && < 0.13- , containers >= 0.4.2 && < 0.8- , deepseq >= 1.1 && < 1.6- , hashable < 2- , scientific >= 0.3.4.7 && < 0.4- , text < 2.2- , text-short == 0.1.*- , transformers >= 0.2 && < 0.7- , unordered-containers < 0.3- , vector >= 0.8 && < 0.14- , Only >= 0.1 && < 0.1.1+ base >= 4.9 && < 5+ , array >= 0.5.1.1 && < 0.6+ , attoparsec >= 0.11.3.0 && < 0.15+ , bytestring >= 0.10.8.0 && < 0.13+ , containers >= 0.5.7.1 && < 1+ , deepseq >= 1.4.2.0 && < 1.6+ , hashable >= 1.2.4.0 && < 2+ , scientific >= 0.3.4.9 && < 0.4+ , text >= 1.2.2.1 && < 2.2+ , text-short == 0.1.*+ , unordered-containers >= 0.2.7.1 && < 0.3+ , vector >= 0.11.0.0 && < 0.14+ , Only >= 0.1 && < 0.1.1 ghc-options: -Wall@@ -135,22 +139,20 @@ Type: exitcode-stdio-1.0 Main-is: UnitTests.hs -- dependencies with version constraints inherited via lib:cassava- Build-depends: attoparsec- , base >= 4.11 && < 5+ Build-depends: base >= 4.11 && < 5 , bytestring , cassava- , hashable , scientific , text , unordered-containers , vector -- extra dependencies not already used by lib:cassava- build-depends: HUnit < 1.7- , QuickCheck >= 2.14 && < 2.16- , quickcheck-instances >= 0.3.12 && < 0.4- , test-framework == 0.8.*- , test-framework-hunit == 0.3.*- , test-framework-quickcheck2 == 0.3.*+ build-depends: HUnit >= 1.3.1.2 && < 1.7+ , QuickCheck >= 2.14 && < 3+ , quickcheck-instances >= 0.3.12 && < 0.4+ , test-framework == 0.8.*+ , test-framework-hunit == 0.3.*+ , test-framework-quickcheck2 == 0.3.* hs-source-dirs: tests
− examples/NamedRecord.hs
@@ -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]
src/Data/Csv.hs view
@@ -56,6 +56,8 @@ , decodeByNameWithP , EncodeOptions(..) , Quoting(..)+ , MissingFieldPolicy(..)+ , defaultMissingFieldPolicy , defaultEncodeOptions , encodeWith , encodeByNameWith
src/Data/Csv/Builder.hs view
@@ -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
src/Data/Csv/Encoding.hs view
@@ -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
src/Data/Csv/Incremental.hs view
@@ -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)
src/Data/Csv/Parser.hs view
@@ -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
src/Data/Csv/Streaming.hs view
@@ -21,11 +21,13 @@ , HasHeader(..) , decode , decodeWith+ , decodeWithP -- ** Name-based record conversion -- $namebased , decodeByName , decodeByNameWith+ , decodeByNameWithP ) where import Control.DeepSeq (NFData(rnf))@@ -36,8 +38,9 @@ import Prelude hiding (foldr) import Data.Csv.Conversion+import qualified Data.Csv.Conversion as Conversion import Data.Csv.Incremental hiding (decode, decodeByName, decodeByNameWith,- decodeWith)+ decodeByNameWithP, decodeWith, decodeWithP) import qualified Data.Csv.Incremental as I import Data.Csv.Parser import Data.Csv.Types@@ -134,8 +137,19 @@ -- skipped -> BL.ByteString -- ^ CSV data -> Records a-decodeWith !opts hasHeader s0 =- go (BL.toChunks s0) (I.decodeWith opts hasHeader)+decodeWith = decodeWithP parseRecord++-- | Like 'decodeWith', but lets you specify a parser function.+--+-- @since 0.5.4.0+decodeWithP :: (Record -> Conversion.Parser a)+ -> DecodeOptions -- ^ Decoding options+ -> HasHeader -- ^ Data contains header that should be+ -- skipped+ -> BL.ByteString -- ^ CSV data+ -> Records a+decodeWithP _parseRecord !opts hasHeader s0 =+ go (BL.toChunks s0) (I.decodeWithP _parseRecord opts hasHeader) where go ss (Done xs) = foldr Cons (Nil Nothing (BL.fromChunks ss)) xs go ss (Fail rest err) = Nil (Just err) (BL.fromChunks (rest:ss))@@ -159,7 +173,18 @@ => DecodeOptions -- ^ Decoding options -> BL.ByteString -- ^ CSV data -> Either String (Header, Records a)-decodeByNameWith !opts s0 = go (BL.toChunks s0) (I.decodeByNameWith opts)+decodeByNameWith = decodeByNameWithP parseNamedRecord++-- | Like 'decodeByNameWith', but lets you specify a parser function.+--+-- @since 0.5.4.0+decodeByNameWithP :: (NamedRecord -> Conversion.Parser a)+ -- ^ Custom parser function+ -> DecodeOptions -- ^ Decoding options+ -> BL.ByteString -- ^ CSV data+ -> Either String (Header, Records a)+decodeByNameWithP _parseNamedRecord !opts s0 =+ go (BL.toChunks s0) (I.decodeByNameWithP _parseNamedRecord opts) where go ss (DoneH hdr p) = Right (hdr, go2 ss p) go ss (FailH rest err) = Left $ err ++ " at " ++
src/Data/Csv/Util.hs view
@@ -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
tests/UnitTests.hs view
@@ -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 ] ------------------------------------------------------------------------