cassava 0.2.2.0 → 0.3.0.0
raw patch · 16 files changed
+265/−192 lines, 16 filesdep ~arraydep ~lazy-csv
Dependency ranges changed: array, lazy-csv
Files
- Data/Csv.hs +35/−8
- Data/Csv/Conversion.hs +12/−2
- Data/Csv/Encoding.hs +71/−36
- Data/Csv/Incremental.hs +24/−72
- Data/Csv/Parser.hs +34/−25
- Data/Csv/Streaming.hs +11/−17
- Data/Csv/Types.hs +7/−0
- Data/Csv/Util.hs +13/−1
- benchmarks/Benchmarks.hs +16/−8
- cassava.cabal +3/−3
- examples/IncrementalIndexedBasedDecode.hs +2/−3
- examples/IndexBasedDecode.hs +1/−1
- examples/IndexBasedGeneric.hs +2/−2
- examples/NamedBasedGeneric.hs +1/−1
- examples/StreamingIndexBasedDecode.hs +1/−1
- tests/UnitTests.hs +32/−12
Data/Csv.hs view
@@ -5,7 +5,7 @@ -- * Empty lines are ignored. -- -- * Non-escaped fields may contain any characters except--- double-quotes, commas, carriage returns, and newlines+-- double-quotes, commas, carriage returns, and newlines. -- -- * Escaped fields may contain any characters (but double-quotes -- need to be escaped).@@ -20,9 +20,13 @@ -- * Custom type conversions -- $customtypeconversions + -- ** Dealing with bad data+ -- $baddata+ -- * Encoding and decoding -- $encoding- decode+ HasHeader(..)+ , decode , decodeByName , encode , encodeByName@@ -56,6 +60,7 @@ , runParser , index , (.!)+ , unsafeIndex , ToRecord(..) , record , Only(..)@@ -86,7 +91,7 @@ -- -- A short encoding usage example: ----- > >>> encode $ fromList [("John" :: Text, 27), ("Jane", 28)]+-- > >>> encode [("John" :: Text, 27), ("Jane", 28)] -- > Chunk "John,27\r\nJane,28\r\n" Empty -- -- Since string literals are overloaded we have to supply a type@@ -97,10 +102,10 @@ -- -- A short decoding usage example: ----- > >>> decode False "John,27\r\nJane,28\r\n" :: Either String (Vector (Text, Int))+-- > >>> decode NoHeader "John,27\r\nJane,28\r\n" :: Either String (Vector (Text, Int)) -- > Right (fromList [("John",27),("Jane",28)]) ----- We pass 'False' as the first argument to indicate that the CSV+-- We pass 'NoHeader' as the first argument to indicate that the CSV -- input data isn't preceded by a header. -- -- In practice, the return type of 'decode' rarely needs to be given,@@ -114,7 +119,7 @@ -- parse a CSV file to a generic representation, just convert each -- record to a @'Vector' 'ByteString'@ value, like so: ----- > decode False "John,27\r\nJane,28\r\n" :: Either String (Vector (Vector ByteString))+-- > decode NoHeader "John,27\r\nJane,28\r\n" :: Either String (Vector (Vector ByteString)) -- > Right (fromList [fromList ["John","27"],fromList ["Jane","28"]]) -- -- As the example output above shows, all the fields are returned as@@ -139,19 +144,41 @@ -- on the @newtype@ constructor to indicate which type conversion you -- want to have the library use: ----- > case decode False "0xff,0xaa\r\n0x11,0x22\r\n" of+-- > case decode NoHeader "0xff,0xaa\r\n0x11,0x22\r\n" of -- > Left err -> putStrLn err -- > Right v -> forM_ v $ \ (Hex val1, Hex val2) -> -- > print (val1, val2) --+-- If a field might be in one several different formats, you can use a+-- newtype to normalize the result:+--+-- > newtype HexOrDecimal = HexOrDecimal Int+-- >+-- > instance FromField DefaultToZero where+-- > parseField s = case runParser (parseField s :: Parser Hex) of+-- > Left err -> HexOrDecimal <$> parseField s -- Uses Int instance+-- > Right n -> pure $ HexOrDecimal n+-- -- You can use the unit type, @()@, to ignore a column. The -- 'parseField' method for @()@ doesn't look at the 'Field' and thus -- always decodes successfully. Note that it lacks a corresponding -- 'ToField' instance. Example: ----- > case decode False "foo,1\r\nbar,22" of+-- > case decode NoHeader "foo,1\r\nbar,22" of -- > Left err -> putStrLn err -- > Right v -> forM_ v $ \ ((), i) -> print (i :: Int)++-- $baddata+--+-- If your input might contain invalid fields, you can write a custom+-- 'FromField' instance to deal with them. Example:+--+-- > newtype DefaultToZero = DefaultToZero Int+-- >+-- > instance FromField DefaultToZero where+-- > parseField s = case runParser (parseField s) of+-- > Left err -> pure $ DefaultToZero 0+-- > Right n -> pure $ DefaultToZero n -- $encoding --
Data/Csv/Conversion.hs view
@@ -304,7 +304,7 @@ -- > -- > data Person = Person { name :: !Text, age :: !Int } -- >--- > instance FromRecord Person where+-- > instance FromNamedRecord Person where -- > parseNamedRecord m = Person <$> -- > m .: "name" <*> -- > m .: "age"@@ -325,7 +325,7 @@ -- -- > data Person = Person { name :: !Text, age :: !Int } -- >--- > instance ToRecord Person where+-- > instance ToNamedRecord Person where -- > toNamedRecord (Person name age) = namedRecord [ -- > "name" .= name, "age" .= age] class ToNamedRecord a where@@ -402,6 +402,13 @@ toField = maybe B.empty toField {-# INLINE toField #-} +-- | @'Left' field@ if conversion failed, 'Right' otherwise.+instance FromField a => FromField (Either Field a) where+ parseField s = case runParser (parseField s) of+ Left _ -> pure $ Left s+ Right a -> pure $ Right a+ {-# INLINE parseField #-}+ -- | Ignores the 'Field'. Always succeeds. instance FromField () where parseField _ = pure ()@@ -762,6 +769,9 @@ left !errMsg = Left errMsg right !x = Right x {-# INLINE runParser #-}++------------------------------------------------------------------------+-- Generics #ifdef GENERICS
Data/Csv/Encoding.hs view
@@ -12,7 +12,8 @@ module Data.Csv.Encoding ( -- * Encoding and decoding- decode+ HasHeader(..)+ , decode , decodeByName , encode , encodeByName@@ -29,7 +30,7 @@ ) where import Blaze.ByteString.Builder (Builder, fromByteString, fromWord8,- toLazyByteString)+ toLazyByteString, toByteString) import Blaze.ByteString.Builder.Char8 (fromString) import Control.Applicative ((*>), (<|>), optional, pure) import Data.Attoparsec.Char8 (endOfInput, endOfLine)@@ -64,7 +65,7 @@ -- If this fails due to incomplete or invalid input, @'Left' msg@ is -- returned. Equivalent to @'decodeWith' 'defaultDecodeOptions'@. decode :: FromRecord a- => Bool -- ^ Data contains header that should be+ => HasHeader -- ^ Data contains header that should be -- skipped -> L.ByteString -- ^ CSV data -> Either String (Vector a)@@ -82,13 +83,13 @@ {-# INLINE decodeByName #-} -- | Efficiently serialize CSV records as a lazy 'L.ByteString'.-encode :: ToRecord a => V.Vector a -> L.ByteString+encode :: ToRecord a => [a] -> L.ByteString encode = encodeWith defaultEncodeOptions {-# INLINE encode #-} -- | Efficiently serialize CSV records as a lazy 'L.ByteString'. The -- header is written before any records and dictates the field order.-encodeByName :: ToNamedRecord a => Header -> V.Vector a -> L.ByteString+encodeByName :: ToNamedRecord a => Header -> [a] -> L.ByteString encodeByName = encodeByNameWith defaultEncodeOptions {-# INLINE encodeByName #-} @@ -98,7 +99,7 @@ -- | Like 'decode', but lets you customize how the CSV data is parsed. decodeWith :: FromRecord a => DecodeOptions -- ^ Decoding options- -> Bool -- ^ Data contains header that should be+ -> HasHeader -- ^ Data contains header that should be -- skipped -> L.ByteString -- ^ CSV data -> Either String (Vector a)@@ -111,19 +112,19 @@ -- | Same as 'decodeWith', but more efficient as no type -- conversion is performed.-idDecodeWith :: DecodeOptions -> Bool -> L.ByteString+idDecodeWith :: DecodeOptions -> HasHeader -> L.ByteString -> Either String (Vector (Vector B.ByteString)) idDecodeWith = decodeWithC Parser.csv -- | Decode CSV data using the provided parser, skipping a leading--- header if 'skipHeader' is 'True'. Returns 'Left' @errMsg@ on+-- header if 'hasHeader' is 'HasHeader'. Returns 'Left' @errMsg@ on -- failure.-decodeWithC :: (DecodeOptions -> AL.Parser a) -> DecodeOptions -> Bool+decodeWithC :: (DecodeOptions -> AL.Parser a) -> DecodeOptions -> HasHeader -> BL8.ByteString -> Either String a-decodeWithC p !opts skipHeader = decodeWithP parser- where parser- | skipHeader = header (decDelimiter opts) *> p opts- | otherwise = p opts+decodeWithC p !opts hasHeader = decodeWithP parser+ where parser = case hasHeader of+ HasHeader -> header (decDelimiter opts) *> p opts+ NoHeader -> p opts {-# INLINE decodeWithC #-} -- | Like 'decodeByName', but lets you customize how the CSV data is@@ -145,6 +146,10 @@ -- > myOptions = defaultEncodeOptions { -- > encDelimiter = fromIntegral (ord '\t') -- > }+--+-- /N.B./ The 'encDelimiter' must /not/ be the quote character (i.e.+-- @\"@) or one of the record separator characters (i.e. @\\n@ or+-- @\\r@). data EncodeOptions = EncodeOptions { -- | Field delimiter. encDelimiter :: {-# UNPACK #-} !Word8@@ -158,47 +163,73 @@ -- | Like 'encode', but lets you customize how the CSV data is -- encoded.-encodeWith :: ToRecord a => EncodeOptions -> V.Vector a -> L.ByteString-encodeWith opts = toLazyByteString- . unlines- . map (encodeRecord (encDelimiter opts) . toRecord)- . V.toList+encodeWith :: ToRecord a => EncodeOptions -> [a] -> L.ByteString+encodeWith opts+ | validDelim (encDelimiter opts) =+ toLazyByteString+ . unlines+ . map (encodeRecord (encDelimiter opts) . toRecord)+ | otherwise = encodeOptionsError {-# INLINE encodeWith #-} +-- | Check if the delimiter is valid.+validDelim :: Word8 -> Bool+validDelim delim = delim `notElem` [cr, nl, dquote]+ where+ nl = 10+ cr = 13+ dquote = 34++-- | Raises an exception indicating that the provided delimiter isn't+-- valid. See 'validDelim'.+--+-- Keep this message consistent with the documentation of+-- 'EncodeOptions'.+encodeOptionsError :: a+encodeOptionsError = error $ "Data.Csv: " +++ "The 'encDelimiter' must /not/ be the quote character (i.e. " +++ "\") or one of the record separator characters (i.e. \\n or " +++ "\\r)"+ encodeRecord :: Word8 -> Record -> Builder encodeRecord delim = mconcat . intersperse (fromWord8 delim)- . map fromByteString . map escape . V.toList+ . map fromByteString . map (escape delim) . V.toList {-# INLINE encodeRecord #-} -- TODO: Optimize-escape :: B.ByteString -> B.ByteString-escape s- | B.find (\ b -> b == dquote || b == comma || b == nl || b == cr ||- b == sp) s == Nothing = s- | otherwise =- B.concat ["\"",- B.concatMap- (\ b -> if b == dquote then "\"\"" else B.singleton b) s,- "\""]+escape :: Word8 -> B.ByteString -> B.ByteString+escape !delim !s+ | B.any (\ b -> b == dquote || b == delim || b == nl || b == cr || b == sp)+ s = toByteString $+ fromWord8 dquote+ <> B.foldl+ (\ acc b -> acc <> if b == dquote+ then fromByteString "\"\""+ else fromWord8 b)+ mempty+ s+ <> fromWord8 dquote+ | otherwise = s where dquote = 34- comma = 44 nl = 10 cr = 13 sp = 32 -- | Like 'encodeByName', but lets you customize how the CSV data is -- encoded.-encodeByNameWith :: ToNamedRecord a => EncodeOptions -> Header -> V.Vector a+encodeByNameWith :: ToNamedRecord a => EncodeOptions -> Header -> [a] -> L.ByteString-encodeByNameWith opts hdr v =- toLazyByteString ((encodeRecord (encDelimiter opts) hdr) <>- fromByteString "\r\n" <> records)+encodeByNameWith opts hdr v+ | validDelim (encDelimiter opts) =+ toLazyByteString ((encodeRecord (encDelimiter opts) hdr) <>+ fromByteString "\r\n" <> records)+ | otherwise = encodeOptionsError where records = unlines . map (encodeRecord (encDelimiter opts) . namedRecordToRecord hdr . toNamedRecord)- . V.toList $ v+ $ v {-# INLINE encodeByNameWith #-} @@ -231,8 +262,12 @@ decodeWithP p s = case AL.parse p s of AL.Done _ v -> Right v- AL.Fail left _ msg -> Left $ "parse error (" ++ msg ++ ") at " ++- show (BL8.unpack left)+ AL.Fail left _ msg -> Left errMsg+ where+ errMsg = "parse error (" ++ msg ++ ") at " +++ (if BL8.length left > 100+ then (take 100 $ BL8.unpack left) ++ " (truncated)"+ else show (BL8.unpack left)) {-# INLINE decodeWithP #-} -- These alternative implementation of the 'csv' and 'csvWithHeader'
Data/Csv/Incremental.hs view
@@ -10,10 +10,6 @@ HeaderParser(..) , decodeHeader , decodeHeaderWith- -- ** Providing input- -- $feed-header- , feedChunkH- , feedEndOfInputH -- * Decoding records -- $typeconversion@@ -21,6 +17,7 @@ -- ** Index-based record conversion -- $indexbased+ , HasHeader(..) , decode , decodeWith @@ -28,11 +25,6 @@ -- $namebased , decodeByName , decodeByNameWith-- -- ** Providing input- -- $feed-records- , feedChunk- , feedEndOfInput ) where import Control.Applicative ((<*), (<|>))@@ -106,22 +98,6 @@ appPrec :: Int appPrec = 10 --- | Feed a 'HeaderParser' with more input. If the 'HeaderParser' is--- 'FailH' it will add the input to 'B.ByteString' of unconsumed--- input. If the 'HeaderParser' is 'DoneH' it will drop the extra--- input on the floor.-feedChunkH :: HeaderParser a -> B.ByteString -> HeaderParser a-feedChunkH (FailH rest err) s = FailH (B.append rest s) err-feedChunkH (PartialH k) s = k s-feedChunkH d@(DoneH _ _) _s = d---- | Tell a 'HeaderParser' that there is no more input. This passes--- 'B.empty' to a 'PartialH' parser, otherwise returns the parser--- unchanged.-feedEndOfInputH :: HeaderParser a -> HeaderParser a-feedEndOfInputH (PartialH k) = k B.empty-feedEndOfInputH p = p- -- | Parse a CSV header in an incremental fashion. When done, the -- 'HeaderParser' returns any unconsumed input in the second field of -- the 'DoneH' constructor.@@ -160,20 +136,14 @@ -- the parse error. Fail !B.ByteString String - -- | The parser needs more input data before it can produce a- -- result. Use an 'B.empty' string to indicate that no more- -- input data is available. If fed an 'B.empty' string, the- -- continuation is guaranteed to return either 'Fail' or 'Done'.- | Partial (B.ByteString -> Parser a)-- -- | The parser parsed and converted some records. Any records- -- that failed type conversion are returned as @'Left' errMsg@- -- and the rest as @'Right' val@. Feed a 'B.ByteString' to the- -- continuation to continue parsing. Use an 'B.empty' string to- -- indicate that no more input data is available. If fed an- -- 'B.empty' string, the continuation is guaranteed to return- -- either 'Fail' or 'Done'.- | Some [Either String a] (B.ByteString -> Parser a)+ -- | The parser parsed and converted zero or more records. Any+ -- records that failed type conversion are returned as @'Left'+ -- errMsg@ and the rest as @'Right' val@. Feed a 'B.ByteString'+ -- to the continuation to continue parsing. Use an 'B.empty'+ -- string to indicate that no more input data is available. If+ -- fed an 'B.empty' string, the continuation is guaranteed to+ -- return either 'Fail' or 'Done'.+ | Many [Either String a] (B.ByteString -> Parser a) -- | The parser parsed and converted some records. Any records -- that failed type conversion are returned as @'Left' errMsg@@@ -186,30 +156,14 @@ where showStr = showString "Fail " . showsPrec (appPrec+1) rest . showString " " . showsPrec (appPrec+1) msg- showsPrec _ (Partial _) = showString "Partial <function>"- showsPrec d (Some rs _) = showParen (d > appPrec) showStr+ showsPrec d (Many rs _) = showParen (d > appPrec) showStr where- showStr = showString "Some " . showsPrec (appPrec+1) rs .+ showStr = showString "Many " . showsPrec (appPrec+1) rs . showString " <function>" showsPrec d (Done rs) = showParen (d > appPrec) showStr where showStr = showString "Done " . showsPrec (appPrec+1) rs --- | Feed a 'Parser' with more input. If the 'Parser' is 'Fail' it--- will add the input to 'B.ByteString' of unconsumed input. If the--- 'Parser' is 'Done' it will drop the extra input on the floor.-feedChunk :: Parser a -> B.ByteString -> Parser a-feedChunk (Fail rest err) s = Fail (B.append rest s) err-feedChunk (Partial k) s = k s-feedChunk (Some xs k) s = Some xs (\ s' -> k s `feedChunk` s')-feedChunk (Done xs) _s = Done xs---- | Tell a 'Parser' that there is no more input. This passes 'empty'--- to a 'Partial' parser, otherwise returns the parser unchanged.-feedEndOfInput :: Parser a -> Parser a-feedEndOfInput (Partial k) = k B.empty-feedEndOfInput p = p- -- | Have we read all available input? data More = Incomplete | Complete deriving (Eq, Show)@@ -217,7 +171,7 @@ -- | Efficiently deserialize CSV in an incremental fashion. Equivalent -- to @'decodeWith' 'defaultDecodeOptions'@. decode :: FromRecord a- => Bool -- ^ Data contains header that should be+ => HasHeader -- ^ Data contains header that should be -- skipped -> Parser a decode = decodeWith defaultDecodeOptions@@ -225,14 +179,14 @@ -- | Like 'decode', but lets you customize how the CSV data is parsed. decodeWith :: FromRecord a => DecodeOptions -- ^ Decoding options- -> Bool -- ^ Data contains header that should be+ -> HasHeader -- ^ Data contains header that should be -- skipped -> Parser a-decodeWith !opts skipHeader- | skipHeader = Partial $ \ s -> go (decodeHeaderWith opts `feedChunkH` s)- | otherwise = Partial (decodeWithP parseRecord opts)+decodeWith !opts hasHeader = case hasHeader of+ HasHeader -> go (decodeHeaderWith opts)+ NoHeader -> Many [] $ \ s -> decodeWithP parseRecord opts s where go (FailH rest msg) = Fail rest msg- go (PartialH k) = Partial $ \ s' -> go (k s')+ go (PartialH k) = Many [] $ \ s' -> go (k s') go (DoneH _ rest) = decodeWithP parseRecord opts rest ------------------------------------------------------------------------@@ -250,8 +204,7 @@ decodeByNameWith :: FromNamedRecord a => DecodeOptions -- ^ Decoding options -> HeaderParser (Parser a)-decodeByNameWith !opts =- PartialH (go . (decodeHeaderWith opts `feedChunkH`))+decodeByNameWith !opts = go (decodeHeaderWith opts) where go (FailH rest msg) = FailH rest msg go (PartialH k) = PartialH $ \ s -> go (k s)@@ -260,6 +213,9 @@ ------------------------------------------------------------------------ +-- TODO: 'decodeWithP' should probably not take an initial+-- 'B.ByteString' input.+ -- | Like 'decode', but lets you customize how the CSV data is parsed. decodeWithP :: (Record -> Conversion.Parser a) -> DecodeOptions -> B.ByteString -> Parser a@@ -267,11 +223,9 @@ where go !_ !acc (A.Fail rest _ msg) | null acc = Fail rest err- | otherwise = Some (reverse acc) (\ s -> Fail (rest `B.append` s) err)+ | otherwise = Many (reverse acc) (\ s -> Fail (rest `B.append` s) err) where err = "parse error (" ++ msg ++ ")"- go Incomplete acc (A.Partial k)- | null acc = Partial cont- | otherwise = Some (reverse acc) cont+ go Incomplete acc (A.Partial k) = Many (reverse acc) cont where cont s = go m [] (k s) where m | B.null s = Complete | otherwise = Incomplete@@ -280,9 +234,7 @@ go m acc (A.Done rest r) | B.null rest = case m of Complete -> Done (reverse acc')- Incomplete- | null acc' -> Partial (cont acc')- | otherwise -> Some (reverse acc') (cont [])+ Incomplete -> Many (reverse acc') (cont []) | otherwise = go m acc' (parser rest) where cont acc'' s | B.null s = Done (reverse acc'')
Data/Csv/Parser.hs view
@@ -26,12 +26,10 @@ import Blaze.ByteString.Builder (fromByteString, toByteString) import Blaze.ByteString.Builder.Char.Utf8 (fromChar)-import Control.Applicative (Alternative, (*>), (<$>), (<*), (<|>), optional,- pure)+import Control.Applicative ((*>), (<$>), (<*), optional, pure) import Data.Attoparsec.Char8 (char, endOfInput, endOfLine) import qualified Data.Attoparsec as A import qualified Data.Attoparsec.Lazy as AL-import Data.Attoparsec.Types (Parser) import qualified Data.Attoparsec.Zepto as Z import qualified Data.ByteString as S import qualified Data.ByteString.Unsafe as S@@ -40,7 +38,7 @@ import Data.Word (Word8) import Data.Csv.Types-import Data.Csv.Util ((<$!>), blankLine)+import Data.Csv.Util ((<$!>), blankLine, liftM2') -- | Options that controls how data is decoded. These options can be -- used to e.g. decode tab-separated data instead of comma-separated@@ -67,36 +65,49 @@ -- | Parse a CSV file that does not include a header. csv :: DecodeOptions -> AL.Parser Csv csv !opts = do- vals <- record (decDelimiter opts) `sepBy1'` endOfLine+ vals <- sepByEndOfLine1' (record (decDelimiter opts)) _ <- optional endOfLine endOfInput let nonEmpty = removeBlankLines vals return $! V.fromList nonEmpty {-# INLINE csv #-} --- | @sepBy1' p sep@ applies /one/ or more occurrences of @p@,--- separated by @sep@. Returns a list of the values returned by @p@.--- The value returned by @p@ is forced to WHNF.------ > commaSep p = p `sepBy1'` (symbol ",")-sepBy1' :: (Alternative f, Monad f) => f a -> f s -> f [a]-sepBy1' p s = go+-- | Specialized version of 'sepBy1'' which is faster due to not+-- accepting an arbitrary separator.+sepByDelim1' :: AL.Parser a+ -> Word8 -- ^ Field delimiter+ -> AL.Parser [a]+sepByDelim1' p !delim = liftM2' (:) p loop where- go = do- !a <- p- as <- (s *> go) <|> pure []- return (a : as)-#if __GLASGOW_HASKELL__ >= 700-{-# SPECIALIZE sepBy1' :: Parser S.ByteString a -> Parser S.ByteString s- -> Parser S.ByteString [a] #-}-#endif+ loop = do+ mb <- A.peekWord8+ case mb of+ Just b | b == delim -> liftM2' (:) (A.anyWord8 *> p) loop+ _ -> pure []+{-# INLINe sepByDelim1' #-} +-- | Specialized version of 'sepBy1'' which is faster due to not+-- accepting an arbitrary separator.+sepByEndOfLine1' :: AL.Parser a+ -> AL.Parser [a]+sepByEndOfLine1' p = liftM2' (:) p loop+ where+ loop = do+ mb <- A.peekWord8+ case mb of+ Just b | b == cr ->+ liftM2' (:) (A.anyWord8 *> A.word8 newline *> p) loop+ | b == newline ->+ liftM2' (:) (A.anyWord8 *> p) loop+ _ -> pure []+{-# INLINe sepByEndOfLine1' #-}+ -- | Parse a CSV file that includes a header. csvWithHeader :: DecodeOptions -> AL.Parser (Header, V.Vector NamedRecord) csvWithHeader !opts = do !hdr <- header (decDelimiter opts) vals <- map (toNamedRecord hdr) . removeBlankLines <$>- (record (decDelimiter opts)) `sepBy1'` endOfLine+ sepByEndOfLine1' (record (decDelimiter opts)) _ <- optional endOfLine endOfInput let !v = V.fromList vals@@ -105,7 +116,7 @@ -- | Parse a header, including the terminating line separator. header :: Word8 -- ^ Field delimiter -> AL.Parser Header-header !delim = V.fromList <$!> name delim `sepBy1'` (A.word8 delim) <* endOfLine+header !delim = V.fromList <$!> name delim `sepByDelim1'` delim <* endOfLine -- | Parse a header name. Header names have the same format as regular -- 'field's.@@ -122,9 +133,7 @@ -- this parser. record :: Word8 -- ^ Field delimiter -> AL.Parser Record-record !delim = do- fs <- field delim `sepBy1'` (A.word8 delim)- return $! V.fromList fs+record !delim = V.fromList <$!> field delim `sepByDelim1'` delim {-# INLINE record #-} -- | Parse a field. The field may be in either the escaped or
Data/Csv/Streaming.hs view
@@ -18,6 +18,7 @@ -- ** Index-based record conversion -- $indexbased+ , HasHeader(..) , decode , decodeWith @@ -51,7 +52,7 @@ -- -- A short usage example: ----- > for_ (decode False "John,27\r\nJane,28\r\n") $ \ (name, age :: Int) ->+-- > for_ (decode NoHeader "John,27\r\nJane,28\r\n") $ \ (name, age :: Int) -> -- > putStrLn $ name ++ " is " ++ show age ++ " years old" -- -- N.B. The 'Foldable' instance, which is used above, skips records@@ -136,7 +137,7 @@ -- | Efficiently deserialize CSV records in a streaming fashion. -- Equivalent to @'decodeWith' 'defaultDecodeOptions'@. decode :: FromRecord a- => Bool -- ^ Data contains header that should be+ => HasHeader -- ^ Data contains header that should be -- skipped -> BL.ByteString -- ^ CSV data -> Records a@@ -145,20 +146,17 @@ -- | Like 'decode', but lets you customize how the CSV data is parsed. decodeWith :: FromRecord a => DecodeOptions -- ^ Decoding options- -> Bool -- ^ Data contains header that should be+ -> HasHeader -- ^ Data contains header that should be -- skipped -> BL.ByteString -- ^ CSV data -> Records a-decodeWith !opts skipHeader s0 = case BL.toChunks s0 of- [] -> go [] (feedEndOfInput $ I.decodeWith opts skipHeader)- (s:ss) -> go ss (I.decodeWith opts skipHeader `feedChunk` s)+decodeWith !opts hasHeader s0 =+ go (BL.toChunks s0) (I.decodeWith 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))- go [] (Partial k) = go [] (k B.empty)- go (s:ss) (Partial k) = go ss (k s)- go [] (Some xs k) = foldr Cons (go [] (k B.empty)) xs- go (s:ss) (Some xs k) = foldr Cons (go ss (k s)) xs+ go [] (Many xs k) = foldr Cons (go [] (k B.empty)) xs+ go (s:ss) (Many xs k) = foldr Cons (go ss (k s)) xs -- | Efficiently deserialize CSV in a streaming fashion. The data is -- assumed to be preceeded by a header. Returns @'Left' errMsg@ if@@ -177,9 +175,7 @@ => DecodeOptions -- ^ Decoding options -> BL.ByteString -- ^ CSV data -> Either String (Header, Records a)-decodeByNameWith !opts s0 = case BL.toChunks s0 of- [] -> go [] (feedEndOfInputH $ I.decodeByNameWith opts)- (s:ss) -> go ss (I.decodeByNameWith opts `feedChunkH` s)+decodeByNameWith !opts s0 = go (BL.toChunks s0) (I.decodeByNameWith opts) where go ss (DoneH hdr p) = Right (hdr, go2 ss p) go ss (FailH rest err) = Left $ err ++ " at " ++@@ -189,7 +185,5 @@ go2 ss (Done xs) = foldr Cons (Nil Nothing (BL.fromChunks ss)) xs go2 ss (Fail rest err) = Nil (Just err) (BL.fromChunks (rest:ss))- go2 [] (Partial k) = go2 [] (k B.empty)- go2 (s:ss) (Partial k) = go2 ss (k s)- go2 [] (Some xs k) = foldr Cons (go2 [] (k B.empty)) xs- go2 (s:ss) (Some xs k) = foldr Cons (go2 ss (k s)) xs+ go2 [] (Many xs k) = foldr Cons (go2 [] (k B.empty)) xs+ go2 (s:ss) (Many xs k) = foldr Cons (go2 ss (k s)) xs
Data/Csv/Types.hs view
@@ -8,6 +8,9 @@ , NamedRecord , Field , toNamedRecord++ -- * Header handling+ , HasHeader(..) ) where import qualified Data.ByteString as S@@ -41,3 +44,7 @@ -- The 'Header' and 'Record' must be of the same length. toNamedRecord :: Header -> Record -> NamedRecord toNamedRecord hdr v = HM.fromList . V.toList $ V.zip hdr v++-- | Is the CSV data preceded by a header?+data HasHeader = HasHeader -- ^ The CSV data is preceded by a header+ | NoHeader -- ^ The CSV data is not preceded by a header
Data/Csv/Util.hs view
@@ -1,6 +1,9 @@+{-# LANGUAGE BangPatterns #-}+ module Data.Csv.Util- ((<$!>)+ ( (<$!>) , blankLine+ , liftM2' ) where import qualified Data.ByteString as B@@ -18,3 +21,12 @@ -- | 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))++-- | 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)+{-# INLINE liftM2' #-}
benchmarks/Benchmarks.hs view
@@ -1,10 +1,11 @@-{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,+{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, OverloadedStrings, RecordWildCards, TypeSynonymInstances #-} {-# OPTIONS_GHC -funbox-strict-fields #-} module Main ( main ) where import Control.Applicative+import Control.Exception (evaluate) import Control.DeepSeq import Criterion.Main import Data.ByteString (ByteString)@@ -20,6 +21,11 @@ import Data.Csv import qualified Data.Csv.Streaming as Streaming +#if !MIN_VERSION_bytestring(0,10,0)+instance NFData (B.ByteString) where+ rnf s = ()+#endif+ data President = President { presidency :: !Int , president :: !Text@@ -91,7 +97,7 @@ rnf (LazyCsv.IncorrectRow !_ !_ !_ xs) = rnf xs rnf (LazyCsv.BlankLine _ _ _ field) = rnf field rnf (LazyCsv.FieldError field) = rnf field- rnf (LazyCsv.DuplicateHeader _ s) = rnf s+ rnf (LazyCsv.DuplicateHeader _ _ s) = rnf s rnf LazyCsv.NoData = () main :: IO ()@@ -99,8 +105,10 @@ !csvData <- fromStrict `fmap` B.readFile "benchmarks/presidents.csv" !csvDataN <- fromStrict `fmap` B.readFile "benchmarks/presidents_with_header.csv"- let (Right !presidents) = decodePresidents csvData- (Right (!hdr, !presidentsN)) = decodePresidentsN csvDataN+ let (Right !presidents) = V.toList <$> decodePresidents csvData+ (Right (!hdr, !presidentsNV)) = decodePresidentsN csvDataN+ !presidentsN = V.toList presidentsNV+ evaluate (rnf [presidents, presidentsN]) defaultMain [ bgroup "positional" [ bgroup "decode"@@ -130,19 +138,19 @@ ] where decodePresidents :: BL.ByteString -> Either String (Vector President)- decodePresidents = decode False+ decodePresidents = decode NoHeader decodePresidentsN :: BL.ByteString -> Either String (Header, Vector President) decodePresidentsN = decodeByName decodePresidentsS :: BL.ByteString -> Streaming.Records President- decodePresidentsS = Streaming.decode False+ decodePresidentsS = Streaming.decode NoHeader idDecode :: BL.ByteString -> Either String (Vector (Vector B.ByteString))- idDecode = decode False+ idDecode = decode NoHeader idDecodeN :: BL.ByteString -> Either String (Header, Vector (BSHashMap B.ByteString)) idDecodeN = decodeByName idDecodeS :: BL.ByteString -> Streaming.Records (Vector B.ByteString)- idDecodeS = Streaming.decode False+ idDecodeS = Streaming.decode NoHeader
cassava.cabal view
@@ -1,5 +1,5 @@ Name: cassava-Version: 0.2.2.0+Version: 0.3.0.0 Synopsis: A CSV parsing and encoding library Description: A CSV parsing and encoding library optimized for ease of use and high@@ -35,7 +35,7 @@ Data.Csv.Util Build-depends:- array < 0.5,+ array < 0.6, attoparsec >= 0.10.2 && < 0.11, base < 5, blaze-builder < 0.4,@@ -81,7 +81,7 @@ cassava, criterion, deepseq,- lazy-csv,+ lazy-csv >= 0.5, text, unordered-containers, vector
examples/IncrementalIndexedBasedDecode.hs view
@@ -9,8 +9,7 @@ main :: IO () main = withFile "salaries.csv" ReadMode $ \ csvFile -> do let loop !_ (Fail _ errMsg) = putStrLn errMsg >> exitFailure- loop acc (Partial k) = loop acc =<< feed k- loop acc (Some rs k) = loop (acc + sumSalaries rs) =<< feed k+ loop acc (Many rs k) = loop (acc + sumSalaries rs) =<< feed k loop acc (Done rs) = putStrLn $ "Total salaries: " ++ show (sumSalaries rs + acc) @@ -19,6 +18,6 @@ if isEof then return $ k B.empty else k `fmap` B.hGetSome csvFile 4096- loop 0 (decode False)+ loop 0 (decode NoHeader) where sumSalaries rs = sum [salary | Right (_ :: String, salary :: Int) <- rs]
examples/IndexBasedDecode.hs view
@@ -7,7 +7,7 @@ main :: IO () main = do csvData <- BL.readFile "salaries.csv"- case decode False csvData of+ case decode NoHeader csvData of Left err -> putStrLn err Right v -> V.forM_ v $ \ (name, salary :: Int) -> putStrLn $ name ++ " earns " ++ show salary ++ " dollars"
examples/IndexBasedGeneric.hs view
@@ -15,9 +15,9 @@ main :: IO () main = do- BL.writeFile "salaries.csv" $ encode (V.fromList persons)+ BL.writeFile "salaries.csv" $ encode persons csvData <- BL.readFile "salaries.csv"- case decode False csvData of+ case decode NoHeader csvData of Left err -> putStrLn err Right v -> V.forM_ v $ \ (Person name salary) -> putStrLn $ name ++ " earns " ++ show salary ++ " dollars"
examples/NamedBasedGeneric.hs view
@@ -19,7 +19,7 @@ main :: IO () main = do- BL.writeFile "salaries.csv" $ encodeByName (V.fromList ["name", "salary"]) (V.fromList persons)+ BL.writeFile "salaries.csv" $ encodeByName (V.fromList ["name", "salary"]) persons csvData <- BL.readFile "salaries.csv" case decodeByName csvData of Left err -> putStrLn err
examples/StreamingIndexBasedDecode.hs view
@@ -9,5 +9,5 @@ csvData <- BL.readFile "salaries.csv" -- N.B. The Foldable instance skips records that failed to -- convert.- for_ (decode False csvData) $ \ (name, salary :: Int) ->+ for_ (decode NoHeader csvData) $ \ (name, salary :: Int) -> putStrLn $ name ++ " earns " ++ show salary ++ " dollars"
tests/UnitTests.hs view
@@ -27,11 +27,11 @@ -- Parse tests decodesAs :: BL.ByteString -> [[B.ByteString]] -> Assertion-decodesAs input expected = assertResult input expected $ decode False input+decodesAs input expected = assertResult input expected $ decode NoHeader input decodesWithAs :: DecodeOptions -> BL.ByteString -> [[B.ByteString]] -> Assertion decodesWithAs opts input expected =- assertResult input expected $ decodeWith opts False input+ assertResult input expected $ decodeWith opts NoHeader input assertResult :: BL.ByteString -> [[B.ByteString]] -> Either String (V.Vector (V.Vector B.ByteString)) -> Assertion@@ -43,17 +43,16 @@ encodesAs :: [[B.ByteString]] -> BL.ByteString -> Assertion encodesAs input expected =- encode (V.fromList (map V.fromList input)) @?= expected+ encode (map V.fromList input) @?= expected encodesWithAs :: EncodeOptions -> [[B.ByteString]] -> BL.ByteString -> Assertion encodesWithAs opts input expected =- encodeWith opts (V.fromList (map V.fromList input)) @?= expected+ encodeWith opts (map V.fromList input) @?= expected namedEncodesAs :: [B.ByteString] -> [[(B.ByteString, B.ByteString)]] -> BL.ByteString -> Assertion namedEncodesAs hdr input expected =- encodeByName (V.fromList hdr)- (V.fromList $ map HM.fromList input) @?= expected+ encodeByName (V.fromList hdr) (map HM.fromList input) @?= expected namedDecodesAs :: BL.ByteString -> [B.ByteString] -> [[(B.ByteString, B.ByteString)]] -> Assertion@@ -76,13 +75,13 @@ decodesStreamingAs :: BL.ByteString -> [[B.ByteString]] -> Assertion decodesStreamingAs input expected = assertResult input expected $ fmap (V.fromList . map V.fromList) $- recordsToList $ S.decode False input+ recordsToList $ S.decode NoHeader input decodesWithStreamingAs :: DecodeOptions -> BL.ByteString -> [[B.ByteString]] -> Assertion decodesWithStreamingAs opts input expected = assertResult input expected $ fmap (V.fromList . map V.fromList) $- recordsToList $ S.decodeWith opts False input+ recordsToList $ S.decodeWith opts NoHeader input namedDecodesStreamingAs :: BL.ByteString -> [B.ByteString] -> [[(B.ByteString, B.ByteString)]] -> Assertion@@ -209,13 +208,14 @@ -- 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 record == decode False (encode record) - where record = V.singleton (x, dummy)+roundTrip x = Right (V.fromList record) == decode NoHeader (encode record) + where record = [(x, dummy)] dummy = 'a' roundTripUnicode :: T.Text -> Assertion-roundTripUnicode x = Right record @=? decode False (encode record)- where record = V.singleton (x, dummy)+roundTripUnicode x = Right (V.fromList record) @=?+ decode NoHeader (encode record)+ where record = [(x, dummy)] dummy = 'a' boundary :: forall a. (Bounded a, Eq a, FromField a, ToField a) => a -> Bool@@ -264,12 +264,32 @@ ] ------------------------------------------------------------------------+-- Custom options tests++customDelim :: Word8 -> B.ByteString -> B.ByteString -> Property+customDelim delim f1 f2 = delim `notElem` [cr, nl, dquote] ==>+ (decodeWith decOpts NoHeader (encodeWith encOpts [V.fromList [f1, f2]]) ==+ Right (V.fromList [V.fromList [f1, f2]]))+ where+ encOpts = defaultEncodeOptions { encDelimiter = delim }+ decOpts = defaultDecodeOptions { decDelimiter = delim }+ nl = 10+ cr = 13+ dquote = 34++customOptionsTests :: [TF.Test]+customOptionsTests =+ [ testProperty "customDelim" customDelim+ ]++------------------------------------------------------------------------ -- Test harness allTests :: [TF.Test] allTests = [ testGroup "positional" positionalTests , testGroup "named" nameBasedTests , testGroup "conversion" conversionTests+ , testGroup "custom-options" customOptionsTests ] main :: IO ()