cassava 0.1.0.1 → 0.2.0.0

raw patch · 16 files changed

+942/−100 lines, 16 filesdep +ghc-primdep ~arraydep ~attoparsecdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim

Dependency ranges changed: array, attoparsec, base, blaze-builder, text, vector

API changes (from Hackage documentation)

Files

• Data/Csv.hs +25/−1
• Data/Csv/Compat/Monoid.hs +14/−0
• Data/Csv/Conversion.hs +160/−21
• Data/Csv/Conversion/Internal.hs +2/−1
• Data/Csv/Encoding.hs +70/−13
• Data/Csv/Incremental.hs +304/−0
• Data/Csv/Parser.hs +34/−11
• Data/Csv/Streaming.hs +130/−0
• Data/Csv/Util.hs +10/−0
• benchmarks/Benchmarks.hs +2/−2
• cassava.cabal +18/−10
• examples/IncrementalIndexedBasedDecode.hs +24/−0
• examples/IndexBasedDecode.hs +1/−1
• examples/IndexBasedGeneric.hs +23/−0
• examples/NamedBasedGeneric.hs +27/−0
• tests/UnitTests.hs +98/−40

@@ -14,6 +14,9 @@     -- * Usage example     -- $example +    -- * Treating CSV data as opaque byte strings+    -- $generic-processing+     -- * Encoding and decoding     -- $encoding       decode@@ -85,9 +88,30 @@ -- -- A short decoding usage example: ----- @ >>> 'decode' \"John,27\\r\\nJane,28\\r\\n\" :: Either String (Vector (Text, Int))+-- @ >>> 'decode' 'False' \"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+-- input data isn't preceded by a header.+--+-- In practice, the return type of 'decode' rarely needs to be given,+-- as it can often be inferred from the context.++-- $generic-processing+--+-- Sometimes you might want to work with a CSV file which contents is+-- unknown to you. For example, you might want remove the second+-- column of a file without knowing anything about its content. To+-- 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))+-- Right (fromList [fromList [\"John\",\"27\"],fromList [\"Jane\",\"28\"]])+-- @+--+-- As the example output above shows, all the fields are returned as+-- uninterpreted 'ByteString' values.  -- $encoding --

@@ -0,0 +1,14 @@+{-# LANGUAGE CPP #-}+module Data.Csv.Compat.Monoid+    ( (<>)+    ) where++import Data.Monoid++#if !MIN_VERSION_base(4,5,0)+infixr 6 <>+-- | An infix synonym for 'mappend'.+(<>) :: Monoid m => m -> m -> m+(<>) = mappend+{-# INLINE (<>) #-}+#endif

@@ -1,4 +1,9 @@-{-# LANGUAGE FlexibleInstances, OverloadedStrings, Rank2Types #-}+{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, OverloadedStrings,+             Rank2Types #-}+#ifdef GENERICS+{-# LANGUAGE DefaultSignatures, TypeOperators, KindSignatures, FlexibleContexts,+             MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables #-}+#endif module Data.Csv.Conversion     (     -- * Type conversion@@ -14,6 +19,7 @@     , Result(..)     , Parser     , parse+    , parseEither      -- * Accessors     , (.!)@@ -40,6 +46,7 @@ import Data.Traversable import Data.Vector (Vector, (!)) import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U import Data.Word import GHC.Float (double2Float) import Prelude hiding (takeWhile)@@ -47,6 +54,11 @@ import Data.Csv.Conversion.Internal import Data.Csv.Types +#ifdef GENERICS+import GHC.Generics+import qualified Data.IntMap as IM+#endif+ ------------------------------------------------------------------------ -- Type conversion @@ -78,6 +90,11 @@ -- @ class FromRecord a where     parseRecord :: Record -> Parser a+  +#ifdef GENERICS+    default parseRecord :: (Generic a, GFromRecord (Rep a)) => Record -> Parser a+    parseRecord r = to <$> gparseRecord r+#endif  -- | Haskell lacks a single-element tuple type, so if you CSV data -- with just one column you can use the 'Only' type to represent a@@ -104,6 +121,11 @@ class ToRecord a where     toRecord :: a -> Record +#ifdef GENERICS+    default toRecord :: (Generic a, GToRecord (Rep a) Field) => a -> Record+    toRecord = V.fromList . gtoRecord . from+#endif+ instance FromField a => FromRecord (Only a) where     parseRecord v         | n == 1    = Only <$> parseField (V.unsafeIndex v 0)@@ -237,6 +259,12 @@ instance ToField a => ToRecord (Vector a) where     toRecord = V.map toField +instance (FromField a, U.Unbox a) => FromRecord (U.Vector a) where+    parseRecord = fmap U.convert . traverse parseField++instance (ToField a, U.Unbox a) => ToRecord (U.Vector a) where+    toRecord = V.map toField . U.convert+ ------------------------------------------------------------------------ -- Name-based conversion @@ -270,6 +298,11 @@ class FromNamedRecord a where     parseNamedRecord :: NamedRecord -> Parser a +#ifdef GENERICS+    default parseNamedRecord :: (Generic a, GFromNamedRecord (Rep a)) => NamedRecord -> Parser a+    parseNamedRecord r = to <$> gparseNamedRecord r+#endif+ -- | A type that can be converted to a single CSV record. -- -- An example type and instance:@@ -283,6 +316,11 @@ class ToNamedRecord a where     toNamedRecord :: a -> NamedRecord +#ifdef GENERICS+    default toNamedRecord :: (Generic a, GToRecord (Rep a) (B.ByteString, B.ByteString)) => a -> NamedRecord+    toNamedRecord = namedRecord . gtoRecord . from+#endif+ instance FromField a => FromNamedRecord (M.Map B.ByteString a) where     parseNamedRecord m = M.fromList <$>                          (traverse parseSnd $ HM.toList m)@@ -339,6 +377,18 @@ class ToField a where     toField :: a -> Field +-- | 'Nothing' if the field is empty, 'Just' otherwise.+instance FromField a => FromField (Maybe a) where+    parseField s+        | B.null s  = pure Nothing+        | otherwise = Just <$> parseField s+    {-# INLINE parseField #-}++-- | 'Nothing' is encoded as an empty field.+instance ToField a => ToField (Maybe a) where+    toField = maybe B.empty toField+    {-# INLINE toField #-}+ instance FromField Char where     parseField s         | T.compareLength t 1 == EQ = pure (T.head t)@@ -460,29 +510,12 @@     toField = decimal     {-# INLINE toField #-} --- 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,-                  "\""]-  where-    dquote = 34-    comma  = 44-    nl     = 10-    cr     = 13-    sp     = 32- instance FromField B.ByteString where     parseField = pure     {-# INLINE parseField #-}  instance ToField B.ByteString where-    toField = escape+    toField = id     {-# INLINE toField #-}  instance FromField L.ByteString where@@ -678,7 +711,113 @@   return (b a) {-# INLINE apP #-} --- | Run a 'Parser'.+-- | Run a 'Parser'. Forces the value in the 'Success' or 'Error'+-- constructors to weak head normal form. parse :: Parser a -> Result a-parse p = runParser p Error Success+parse p = runParser p err success+  where+    err !errMsg = Error errMsg+    success !x = Success x {-# INLINE parse #-}++-- | Run a 'Parser', returning either @'Left' msg@ or @'Right'+-- result@. Forces the value in the 'Left' or 'Right' constructors to+-- weak head normal form.+parseEither :: Parser a -> Either String a+parseEither p = runParser p left right+  where+    left !errMsg = Left errMsg+    right !x = Right x+{-# INLINE parseEither #-}++#ifdef GENERICS++class GFromRecord f where+    gparseRecord :: Record -> Parser (f p)++instance GFromRecordSum f Record => GFromRecord (M1 i n f) where+    gparseRecord v = +        case (IM.lookup n gparseRecordSum) of+            Nothing -> lengthMismatch n v +            Just p -> M1 <$> p v+      where+        n = V.length v++class GFromNamedRecord f where+    gparseNamedRecord :: NamedRecord -> Parser (f p)++instance GFromRecordSum f NamedRecord => GFromNamedRecord (M1 i n f) where+    gparseNamedRecord v = +        foldr (\f p -> p <|> M1 <$> f v) empty (IM.elems gparseRecordSum)+++class GFromRecordSum f r where+    gparseRecordSum :: IM.IntMap (r -> Parser (f p))++instance (GFromRecordSum a r, GFromRecordSum b r) => GFromRecordSum (a :+: b) r where+    gparseRecordSum = +        IM.unionWith (\a b r -> a r <|> b r) +            (fmap (L1 <$>) <$> gparseRecordSum)+            (fmap (R1 <$>) <$> gparseRecordSum)++instance GFromRecordProd f r => GFromRecordSum (M1 i n f) r where+    gparseRecordSum = IM.singleton n (fmap (M1 <$>) f)+      where+        (n, f) = gparseRecordProd 0++class GFromRecordProd f r where+    gparseRecordProd :: Int -> (Int, r -> Parser (f p))++instance GFromRecordProd U1 r where+    gparseRecordProd n = (n, const (pure U1))++instance (GFromRecordProd a r, GFromRecordProd b r) => GFromRecordProd (a :*: b) r where+    gparseRecordProd n0 = (n2, f)+      where+        f r = (:*:) <$> fa r <*> fb r+        (n1, fa) = gparseRecordProd n0+        (n2, fb) = gparseRecordProd n1++instance GFromRecordProd f Record => GFromRecordProd (M1 i n f) Record where+    gparseRecordProd n = fmap (M1 <$>) <$> gparseRecordProd n++instance FromField a => GFromRecordProd (K1 i a) Record where+    gparseRecordProd n = (n + 1, \v -> K1 <$> parseField (V.unsafeIndex v n))++data Proxy s (f :: * -> *) a = Proxy++instance (FromField a, Selector s) => GFromRecordProd (M1 S s (K1 i a)) NamedRecord where+    gparseRecordProd n = (n + 1, \v -> (M1 . K1) <$> v .: name)+      where+        name = T.encodeUtf8 (T.pack (selName (Proxy :: Proxy s f a)))+++class GToRecord a f where+    gtoRecord :: a p -> [f]++instance GToRecord U1 f where+    gtoRecord U1 = []++instance (GToRecord a f, GToRecord b f) => GToRecord (a :*: b) f where+    gtoRecord (a :*: b) = gtoRecord a ++ gtoRecord b++instance (GToRecord a f, GToRecord b f) => GToRecord (a :+: b) f where+    gtoRecord (L1 a) = gtoRecord a+    gtoRecord (R1 b) = gtoRecord b++instance GToRecord a f => GToRecord (M1 D c a) f where+    gtoRecord (M1 a) = gtoRecord a++instance GToRecord a f => GToRecord (M1 C c a) f where+    gtoRecord (M1 a) = gtoRecord a++instance GToRecord a Field => GToRecord (M1 S c a) Field where+    gtoRecord (M1 a) = gtoRecord a++instance ToField a => GToRecord (K1 i a) Field where+    gtoRecord (K1 a) = [toField a]++instance (ToField a, Selector s) => GToRecord (M1 S s (K1 i a)) (B.ByteString, B.ByteString) where+    gtoRecord m@(M1 (K1 a)) = [T.encodeUtf8 (T.pack (selName m)) .= toField a]++#endif

@@ -10,8 +10,9 @@ import qualified Data.ByteString as B import Data.Char (ord) import Data.Int-import Data.Monoid import Data.Word++import Data.Csv.Compat.Monoid ((<>))  ------------------------------------------------------------------------ -- Integers

@@ -37,16 +37,17 @@ import qualified Data.ByteString.Lazy as L import qualified Data.ByteString.Lazy.Char8 as BL8 import qualified Data.HashMap.Strict as HM-import Data.Monoid-import Data.Traversable+import Data.Monoid (mconcat, mempty) import Data.Vector (Vector) import qualified Data.Vector as V import Data.Word (Word8) import Prelude hiding (unlines) +import Data.Csv.Compat.Monoid ((<>)) import Data.Csv.Conversion import Data.Csv.Parser import Data.Csv.Types+import Data.Csv.Util ((<$!>))  -- TODO: 'encode' isn't as efficient as it could be. @@ -56,7 +57,11 @@ -- | Efficiently deserialize CSV records from a lazy 'L.ByteString'. -- If this fails due to incomplete or invalid input, @'Left' msg@ is -- returned. Equivalent to @'decodeWith' 'defaultDecodeOptions'@.-decode :: FromRecord a => L.ByteString -> Either String (Vector a)+decode :: FromRecord a+       => Bool          -- ^ Data contains header that should be+                        -- skipped+       -> L.ByteString  -- ^ CSV data+       -> Either String (Vector a) decode = decodeWith defaultDecodeOptions {-# INLINE decode #-} @@ -64,47 +69,80 @@ -- If this fails due to incomplete or invalid input, @'Left' msg@ is -- returned. The data is assumed to be preceeded by a header. -- Equivalent to @'decodeByNameWith' 'defaultDecodeOptions'@.-decodeByName :: FromNamedRecord a => L.ByteString-                 -> Either String (Header, Vector a)+decodeByName :: FromNamedRecord a+             => L.ByteString  -- ^ CSV data+             -> Either String (Header, Vector a) decodeByName = decodeByNameWith defaultDecodeOptions {-# INLINE decodeByName #-}  -- | Efficiently serialize CVS records as a lazy 'L.ByteString'. encode :: ToRecord a => V.Vector a -> L.ByteString encode = encodeWith defaultEncodeOptions+{-# INLINE encode #-}  -- | Efficiently serialize CVS 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 = encodeByNameWith defaultEncodeOptions+{-# INLINE encodeByName #-}  ------------------------------------------------------------------------ -- ** Encoding and decoding options  -- | Like 'decode', but lets you customize how the CSV data is parsed.-decodeWith :: FromRecord a => DecodeOptions -> L.ByteString+decodeWith :: FromRecord a+           => DecodeOptions  -- ^ Decoding options+           -> Bool           -- ^ Data contains header that should be+                             -- skipped+           -> L.ByteString   -- ^ CSV data            -> Either String (Vector a)-decodeWith !opts = decodeWithP (csv opts) (parse . traverse parseRecord)+decodeWith = decodeWithC (parse . parseCsv) {-# INLINE [1] decodeWith #-} +parseCsv :: FromRecord a => Csv -> Parser (Vector a)+parseCsv xs = V.fromList <$!> mapM' parseRecord (V.toList xs)++mapM' :: Monad m => (a -> m b) -> [a] -> m [b]+mapM' f = go+  where+    go [] = return []+    go (x:xs) = do+        !y <- f x+        ys <- go xs+        return (y : ys)+{-# INLINE mapM' #-}+ {-# RULES     "idDecodeWith" decodeWith = idDecodeWith  #-}  -- | Same as 'decodeWith', but more efficient as no type -- conversion is performed.-idDecodeWith :: DecodeOptions -> L.ByteString+idDecodeWith :: DecodeOptions -> Bool -> L.ByteString              -> Either String (Vector (Vector B.ByteString))-idDecodeWith !opts = decodeWithP (csv opts) pure+idDecodeWith = decodeWithC pure +decodeWithC :: (Csv -> Result a) -> DecodeOptions -> Bool -> L.ByteString+            -> Either String a+decodeWithC convert !opts skipHeader = decodeWithP parser convert+  where parser+            | skipHeader = header (decDelimiter opts) *> csv opts+            | otherwise  = csv opts+{-# INLINE decodeWithC #-}+ -- | Like 'decodeByName', but lets you customize how the CSV data is -- parsed.-decodeByNameWith :: FromNamedRecord a => DecodeOptions -> L.ByteString-                     -> Either String (Header, Vector a)+decodeByNameWith :: FromNamedRecord a+                 => DecodeOptions  -- ^ Decoding options+                 -> L.ByteString   -- ^ CSV data+                 -> Either String (Header, Vector a) decodeByNameWith !opts =     decodeWithP (csvWithHeader opts)-    (\ (hdr, vs) -> (,) <$> pure hdr <*> (parse $ traverse parseNamedRecord vs))+    (\ (hdr, vs) -> (,) <$> pure hdr <*> (parse $ parseNamedCsv vs)) +parseNamedCsv :: FromNamedRecord a => Vector NamedRecord -> Parser (Vector a)+parseNamedCsv xs = V.fromList <$!> mapM' parseNamedRecord (V.toList xs)+ -- | 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.@@ -126,12 +164,30 @@                   . unlines                   . map (encodeRecord (encDelimiter opts) . toRecord)                   . V.toList+{-# INLINE encodeWith #-}  encodeRecord :: Word8 -> Record -> Builder encodeRecord delim = mconcat . intersperse (fromWord8 delim)-                     . map fromByteString . V.toList+                     . map fromByteString . map escape . 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,+                  "\""]+  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@@ -144,6 +200,7 @@               . map (encodeRecord (encDelimiter opts)                      . namedRecordToRecord hdr . toNamedRecord)               . V.toList $ v+{-# INLINE encodeByNameWith #-}   namedRecordToRecord :: Header -> NamedRecord -> Record

@@ -0,0 +1,304 @@+{-# LANGUAGE BangPatterns, DeriveFunctor #-}++-- | This module allows for incremental decoding of CSV data. This is+-- useful if you e.g. want to interleave I\/O with parsing or if you+-- want finer grained control over how you deal with type conversion+-- errors.+module Data.Csv.Incremental+    (+    -- * Decoding headers+      HeaderParser(..)+    , decodeHeader+    , decodeHeaderWith+    -- ** Providing input+    -- $feed-header+    , feedChunkH+    , feedEndOfInputH++    -- * Decoding records+    -- $typeconversion+    , Parser(..)++    -- ** Index-based record conversion+    -- $indexbased+    , decode+    , decodeWith++    -- ** Name-based record conversion+    -- $namebased+    , decodeByName+    , decodeByNameWith++    -- ** Providing input+    -- $feed-records+    , feedChunk+    , feedEndOfInput+    ) where++import Control.Applicative+import qualified Data.Attoparsec as A+import Data.Attoparsec.Char8 (endOfInput, endOfLine)+import qualified Data.ByteString as B+import qualified Data.HashMap.Strict as HM+import qualified Data.Vector as V++import Data.Csv.Conversion hiding (Parser, Result, record, toNamedRecord)+import qualified Data.Csv.Conversion as Conversion+import Data.Csv.Parser+import Data.Csv.Types++-- $feed-header+--+-- These functions are sometimes convenient when working with+-- 'HeaderParser', but don't let you do anything you couldn't already+-- do using the 'HeaderParser' constructors directly.++-- $indexbased+--+-- See documentation on index-based conversion in "Data.Csv" for more+-- information.++-- $namebased+--+-- See documentation on name-based conversion in "Data.Csv" for more+-- information.++-- $feed-records+--+-- These functions are sometimes convenient when working with+-- 'Parser', but don't let you do anything you couldn't already do+-- using the 'Parser' constructors directly.++------------------------------------------------------------------------+-- * Decoding headers++-- | An incremental parser that when fed data eventually returns a+-- parsed 'Header', or an error.+data HeaderParser a =+      -- | The input data was malformed. The first field contains any+      -- unconsumed input and second field contains information about+      -- the parse error.+      FailH !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 'FailH' or+      -- 'DoneH'.+    | PartialH (B.ByteString -> HeaderParser a)++      -- | The parse succeeded and produced the given 'Header'.+    | DoneH !Header a+    deriving Functor++instance Show a => Show (HeaderParser a) where+    showsPrec d (FailH rest msg) = showParen (d > appPrec) showStr+      where+        showStr = showString "FailH " . showsPrec (appPrec+1) rest .+                  showString " " . showsPrec (appPrec+1) msg+    showsPrec _ (PartialH _) = showString "PartialH <function>"+    showsPrec d (DoneH hdr x) = showParen (d > appPrec) showStr+      where+        showStr = showString "DoneH " . showsPrec (appPrec+1) hdr .+                  showString " " . showsPrec (appPrec+1) x++-- Application has precedence one more than the most tightly-binding+-- operator+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 its second field.+decodeHeader :: HeaderParser B.ByteString+decodeHeader = decodeHeaderWith defaultDecodeOptions++-- | Like 'decodeHeader', but lets you customize how the CSV data is+-- parsed.+decodeHeaderWith :: DecodeOptions -> HeaderParser B.ByteString+decodeHeaderWith !opts = PartialH (go . parser)+  where+    parser = A.parse (header $ decDelimiter opts)++    go (A.Fail rest _ msg) = FailH rest err+      where err = "parse error (" ++ msg ++ ")"+    -- TODO: Check empty and give attoparsec one last chance to return+    -- something:+    go (A.Partial k)       = PartialH $ \ s -> go (k s)+    go (A.Done rest r)     = DoneH r rest++------------------------------------------------------------------------+-- * Decoding records++-- $typeconversion+--+-- Just like in the case of non-incremental decoding, there are two+-- ways to convert CSV records to and from and user-defined data+-- types: index-based conversion and name-based conversion.++-- | An incremental parser that when fed data eventually produces some+-- parsed records, converted to the desired type, or an error in case+-- of malformed input data.+data Parser a =+      -- | The input data was malformed. The first field contains any+      -- unconsumed input and second field contains information about+      -- 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 some records. Any records+      -- that failed type conversion are returned as @'Left' errMsg@+      -- and the rest as @'Right' val@.+    | Done [Either String a]+    deriving Functor++instance Show a => Show (Parser a) where+    showsPrec d (Fail rest msg) = showParen (d > appPrec) showStr+      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+      where+        showStr = showString "Some " . 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)++-- | Efficiently deserialize CSV in an incremental fashion. Equivalent+-- to @'decodeByNameWith' 'defaultDecodeOptions'@.+decode :: FromRecord a+       => Bool          -- ^ Data contains header that should be+                        -- skipped+       -> Parser a+decode = decodeWith defaultDecodeOptions++-- | 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+                             -- skipped+           -> Parser a+decodeWith !opts skipHeader+    | skipHeader = Partial $ \ s -> go (decodeHeaderWith opts `feedChunkH` s)+    | otherwise  = Partial (decodeWithP parseRecord opts)+  where go (FailH rest msg) = Fail rest msg+        go (PartialH k)     = Partial $ \ s' -> go (k s')+        go (DoneH _ rest)   = decodeWithP parseRecord opts rest++------------------------------------------------------------------------++-- | Efficiently deserialize CSV in an incremental fashion. The data+-- is assumed to be preceeded by a header. Returns a 'HeaderParser'+-- that when done produces a 'Parser' for parsing the actual records.+-- Equivalent to @'decodeByNameWith' 'defaultDecodeOptions'@.+decodeByName :: FromNamedRecord a+             => HeaderParser (Parser a)+decodeByName = decodeByNameWith defaultDecodeOptions++-- | Like 'decodeByName', but lets you customize how the CSV data is+-- parsed.+decodeByNameWith :: FromNamedRecord a+                 => DecodeOptions  -- ^ Decoding options+                 -> HeaderParser (Parser a)+decodeByNameWith !opts =+    PartialH (runParser . (decodeHeaderWith opts `feedChunkH`))+  where+    runParser (FailH rest msg) = FailH rest msg+    runParser (PartialH k)     = PartialH $ \ s -> runParser (k s)+    runParser (DoneH hdr rest) =+        DoneH hdr (decodeWithP (parseNamedRecord . toNamedRecord hdr) opts rest)++-- Copied from Data.Csv.Parser+toNamedRecord :: Header -> Record -> NamedRecord+toNamedRecord hdr v = HM.fromList . V.toList $ V.zip hdr v++------------------------------------------------------------------------++-- | Like 'decode', but lets you customize how the CSV data is parsed.+decodeWithP :: (Record -> Conversion.Parser a) -> DecodeOptions -> B.ByteString+            -> Parser a+decodeWithP p !opts = go Incomplete [] . parser+  where+    go !_ !acc (A.Fail rest _ msg)+        | null acc  = Fail rest err+        | otherwise = Some (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+      where cont s = go m [] (k s)+              where m | B.null s  = Complete+                      | otherwise = Incomplete+    go Complete _ (A.Partial _) = moduleError "decodeWithP" msg+        where msg = "attoparsec should never return Partial in this case"+    go m acc (A.Done rest r)+        | B.null rest = case m of+            Complete   -> Done (reverse acc')+            Incomplete -> Partial cont+        | otherwise   = go m acc' (parser rest)+      where cont s+                | B.null s  = Done (reverse acc')+                | otherwise = go Incomplete acc' (parser s)+            acc' | blankLine r = acc+                 | otherwise   = convert r : acc++    parser = A.parse (record (decDelimiter opts) <* (endOfLine <|> endOfInput))+    convert = parseEither . p+{-# INLINE decodeWithP #-}++blankLine :: V.Vector B.ByteString -> Bool+blankLine v = V.length v == 1 && (B.null (V.head v))++moduleError :: String -> String -> a+moduleError func msg = error $ "Data.Csv.Incremental." ++ func ++ ": " ++ msg+{-# NOINLINE moduleError #-}

@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BangPatterns, CPP #-}  -- | A CSV parser. The parser defined here is RFC 4180 compliant, with -- the following extensions:@@ -30,6 +30,7 @@ import Data.Attoparsec.Char8 hiding (Parser, Result, parse) 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@@ -39,6 +40,7 @@ import Data.Word  import Data.Csv.Types+import Data.Csv.Util ((<$!>))  -- | Options that controls how data is decoded. These options can be -- used to e.g. decode tab-separated data instead of comma-separated@@ -57,34 +59,52 @@ -- | 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 <- record (decDelimiter opts) `sepBy1'` endOfLine     _ <- optional endOfLine     endOfInput     let nonEmpty = removeBlankLines vals-    return (V.fromList nonEmpty)+    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+  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+ -- | Parse a CSV file that includes a header. csvWithHeader :: DecodeOptions -> AL.Parser (Header, V.Vector NamedRecord) csvWithHeader !opts = do-    hdr <- header (decDelimiter opts)+    !hdr <- header (decDelimiter opts)     vals <- map (toNamedRecord hdr) . removeBlankLines <$>-            (record (decDelimiter opts)) `sepBy1` endOfLine+            (record (decDelimiter opts)) `sepBy1'` endOfLine     _ <- optional endOfLine     endOfInput-    return (hdr, V.fromList vals)+    let !v = V.fromList vals+    return (hdr, v) -toNamedRecord :: V.Vector S.ByteString -> Record -> NamedRecord+toNamedRecord :: Header -> Record -> NamedRecord toNamedRecord hdr v = HM.fromList . V.toList $ V.zip hdr v  -- | 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 `sepBy1'` (A.word8 delim) <* endOfLine  -- | Parse a header name. Header names have the same format as regular -- 'field's.-name :: Word8 -> AL.Parser Field  -- TODO: Create Name type alias+name :: Word8 -> AL.Parser Name name !delim = field delim  removeBlankLines :: [Record] -> [Record]@@ -98,7 +118,9 @@ -- this parser. record :: Word8  -- ^ Field delimiter        -> AL.Parser Record-record !delim = V.fromList <$> field delim `sepBy1` (A.word8 delim)+record !delim = do+    fs <- field delim `sepBy1'` (A.word8 delim)+    return $! V.fromList fs {-# INLINE record #-}  -- | Parse a field. The field may be in either the escaped or@@ -111,6 +133,7 @@     case mb of         Just b | b == doubleQuote -> escapedField         _                         -> unescapedField delim+{-# INLINE field #-}  escapedField :: AL.Parser S.ByteString escapedField = do@@ -137,7 +160,7 @@ dquote = char '"'  unescape :: Z.Parser S.ByteString-unescape = toByteString <$> go mempty where+unescape = toByteString <$!> go mempty where   go acc = do     h <- Z.takeWhile (/= doubleQuote)     let rest = do

@@ -0,0 +1,130 @@+{-# LANGUAGE BangPatterns, CPP, DeriveFunctor #-}++-- | This module allows for streaming decoding of CSV data. This is+-- useful if you need to parse large amounts of input in constant+-- space. The API also allows you to ignore type conversion errors on+-- a per-record basis.+module Data.Csv.Streaming+    ( Records(..)+    , decode+    , decodeWith+    , decodeByName+    , decodeByNameWith+    ) where++import Control.Applicative ((<$>), (<*>), pure)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BL8+import Data.Foldable (Foldable(..))+import Data.Traversable (Traversable(..))+import Prelude hiding (foldr)++import Data.Csv.Conversion+import Data.Csv.Incremental hiding (decode, decodeByName, decodeByNameWith,+                                    decodeWith)+import qualified Data.Csv.Incremental as I+import Data.Csv.Parser+import Data.Csv.Types++-- | A stream of parsed records. If type conversion failed for the+-- record, the error is returned as @'Left' errMsg@.+data Records a+    = -- | A record or an error message, followed by more records.+      Cons (Either String a) (Records a)++      -- | End of stream, potentially due to a parse error. If a parse+      -- error occured, the first field contains the error message.+      -- The second field contains any unconsumed input.+    | Nil (Maybe String) BL.ByteString+    deriving (Eq, Functor, Show)++instance Foldable Records where+    foldr = foldrRecords+#if MIN_VERSION_base(4,6,0)+    foldl' = foldlRecords'+#endif++foldrRecords :: (a -> b -> b) -> b -> Records a -> b+foldrRecords f = go+  where+    go z (Cons (Right x) rs) = f x (go z rs)+    go z _ = z+{-# INLINE foldrRecords #-}++#if MIN_VERSION_base(4,6,0)+foldlRecords' :: (a -> b -> a) -> a -> Records b -> a+foldlRecords' f = go+  where+    go z (Cons (Right x) rs) = let z' = f z x in z' `seq` go z' rs+    go z _ = z+{-# INLINE foldlRecords' #-}+#endif++instance Traversable Records where+    traverse _ (Nil merr rest) = pure $ Nil merr rest+    traverse f (Cons x xs)     = Cons <$> traverseElem x <*> traverse f xs+      where+        traverseElem (Left err) = pure $ Left err+        traverseElem (Right y)  = Right <$> f y++-- | Efficiently deserialize CSV records in a streaming fashion.+-- Equivalent to @'decodeWith' 'defaultDecodeOptions'@.+decode :: FromRecord a+       => Bool           -- ^ Data contains header that should be+                         -- skipped+       -> BL.ByteString  -- ^ CSV data+       -> Records a+decode = decodeWith defaultDecodeOptions++-- | 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+                             -- 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)+  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++-- | Efficiently deserialize CSV in a streaming fashion. The data is+-- assumed to be preceeded by a header. Returns @'Left' errMsg@ if+-- parsing the header fails. Equivalent to @'decodeByNameWith'+-- 'defaultDecodeOptions'@.+decodeByName :: FromNamedRecord a+             => BL.ByteString  -- ^ CSV data+             -> Either String (Header, Records a)+decodeByName = decodeByNameWith defaultDecodeOptions++-- TODO: Include something more in error messages?++-- | Like 'decodeByName', but lets you customize how the CSV data is+-- parsed.+decodeByNameWith :: FromNamedRecord a+                 => 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)+  where+    go ss (DoneH hdr p)    = Right (hdr, go2 ss p)+    go ss (FailH rest err) = Left $ err ++ " at " +++                             show (BL8.unpack . BL.fromChunks $ rest : ss)+    go [] (PartialH k)     = go [] (k B.empty)+    go (s:ss) (PartialH k) = go ss (k s)++    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

@@ -0,0 +1,10 @@+module Data.Csv.Util ((<$!>)) where++-- | A strict version of 'Data.Functor.<$>' for monads.+(<$!>) :: Monad m => (a -> b) -> m a -> m b+f <$!> m = do+    a <- m+    return $! f a+{-# INLINE (<$!>) #-}++infixl 4 <$!>

@@ -71,13 +71,13 @@         ]   where     decodePresidents :: BL.ByteString -> Either String (Vector President)-    decodePresidents = decode+    decodePresidents = decode False      decodePresidentsN :: BL.ByteString -> Either String (Header, Vector President)     decodePresidentsN = decodeByName      idDecode :: BL.ByteString -> Either String (Vector (Vector B.ByteString))-    idDecode = decode+    idDecode = decode False      idDecodeN :: BL.ByteString -> Either String (Header, Vector (BSHashMap B.ByteString))     idDecodeN = decodeByName

@@ -1,5 +1,5 @@ Name:                cassava-Version:             0.1.0.1+Version:             0.2.0.0 Synopsis:            A CSV parsing and encoding library Description:   A CSV parsing and encoding library optimized for ease of use and high@@ -21,25 +21,33 @@  Library   Exposed-modules:     Data.Csv+                       Data.Csv.Incremental                        Data.Csv.Parser+                       Data.Csv.Streaming -  Other-modules:       Data.Csv.Conversion+  Other-modules:       Data.Csv.Compat.Monoid+                       Data.Csv.Conversion                        Data.Csv.Conversion.Internal                        Data.Csv.Encoding                        Data.Csv.Types+                       Data.Csv.Util -  Build-depends:       array,-                       attoparsec >= 0.10.2,+  Build-depends:       array < 0.5,+                       attoparsec >= 0.10.2 && < 0.11,                        base < 5,-                       blaze-builder,-                       bytestring,-                       containers,-                       text,-                       unordered-containers,-                       vector+                       blaze-builder < 0.4,+                       bytestring < 0.11,+                       containers < 0.6,+                       text < 0.12,+                       unordered-containers < 0.3,+                       vector < 0.11    ghc-options:         -Wall -O2 +  if impl(ghc >= 7.2.1)+    cpp-options:       -DGENERICS+    build-depends:     ghc-prim >= 0.2 && < 0.4+   Test-suite unit-tests   Type: exitcode-stdio-1.0   Main-is: UnitTests.hs

@@ -0,0 +1,24 @@+{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}++import Control.Monad+import qualified Data.ByteString as B+import Data.Csv.Incremental+import System.Exit+import System.IO++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 (Done rs)      = putStrLn $ "Total salaries: " +++                                  show (sumSalaries rs + acc)++        feed k = do+            isEof <- hIsEOF csvFile+            if isEof+                then return $ k B.empty+                else k `fmap` B.hGetSome csvFile 4096+    loop 0 (decode False)+  where+    sumSalaries rs = sum [salary | Right (_ :: String, salary :: Int) <- rs]

@@ -7,7 +7,7 @@ main :: IO () main = do     csvData <- BL.readFile "salaries.csv"-    case decode csvData of+    case decode False csvData of         Left err -> putStrLn err         Right v -> V.forM_ v $ \ (name, salary :: Int) ->             putStrLn $ name ++ " earns " ++ show salary ++ " dollars"

@@ -0,0 +1,23 @@+{-# LANGUAGE ScopedTypeVariables, DeriveGeneric #-}++import qualified Data.ByteString.Lazy as BL+import Data.Csv+import qualified Data.Vector as V+import GHC.Generics++data Person = Person String Int deriving Generic++instance FromRecord Person+instance ToRecord Person++persons :: [Person]+persons = [Person "John" 50000, Person "Jane" 60000]++main :: IO ()+main = do+    BL.writeFile "salaries.csv" $ encode (V.fromList persons)+    csvData <- BL.readFile "salaries.csv"+    case decode False csvData of+        Left err -> putStrLn err+        Right v -> V.forM_ v $ \ (Person name salary) ->+            putStrLn $ name ++ " earns " ++ show salary ++ " dollars"

@@ -0,0 +1,27 @@+{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}++import qualified Data.ByteString.Lazy as BL+import Data.Csv+import qualified Data.Vector as V+import GHC.Generics++data Person = Person+    { name   :: String+    , salary :: Int+    }+    deriving Generic++instance FromNamedRecord Person+instance ToNamedRecord Person++persons :: [Person]+persons = [Person "John" 50000, Person "Jane" 60000]++main :: IO ()+main = do+    BL.writeFile "salaries.csv" $ encodeByName (V.fromList ["name", "salary"]) (V.fromList persons)+    csvData <- BL.readFile "salaries.csv"+    case decodeByName csvData of+        Left err -> putStrLn err+        Right (_, v) -> V.forM_ v $ \ p ->+            putStrLn $ name p ++ " earns " ++ show (salary p) ++ " dollars"

@@ -12,7 +12,6 @@ import Data.Int import qualified Data.Text as T import qualified Data.Text.Lazy as LT-import Data.Vector ((!)) import qualified Data.Vector as V import Data.Word import Test.HUnit@@ -21,17 +20,18 @@ import Test.QuickCheck import Test.Framework.Providers.QuickCheck2 as TF -import Data.Csv+import Data.Csv hiding (record)+import qualified Data.Csv.Streaming as S  ------------------------------------------------------------------------ -- Parse tests  decodesAs :: BL.ByteString -> [[B.ByteString]] -> Assertion-decodesAs input expected = assertResult input expected $ decode input+decodesAs input expected = assertResult input expected $ decode False input  decodesWithAs :: DecodeOptions -> BL.ByteString -> [[B.ByteString]] -> Assertion decodesWithAs opts input expected =-    assertResult input expected $ decodeWith opts input+    assertResult input expected $ decodeWith opts False input  assertResult :: BL.ByteString -> [[B.ByteString]]              -> Either String (V.Vector (V.Vector B.ByteString)) -> Assertion@@ -65,19 +65,39 @@   where     expected' = V.fromList $ map HM.fromList expected -testRfc4180 :: Assertion-testRfc4180 = (BL8.pack $-               "#field1,field2,field3\n" ++-               "\"aaa\",\"bb\n" ++-               "b\",\"ccc\"\n" ++-               "\"a,a\",\"b\"\"bb\",\"ccc\"\n" ++-               "zzz,yyy,xxx\n")-              `decodesAs`-              [["#field1", "field2", "field3"],-               ["aaa", "bb\nb", "ccc"],-               ["a,a", "b\"bb", "ccc"],-               ["zzz", "yyy", "xxx"]]+recordsToList :: S.Records a -> Either String [a]+recordsToList (S.Nil (Just err) _)  = Left err+recordsToList (S.Nil Nothing _)     = Right []+recordsToList (S.Cons (Left err) _) = Left err+recordsToList (S.Cons (Right x) rs) = case recordsToList rs of+    l@(Left _) -> l+    (Right xs) -> Right (x : xs) +decodesStreamingAs :: BL.ByteString -> [[B.ByteString]] -> Assertion+decodesStreamingAs input expected =+    assertResult input expected $ fmap (V.fromList . map V.fromList) $+    recordsToList $ S.decode False 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++namedDecodesStreamingAs :: BL.ByteString -> [B.ByteString]+                        -> [[(B.ByteString, B.ByteString)]] -> Assertion+namedDecodesStreamingAs input ehdr expected = case S.decodeByName input of+    Right (hdr, rs) -> case recordsToList rs of+        Right xs -> (V.fromList ehdr, expected') @=? (hdr, xs)+        Left err -> assertFailure $+                    "           input: " ++ show (BL8.unpack input) ++ "\n" +++                    "conversion error: " ++ err+    Left err -> assertFailure $+                "      input: " ++ show (BL8.unpack input) ++ "\n" +++                "parse error: " ++ err+  where+    expected' = map HM.fromList expected+ positionalTests :: [TF.Test] positionalTests =     [ testGroup "encode" $ map encodeTest@@ -95,24 +115,47 @@       [ testCase "tab-delim" $ encodesWithAs (defEnc { encDelimiter = 9 })         [["1", "2"]] "1\t2\r\n"       ]-    , testGroup "decode" $ map decodeTest-      [ ("simple",       "a,b,c\n",        [["a", "b", "c"]])-      , ("crlf",         "a,b\r\nc,d\r\n", [["a", "b"], ["c", "d"]])-      , ("noEol",        "a,b,c",          [["a", "b", "c"]])-      , ("blankLine",    "a,b,c\n\nd,e,f\n\n",-         [["a", "b", "c"], ["d", "e", "f"]])-      , ("leadingSpace", " a,  b,   c\n",  [[" a", "  b", "   c"]])-      ] ++ [testCase "rfc4180" testRfc4180]-    , testGroup "decodeWith"-      [ testCase "tab-delim" $ decodesWithAs (defDec { decDelimiter = 9 })-        "1\t2" [["1", "2"]]+    , testGroup "decode" $ map decodeTest decodeTests+    , testGroup "decodeWith" $ map decodeWithTest decodeWithTests+    , testGroup "streaming"+      [ testGroup "decode" $ map streamingDecodeTest decodeTests+      , testGroup "decodeWith" $ map streamingDecodeWithTest decodeWithTests       ]     ]   where+    rfc4180Input = BL8.pack $+                   "#field1,field2,field3\n" +++                   "\"aaa\",\"bb\n" +++                   "b\",\"ccc\"\n" +++                   "\"a,a\",\"b\"\"bb\",\"ccc\"\n" +++                   "zzz,yyy,xxx\n"+    rfc4180Output = [["#field1", "field2", "field3"],+                     ["aaa", "bb\nb", "ccc"],+                     ["a,a", "b\"bb", "ccc"],+                     ["zzz", "yyy", "xxx"]]+    decodeTests =+        [ ("simple",       "a,b,c\n",        [["a", "b", "c"]])+        , ("crlf",         "a,b\r\nc,d\r\n", [["a", "b"], ["c", "d"]])+        , ("noEol",        "a,b,c",          [["a", "b", "c"]])+        , ("blankLine",    "a,b,c\n\nd,e,f\n\n",+           [["a", "b", "c"], ["d", "e", "f"]])+        , ("leadingSpace", " a,  b,   c\n",  [[" a", "  b", "   c"]])+        , ("rfc4180", rfc4180Input, rfc4180Output)+        ]+    decodeWithTests =+        [ ("tab-delim", defDec { decDelimiter = 9 }, "1\t2", [["1", "2"]])+        ]+     encodeTest (name, input, expected) =         testCase name $ input `encodesAs` expected     decodeTest (name, input, expected) =         testCase name $ input `decodesAs` expected+    decodeWithTest (name, opts, input, expected) =+        testCase name $ decodesWithAs opts input expected+    streamingDecodeTest (name, input, expected) =+        testCase name $ input `decodesStreamingAs` expected+    streamingDecodeWithTest (name, opts, input, expected) =+        testCase name $ decodesWithStreamingAs opts input expected     defEnc = defaultEncodeOptions     defDec = defaultDecodeOptions @@ -126,19 +169,26 @@       , ("twoRecords", ["field"], [[("field", "abc")], [("field", "def")]],          "field\r\nabc\r\ndef\r\n")       ]-    , testGroup "decode" $ map decodeTest-      [("simple", "field\r\nabc\r\n", ["field"], [[("field", "abc")]])-      , ("twoFields", "field1,field2\r\nabc,def\r\n", ["field1", "field2"],-         [[("field1", "abc"), ("field2", "def")]])-      , ("twoRecords", "field\r\nabc\r\ndef\r\n", ["field"],-         [[("field", "abc")], [("field", "def")]])+    , testGroup "decode" $ map decodeTest decodeTests+    , testGroup "streaming"+      [ testGroup "decode" $ map streamingDecodeTest decodeTests       ]     ]   where+    decodeTests =+        [ ("simple", "field\r\nabc\r\n", ["field"], [[("field", "abc")]])+        , ("twoFields", "field1,field2\r\nabc,def\r\n", ["field1", "field2"],+           [[("field1", "abc"), ("field2", "def")]])+        , ("twoRecords", "field\r\nabc\r\ndef\r\n", ["field"],+           [[("field", "abc")], [("field", "def")]])+        ]+     encodeTest (name, hdr, input, expected) =         testCase name $ namedEncodesAs 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  ------------------------------------------------------------------------ -- Conversion tests@@ -159,17 +209,18 @@ -- empty line (which we will ignore.) We therefore encode at least two -- columns. roundTrip :: (Eq a, FromField a, ToField a) => a -> Bool-roundTrip x = case decode (encode (V.singleton (x, dummy))) of-    Right v | V.length v == 1 -> let (y, _ :: Char) = v ! 0 in x == y-    _  -> False-  where dummy = 'a'+roundTrip x = Right record == decode False (encode record) +  where record = V.singleton (x, dummy)+        dummy = 'a' +roundTripUnicode :: T.Text -> Assertion+roundTripUnicode x = Right record @=? decode False (encode record)+  where record = V.singleton (x, dummy)+        dummy = 'a'+ boundary :: forall a. (Bounded a, Eq a, FromField a, ToField a) => a -> Bool boundary _dummy = roundTrip (minBound :: a) && roundTrip (maxBound :: a) --- TODO: Right now we only encode ASCII properly. Should we support--- UTF-8? Arbitrary byte strings?- conversionTests :: [TF.Test] conversionTests =     [ testGroup "roundTrip"@@ -202,6 +253,13 @@       , testProperty "Word16" (boundary (undefined :: Word16))       , testProperty "Word32" (boundary (undefined :: Word32))       , testProperty "Word64" (boundary (undefined :: Word64))+      ]+    , testGroup "Unicode"+      [ testCase "Chinese" (roundTripUnicode "我能吞下玻璃而不伤身体。")+      , testCase "Icelandic" (roundTripUnicode+                              "Sævör grét áðan því úlpan var ónýt.")+      , testCase "Turkish" (roundTripUnicode+                            "Cam yiyebilirim, bana zararı dokunmaz.")       ]     ]