cassava 0.4.2.4 → 0.4.3.0

raw patch · 9 files changed

+595/−66 lines, 9 filesdep +hashabledep ~basePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: hashable

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• Data/Csv.hs +106/−4
• Data/Csv/Builder.hs +72/−0
• Data/Csv/Conversion.hs +115/−32
• Data/Csv/Encoding.hs +69/−12
• Data/Csv/Incremental.hs +167/−8
• cassava.cabal +8/−7
• examples/IncrementalNamedBasedEncode.hs +24/−0
• examples/NamedBasedGeneric.hs +5/−3
• tests/UnitTests.hs +29/−0

@@ -11,9 +11,18 @@ --    need to be escaped). module Data.Csv     (-    -- * Usage example+    -- * Usage examples     -- $example +    -- ** Encoding and decoding custom data types+    -- $example-instance++    -- *** Index-based record conversion+    -- $example-indexed-instance++    -- *** Name-based record conversion+    -- $example-named-instance+     -- * Treating CSV data as opaque byte strings     -- $generic-processing @@ -28,8 +37,11 @@       HasHeader(..)     , decode     , decodeByName+    , Quoting(..)     , encode     , encodeByName+    , encodeDefaultOrderedByName+    , DefaultOrdered(..)      -- ** Encoding and decoding options     -- $options@@ -41,6 +53,7 @@     , defaultEncodeOptions     , encodeWith     , encodeByNameWith+    , encodeDefaultOrderedByNameWith      -- * Core CSV types     , Csv@@ -74,6 +87,7 @@     , namedRecord     , namedField     , (.=)+    , header      -- ** Field conversion     -- $fieldconversion@@ -89,7 +103,7 @@  -- $example ----- A short encoding usage example:+-- Encoding standard Haskell types: -- -- > >>> encode [("John" :: Text, 27), ("Jane", 28)] -- > "John,27\r\nJane,28\r\n"@@ -100,7 +114,7 @@ -- will infer the type from the context and you can omit type -- signatures. ----- A short decoding usage example:+-- Decoding standard Haskell types: -- -- > >>> decode NoHeader "John,27\r\nJane,28\r\n" :: Either String (Vector (Text, Int)) -- > Right [("John",27),("Jane",28)]@@ -111,6 +125,94 @@ -- In practice, the return type of 'decode' rarely needs to be given, -- as it can often be inferred from the context. +-- $example-instance+--+-- To encode and decode your own data types you need to defined+-- instances of either 'ToRecord' and 'FromRecord' or 'ToNamedRecord'+-- and 'FromNamedRecord'. The former is used for encoding/decoding+-- using the column index and the latter using column name.+--+-- There are two ways to to define these instances, either by manually+-- defining them or by using GHC generics to derive them automatically.++-- $example-indexed-instance+--+-- Derived:+--+-- > {-# LANGUAGE DeriveGeneric #-}+-- >+-- > data Person = Person { name :: !Text , salary :: !Int }+-- >     deriving Generic+-- >+-- > instance FromRecord Person+-- > instance ToRecord Person+--+-- Manually defined:+--+-- > data Person = Person { name :: !Text , salary :: !Int }+-- >+-- > instance FromRecord Person where+-- >     parseRecord v+-- >         | length v == 2 = Person <$> v .! 0 <*> v .! 1+-- >         | otherwise     = mzero+-- > instance ToRecord Person where+-- >     toRecord (Person name age) = record [+-- >         toField name, toField age]+--+-- We can now use e.g. 'encode' and 'decode' to encode and decode our+-- data type.+--+-- Encoding:+--+-- > >>> encode [Person ("John" :: Text) 27]+-- > "John,27\r\n"+--+-- Decoding:+--+-- > >>> decode NoHeader "John,27\r\n" :: Either String (Vector Person)+-- > Right (["name","salary"],[Person {name = "John", salary = 27}])+--++-- $example-named-instance+--+-- Derived:+--+-- > {-# LANGUAGE DeriveGeneric #-}+-- >+-- > data Person = Person { name :: !Text , salary :: !Int }+-- >     deriving Generic+-- >+-- > instance FromNamedRecord Person+-- > instance ToNamedRecord Person+-- > instance DefaultOrdered Person+--+-- Manually defined:+--+-- > data Person = Person { name :: !Text , salary :: !Int }+-- >+-- > instance FromNamedRecord Person where+-- >     parseNamedRecord m = Person <$> m .: "name" <*> m .: "salary"+-- > instance ToNamedRecord Person+-- >     toNamedRecord (Person name salary) = namedRecord [+-- >         "name" .= name, "salary" .= salary]+-- > instance DefaultOrdered Person+-- >     where headerOrder = header ["name", "salary"]+--+-- We can now use e.g. 'encodeDefaultOrderedByName' (or 'encodeByName'+-- with an explicit header order) and 'decodeByName' to encode and+-- decode our data type.+--+-- Encoding:+--+-- > >>> encodeDefaultOrderedByName [Person ("John" :: Text) 27]+-- > "name,salary\r\nJohn,27\r\n"+--+-- Decoding:+--+-- > >>> decodeByName "name,salary\r\nJohn,27\r\n" :: Either String (Header, Vector Person)+-- > Right (["name","salary"],[Person {name = "John", salary = 27}])+--+ -- $generic-processing -- -- Sometimes you might want to work with a CSV file which contents is@@ -119,7 +221,7 @@ -- parse a CSV file to a generic representation, just convert each -- record to a @'Vector' 'ByteString'@ value, like so: ----- > decode NoHeader "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 [["John","27"],["Jane","28"]] -- -- As the example output above shows, all the fields are returned as

@@ -0,0 +1,72 @@+{-# LANGUAGE ScopedTypeVariables #-}++-- | Low-level bytestring builders. Most users want to use the more+-- type-safe 'Data.Csv.Incremental' module instead.+module Data.Csv.Builder+    (+    -- * Encoding single records and headers+      encodeHeader+    , encodeRecord+    , encodeNamedRecord+    , encodeDefaultOrderedNamedRecord+    -- ** Encoding options+    , encodeHeaderWith+    , encodeRecordWith+    , encodeNamedRecordWith+    , encodeDefaultOrderedNamedRecordWith+    ) where++import Data.Monoid++import Blaze.ByteString.Builder as Builder+import Data.Csv.Conversion+import qualified Data.Csv.Encoding as Encoding+import Data.Csv.Encoding (EncodeOptions(..))+import Data.Csv.Types hiding (toNamedRecord)++-- | Encode a header.+encodeHeader :: Header -> Builder.Builder+encodeHeader = encodeRecord++-- | Encode a single record.+encodeRecord :: ToRecord a => a -> Builder.Builder+encodeRecord = encodeRecordWith Encoding.defaultEncodeOptions++-- | Encode a single named record, given the field order.+encodeNamedRecord :: ToNamedRecord a =>+                     Header -> a -> Builder.Builder+encodeNamedRecord = encodeNamedRecordWith Encoding.defaultEncodeOptions++-- | Encode a single named record, using the default field order.+encodeDefaultOrderedNamedRecord ::+    (DefaultOrdered a, ToNamedRecord a) => a -> Builder.Builder+encodeDefaultOrderedNamedRecord =+    encodeDefaultOrderedNamedRecordWith Encoding.defaultEncodeOptions++-- | Like 'encodeHeader', but lets you customize how the CSV data is+-- encoded.+encodeHeaderWith :: EncodeOptions -> Header -> Builder.Builder+encodeHeaderWith = encodeRecordWith++-- | Like 'encodeRecord', but lets you customize how the CSV data is+-- encoded.+encodeRecordWith :: ToRecord a => EncodeOptions -> a -> Builder.Builder+encodeRecordWith opts r =+    Encoding.encodeRecord (encQuoting opts) (encDelimiter opts) (toRecord r)+    <> Encoding.recordSep (encUseCrLf opts)++-- | Like 'encodeNamedRecord', but lets you customize how the CSV data+-- is encoded.+encodeNamedRecordWith :: ToNamedRecord a =>+                         EncodeOptions -> Header -> a -> Builder.Builder+encodeNamedRecordWith opts hdr nr =+    Encoding.encodeNamedRecord hdr (encQuoting opts) (encDelimiter opts)+    (toNamedRecord nr) <> Encoding.recordSep (encUseCrLf opts)++-- | Like 'encodeDefaultOrderedNamedRecord', but lets you customize+-- how the CSV data is encoded.+encodeDefaultOrderedNamedRecordWith ::+    forall a. (DefaultOrdered a, ToNamedRecord a) =>+    EncodeOptions -> a -> Builder.Builder+encodeDefaultOrderedNamedRecordWith opts =+    encodeNamedRecordWith opts (headerOrder (undefined :: a))

@@ -1,9 +1,18 @@-{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, OverloadedStrings,-             Rank2Types #-}-#ifdef GENERICS-{-# LANGUAGE DefaultSignatures, TypeOperators, KindSignatures, FlexibleContexts,-             MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables #-}-#endif+{-# LANGUAGE+    BangPatterns,+    CPP,+    DefaultSignatures,+    FlexibleContexts,+    FlexibleInstances,+    KindSignatures,+    MultiParamTypeClasses,+    OverlappingInstances,+    OverloadedStrings,+    Rank2Types,+    ScopedTypeVariables,+    TypeOperators,+    UndecidableInstances+    #-} module Data.Csv.Conversion     (     -- * Type conversion@@ -11,6 +20,7 @@     , FromRecord(..)     , FromNamedRecord(..)     , ToNamedRecord(..)+    , DefaultOrdered(..)     , FromField(..)     , ToRecord(..)     , ToField(..)@@ -29,6 +39,7 @@     , (.=)     , record     , namedRecord+    , header     ) where  import Control.Applicative (Alternative, (<$>), (<|>), empty)@@ -38,8 +49,10 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Lazy as L+import Data.Hashable (Hashable) import qualified Data.HashMap.Lazy as HM import Data.Int (Int8, Int16, Int32, Int64)+import qualified Data.IntMap as IM import qualified Data.Map as M import qualified Data.Text as T import qualified Data.Text.Encoding as T@@ -50,6 +63,7 @@ import qualified Data.Vector.Unboxed as U import Data.Word (Word8, Word16, Word32, Word64) import GHC.Float (double2Float)+import GHC.Generics import Prelude hiding (lookup, takeWhile)  import Data.Csv.Conversion.Internal@@ -62,11 +76,6 @@ import Data.Word (Word) #endif -#ifdef GENERICS-import GHC.Generics-import qualified Data.IntMap as IM-#endif- ------------------------------------------------------------------------ -- bytestring compatibility @@ -113,10 +122,8 @@ 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@@ -140,12 +147,11 @@ -- > John,56 -- > Jane,55 class ToRecord a where+    -- | Convert a value to a record.     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@@ -365,10 +371,8 @@ 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. --@@ -380,27 +384,67 @@ -- >     toNamedRecord (Person name age) = namedRecord [ -- >         "name" .= name, "age" .= age] class ToNamedRecord a where+    -- | Convert a value to a named record.     toNamedRecord :: a -> NamedRecord -#ifdef GENERICS-    default toNamedRecord :: (Generic a, GToRecord (Rep a) (B.ByteString, B.ByteString)) => a -> NamedRecord+    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+-- | A type that has a default field order when converted to CSV. This+-- class lets you specify how to get the headers to use for a record+-- type that's an instance of 'ToNamedRecord'.+--+-- To derive an instance, the type is required to only have one+-- constructor and that constructor must have named fields (also known+-- as selectors) for all fields.+--+-- Right: @data Foo = Foo { foo :: !Int }@+--+-- Wrong: @data Bar = Bar Int@+--+-- If you try to derive an instance using GHC generics and your type+-- doesn't have named fields, you will get an error along the lines+-- of:+--+-- > <interactive>:9:10:+-- >     No instance for (DefaultOrdered (M1 S NoSelector (K1 R Char) ()))+-- >       arising from a use of ‘Data.Csv.Conversion.$gdmheader’+-- >     In the expression: Data.Csv.Conversion.$gdmheader+-- >     In an equation for ‘header’:+-- >         header = Data.Csv.Conversion.$gdmheader+-- >     In the instance declaration for ‘DefaultOrdered Foo’+--+class DefaultOrdered a where+    -- | The header order for this record. Should include the names+    -- used in the 'NamedRecord' returned by 'toNamedRecord'. Pass+    -- 'undefined' as the argument, together with a type annotation+    -- e.g. @'headerOrder' ('undefined' :: MyRecord)@.+    headerOrder :: a -> Header  -- TODO: Add Generic implementation++    default headerOrder ::+        (Generic a, GToNamedRecordHeader (Rep a)) =>+        a -> Header+    headerOrder = V.fromList. gtoNamedRecordHeader . from++instance (FromField a, FromField b, Ord a) => FromNamedRecord (M.Map a b) where     parseNamedRecord m = M.fromList <$>-                         (traverse parseSnd $ HM.toList m)-      where parseSnd (name, s) = (,) <$> pure name <*> parseField s+                         (traverse parseBoth $ HM.toList m) -instance ToField a => ToNamedRecord (M.Map B.ByteString a) where-    toNamedRecord = HM.fromList . map (\ (k, v) -> (k, toField v)) . M.toList+instance (ToField a, ToField b, Ord a) => ToNamedRecord (M.Map a b) where+    toNamedRecord = HM.fromList . map (\ (k, v) -> (toField k, toField v)) . M.toList -instance FromField a => FromNamedRecord (HM.HashMap B.ByteString a) where-    parseNamedRecord m = traverse (\ s -> parseField s) m+instance (Eq a, FromField a, FromField b, Hashable a) => FromNamedRecord (HM.HashMap a b) where+    parseNamedRecord m = HM.fromList <$>+                         (traverse parseBoth $ HM.toList m) -instance ToField a => ToNamedRecord (HM.HashMap B.ByteString a) where-    toNamedRecord = HM.map toField+instance (Eq a, ToField a, ToField b, Hashable a) => ToNamedRecord (HM.HashMap a b) where+    toNamedRecord = HM.fromList . map (\ (k, v) -> (toField k, toField v)) . HM.toList +parseBoth :: (FromField a, FromField b) => (Field, Field) -> Parser (a, b)+parseBoth (k, v) = (,) <$> parseField k <*> parseField v+ ------------------------------------------------------------------------ -- Individual field conversion @@ -768,6 +812,10 @@ namedRecord :: [(B.ByteString, B.ByteString)] -> NamedRecord namedRecord = HM.fromList +-- | Construct a header from a list of 'B.ByteString's.+header :: [B.ByteString] -> Header+header = V.fromList+ ------------------------------------------------------------------------ -- Parser for converting records to data types @@ -849,8 +897,6 @@ ------------------------------------------------------------------------ -- Generics -#ifdef GENERICS- class GFromRecord f where     gparseRecord :: Record -> Parser (f p) @@ -938,4 +984,41 @@ 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+-- We statically fail on sum types and product types without selectors+-- (field names).++class GToNamedRecordHeader a+  where+    gtoNamedRecordHeader :: a p -> [Name]++instance GToNamedRecordHeader U1+  where+    gtoNamedRecordHeader _ = []++instance (GToNamedRecordHeader a, GToNamedRecordHeader b) =>+         GToNamedRecordHeader (a :*: b)+  where+    gtoNamedRecordHeader _ = gtoNamedRecordHeader (undefined :: a p) +++                             gtoNamedRecordHeader (undefined :: b p)++instance GToNamedRecordHeader a => GToNamedRecordHeader (M1 D c a)+  where+    gtoNamedRecordHeader _ = gtoNamedRecordHeader (undefined :: a p)++instance GToNamedRecordHeader a => GToNamedRecordHeader (M1 C c a)+  where+    gtoNamedRecordHeader _ = gtoNamedRecordHeader (undefined :: a p)++-- | Instance to ensure that you cannot derive DefaultOrdered for+-- constructors without selectors.+instance DefaultOrdered (M1 S NoSelector a ()) => GToNamedRecordHeader (M1 S NoSelector a)+  where+    gtoNamedRecordHeader _ =+        error "You cannot derive DefaultOrdered for constructors without selectors."++instance Selector s => GToNamedRecordHeader (M1 S s a)+  where+    gtoNamedRecordHeader m+        | null name = error "Cannot derive DefaultOrdered for constructors without selectors"+        | otherwise = [B8.pack (selName m)]+      where name = selName m

@@ -1,4 +1,4 @@-{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-}+{-# LANGUAGE BangPatterns, CPP, OverloadedStrings, ScopedTypeVariables #-}  -- Module:      Data.Csv.Encoding -- Copyright:   (c) 2011 MailRank, Inc.@@ -15,8 +15,10 @@       HasHeader(..)     , decode     , decodeByName+    , Quoting(..)     , encode     , encodeByName+    , encodeDefaultOrderedByName      -- ** Encoding and decoding options     , DecodeOptions(..)@@ -27,6 +29,12 @@     , defaultEncodeOptions     , encodeWith     , encodeByNameWith+    , encodeDefaultOrderedByNameWith++    -- ** Encoding and decoding single records+    , encodeRecord+    , encodeNamedRecord+    , recordSep     ) where  import Blaze.ByteString.Builder (Builder, fromByteString, fromWord8,@@ -46,6 +54,7 @@ import Prelude hiding (unlines)  import Data.Csv.Compat.Monoid ((<>))+import qualified Data.Csv.Conversion as Conversion import Data.Csv.Conversion (FromNamedRecord, FromRecord, ToNamedRecord,                             ToRecord, parseNamedRecord, parseRecord, runParser,                             toNamedRecord, toRecord)@@ -97,6 +106,13 @@ encodeByName = encodeByNameWith defaultEncodeOptions {-# INLINE encodeByName #-} +-- | Like 'encodeByName', but header and field order is dictated by+-- the 'Conversion.header' method.+encodeDefaultOrderedByName :: (Conversion.DefaultOrdered a, ToNamedRecord a) =>+                              [a] -> L.ByteString+encodeDefaultOrderedByName = encodeDefaultOrderedByNameWith defaultEncodeOptions+{-# INLINE encodeDefaultOrderedByName #-}+ ------------------------------------------------------------------------ -- ** Encoding and decoding options @@ -139,6 +155,13 @@                  -> Either String (Header, Vector a) decodeByNameWith !opts = decodeWithP (csvWithHeader opts) +-- | Should quoting be applied to fields, and at which level+data Quoting+    = QuoteNone        -- ^ No quotes+    | QuoteMinimal     -- ^ Quotes according to RFC 4180+    | QuoteAll         -- ^ Always quote+    deriving (Eq, Show)+ -- | 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.@@ -165,6 +188,9 @@       -- | Include a header row when encoding @ToNamedRecord@       -- instances.     , encIncludeHeader :: !Bool++      -- | What kind of quoting should be applied to text fields.+    , encQuoting :: !Quoting     } deriving (Eq, Show)  -- | Encoding options for CSV files.@@ -173,6 +199,7 @@     { encDelimiter     = 44  -- comma     , encUseCrLf       = True     , encIncludeHeader = True+    , encQuoting       = QuoteMinimal     }  -- | Like 'encode', but lets you customize how the CSV data is@@ -182,7 +209,8 @@     | validDelim (encDelimiter opts) =         toLazyByteString         . unlines (recordSep (encUseCrLf opts))-        . map (encodeRecord (encDelimiter opts) . toRecord)+        . map (encodeRecord (encQuoting opts) (encDelimiter opts)+              . toRecord)     | otherwise = encodeOptionsError {-# INLINE encodeWith #-} @@ -205,16 +233,26 @@         "\") 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 delim) . V.toList+-- | Encode a single record, without the trailing record separator+-- (i.e. newline).+encodeRecord :: Quoting -> Word8 -> Record -> Builder+encodeRecord qtng delim = mconcat . intersperse (fromWord8 delim)+                     . map fromByteString . map (escape qtng delim) . V.toList {-# 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+ -- TODO: Optimize-escape :: Word8 -> B.ByteString -> B.ByteString-escape !delim !s-    | B.any (\ b -> b == dquote || b == delim || b == nl || b == cr || b == sp)-        s = toByteString $+escape :: Quoting -> Word8 -> B.ByteString -> B.ByteString+escape !qtng !delim !s+    | (qtng == QuoteMinimal &&+        B.any (\ b -> b == dquote || b == delim || b == nl || b == cr || b == sp) s+      ) || qtng == QuoteAll+         = toByteString $             fromWord8 dquote             <> B.foldl                 (\ acc b -> acc <> if b == dquote@@ -240,14 +278,33 @@     | otherwise = encodeOptionsError   where     rows False = records-    rows True  = encodeRecord (encDelimiter opts) hdr <>+    rows True  = encodeRecord (encQuoting opts) (encDelimiter opts) hdr <>                  recordSep (encUseCrLf opts) <> records     records = unlines (recordSep (encUseCrLf opts))-              . map (encodeRecord (encDelimiter opts)-                     . namedRecordToRecord hdr . toNamedRecord)+              . map (encodeNamedRecord hdr (encQuoting opts) (encDelimiter opts)+                     . toNamedRecord)               $ v {-# INLINE encodeByNameWith #-} +-- | Like 'encodeDefaultOrderedByNameWith', but lets you customize how+-- the CSV data is encoded.+encodeDefaultOrderedByNameWith ::+    forall a. (Conversion.DefaultOrdered a, ToNamedRecord a) =>+    EncodeOptions -> [a] -> L.ByteString+encodeDefaultOrderedByNameWith opts v+    | validDelim (encDelimiter opts) =+        toLazyByteString (rows (encIncludeHeader opts))+    | otherwise = encodeOptionsError+  where+    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)+                     . toNamedRecord)+              $ v+{-# INLINE encodeDefaultOrderedByNameWith #-}  namedRecordToRecord :: Header -> NamedRecord -> Record namedRecordToRecord hdr nr = V.map find hdr

@@ -1,17 +1,52 @@-{-# LANGUAGE BangPatterns, CPP, DeriveFunctor #-}+{-# LANGUAGE BangPatterns, CPP, DeriveFunctor, ScopedTypeVariables #-} --- | 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.+-- | This module allows for incremental decoding and encoding 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.+--+-- Decoding example:+--+-- > main :: IO ()+-- > main = withFile "salaries.csv" ReadMode $ \ csvFile -> do+-- >     let loop !_ (Fail _ errMsg) = putStrLn errMsg >> exitFailure+-- >         loop acc (Many 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 NoHeader)+-- >   where+-- >     sumSalaries rs = sum [salary | Right (_ :: String, salary :: Int) <- rs]+--+-- Encoding example:+--+-- > data Person = Person { name   :: !String, salary :: !Int }+-- >     deriving Generic+-- >+-- > instance FromNamedRecord Person+-- > instance ToNamedRecord Person+-- > instance DefaultOrdered Person+-- >+-- > persons :: [Person]+-- > persons = [Person "John" 50000, Person "Jane" 60000]+-- >+-- > main :: IO ()+-- > main = putStrLn $ encodeDefaultOrderedByName (go persons)+-- >   where+-- >     go (x:xs) = encodeNamedRecord x <> go xs+-- module Data.Csv.Incremental     (-    -- * Decoding headers+    -- * Decoding       HeaderParser(..)     , decodeHeader     , decodeHeaderWith -    -- * Decoding records     -- $typeconversion     , Parser(..) @@ -25,16 +60,40 @@     -- $namebased     , decodeByName     , decodeByNameWith++    -- * Encoding+    -- ** Index-based record conversion+    -- $indexbased+    , encode+    , encodeWith+    , encodeRecord+    , Builder++    -- ** Name-based record conversion+    -- $namebased+    , encodeByName+    , encodeDefaultOrderedByName+    , encodeByNameWith+    , encodeDefaultOrderedByNameWith+    , encodeNamedRecord+    , NamedBuilder     ) where  import Control.Applicative ((<|>)) import qualified Data.Attoparsec.ByteString as A import Data.Attoparsec.ByteString.Char8 (endOfInput) import qualified Data.ByteString as B+import qualified Blaze.ByteString.Builder as Builder+import qualified Data.ByteString.Lazy as L+import Data.Monoid (Monoid(mappend, mempty), (<>)) import qualified Data.Vector as V+import Data.Word (Word8) -import Data.Csv.Conversion hiding (Parser, record, toNamedRecord)+import Data.Csv.Conversion hiding (Parser, header, namedRecord, record,+                                   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.Parser import Data.Csv.Types import Data.Csv.Util (endOfLine)@@ -253,6 +312,106 @@  blankLine :: V.Vector B.ByteString -> Bool blankLine v = V.length v == 1 && (B.null (V.head v))++------------------------------------------------------------------------+-- * Encoding++-- | Efficiently serialize records in an incremental+-- fashion. Equivalent to @'encodeWith' 'defaultEncodeOptions'@.+encode :: ToRecord a => Builder a -> L.ByteString+encode = encodeWith Encoding.defaultEncodeOptions++-- | Like 'encode', but lets you customize how the CSV data is+-- encoded.+encodeWith :: ToRecord a => EncodeOptions -> Builder a+                 -> L.ByteString+encodeWith opts b =+    Builder.toLazyByteString $+    runBuilder b (encQuoting opts) (encDelimiter opts) (encUseCrLf opts)++-- | Encode a single record.+encodeRecord :: ToRecord a => a -> Builder a+encodeRecord r = Builder $ \ qtng delim useCrLf ->+    Encoding.encodeRecord qtng delim (toRecord r) <> recordSep useCrLf++-- | A builder for building the CSV data incrementally. Just like the+-- @ByteString@ builder, this builder should be used in a+-- right-associative, 'foldr' style. Using '<>' to compose builders in+-- a left-associative, `foldl'` style makes the building not be+-- incremental.+newtype Builder a = Builder {+      runBuilder :: Quoting -> Word8 -> Bool -> Builder.Builder+    }++instance Monoid (Builder a) where+    mempty = Builder (\ _ _ _ -> mempty)+    mappend (Builder f) (Builder g) =+        Builder $ \ qtng delim useCrlf ->+        f qtng delim useCrlf <> g qtng delim useCrlf++------------------------------------------------------------------------+-- ** Index-based record conversion++-- | Efficiently serialize named records in an incremental fashion,+-- including the leading header. Equivalent to @'encodeWith'+-- 'defaultEncodeOptions'@. The header is written before any records+-- and dictates the field order.+encodeByName :: ToNamedRecord a => Header -> NamedBuilder a -> L.ByteString+encodeByName = encodeByNameWith Encoding.defaultEncodeOptions++-- | Like 'encodeByName', but header and field order is dictated by+-- the 'Conversion.header' method.+encodeDefaultOrderedByName :: (DefaultOrdered a, ToNamedRecord a) =>+                              NamedBuilder a -> L.ByteString+encodeDefaultOrderedByName =+    encodeDefaultOrderedByNameWith Encoding.defaultEncodeOptions++-- | Like 'encodeByName', but lets you customize how the CSV data is+-- encoded.+encodeByNameWith :: ToNamedRecord a => EncodeOptions -> Header -> NamedBuilder a+                 -> L.ByteString+encodeByNameWith opts hdr b =+    Builder.toLazyByteString $+    Encoding.encodeRecord (encQuoting opts) (encDelimiter opts) hdr <>+    recordSep (encUseCrLf opts) <>+    runNamedBuilder b hdr (encQuoting opts) (encDelimiter opts)+    (encUseCrLf opts)++-- | Like 'encodeDefaultOrderedByName', but lets you customize how the+-- CSV data is encoded.+encodeDefaultOrderedByNameWith ::+    forall a. (DefaultOrdered a, ToNamedRecord a) =>+    EncodeOptions -> NamedBuilder a -> L.ByteString+encodeDefaultOrderedByNameWith opts b =+    Builder.toLazyByteString $+    Encoding.encodeRecord (encQuoting opts) (encDelimiter opts) hdr <>+    recordSep (encUseCrLf opts) <>+    runNamedBuilder b hdr (encQuoting opts)+    (encDelimiter opts) (encUseCrLf opts)+  where hdr = Conversion.headerOrder (undefined :: a)++-- | Encode a single named record.+encodeNamedRecord :: ToNamedRecord a => a -> NamedBuilder a+encodeNamedRecord nr = NamedBuilder $ \ hdr qtng delim useCrLf ->+    Encoding.encodeNamedRecord hdr qtng delim+    (Conversion.toNamedRecord nr) <> recordSep useCrLf++-- | A builder for building the CSV data incrementally. Just like the+-- @ByteString@ builder, this builder should be used in a+-- 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+    }++instance Monoid (NamedBuilder a) where+    mempty = NamedBuilder (\ _ _ _ _ -> mempty)+    mappend (NamedBuilder f) (NamedBuilder g) =+        NamedBuilder $ \ hdr qtng delim useCrlf ->+        f hdr qtng delim useCrlf <> g hdr qtng delim useCrlf++------------------------------------------------------------------------  moduleError :: String -> String -> a moduleError func msg = error $ "Data.Csv.Incremental." ++ func ++ ": " ++ msg

@@ -1,5 +1,5 @@ Name:                cassava-Version:             0.4.2.4+Version:             0.4.3.0 Synopsis:            A CSV parsing and encoding library Description:   A CSV parsing and encoding library optimized for ease of use and high@@ -21,6 +21,7 @@ Library   Exposed-modules:     Data.Csv+    Data.Csv.Builder     Data.Csv.Incremental     Data.Csv.Parser     Data.Csv.Streaming@@ -41,18 +42,16 @@     bytestring < 0.11,     containers < 0.6,     deepseq < 1.5,+    hashable < 1.3,     text < 1.3,     unordered-containers < 0.3,     vector < 0.11    ghc-options: -Wall -O2 -  if impl(ghc >= 7.2.1)-    cpp-options: -DGENERICS--    -- GHC.Generics lived in `ghc-prim` for GHC 7.2 & GHC 7.4 only-    if impl(ghc < 7.6)-      build-depends: ghc-prim == 0.2.*+  -- GHC.Generics lived in `ghc-prim` for GHC 7.2 & GHC 7.4 only+  if impl(ghc < 7.6)+    build-depends: ghc-prim == 0.2.*  Test-suite unit-tests   Type: exitcode-stdio-1.0@@ -62,6 +61,7 @@     base,     bytestring,     cassava,+    hashable < 1.3,     HUnit,     QuickCheck >= 2.0,     test-framework,@@ -99,6 +99,7 @@     containers < 0.6,     criterion >= 1.0,     deepseq < 1.5,+    hashable < 1.3,     lazy-csv >= 0.5,     text < 1.3,     text,

@@ -0,0 +1,24 @@+{-# LANGUAGE DeriveGeneric #-}+import qualified Data.ByteString.Lazy as L+import Data.Csv hiding (encodeDefaultOrderedByName)+import Data.Csv.Incremental+import Data.Monoid+import GHC.Generics++data Person = Person+    { name   :: !String+    , salary :: !Int+    }+    deriving Generic++instance FromNamedRecord Person+instance ToNamedRecord Person+instance DefaultOrdered Person++persons :: [Person]+persons = [Person "John" 50000, Person "Jane" 60000]++main :: IO ()+main = L.putStrLn $ encodeDefaultOrderedByName (go persons)+  where+    go (x:xs) = encodeNamedRecord x <> go xs

@@ -2,24 +2,26 @@  import qualified Data.ByteString.Lazy as BL import Data.Csv+import Data.Text (Text) import qualified Data.Vector as V import GHC.Generics  data Person = Person-    { name   :: String-    , salary :: Int+    { name   :: !String+    , salary :: !Int     }     deriving Generic  instance FromNamedRecord Person instance ToNamedRecord Person+instance DefaultOrdered Person  persons :: [Person] persons = [Person "John" 50000, Person "Jane" 60000]  main :: IO () main = do-    BL.writeFile "salaries.csv" $ encodeByName (V.fromList ["name", "salary"]) persons+    BL.writeFile "salaries.csv" $ encodeDefaultOrderedByName persons     csvData <- BL.readFile "salaries.csv"     case decodeByName csvData of         Left err -> putStrLn err

@@ -116,6 +116,29 @@       , ("twoRecords",   [["abc"], ["def"]], "abc\r\ndef\r\n")       , ("newline",      [["abc\ndef"]],     "\"abc\ndef\"\r\n")       ]+    , testGroup "encode" $ map encodeTestUnqtd+      [ ("simple",       [["abc"]],          "abc\r\n")+      , ("quoted",       [["\"abc\""]],      "\"abc\"\r\n")+      , ("quote",        [["a\"b"]],         "a\"b\r\n")+      , ("quotedQuote",  [["\"a\"b\""]],     "\"a\"b\"\r\n")+      , ("leadingSpace", [[" abc"]],         " abc\r\n")+      , ("comma",        [["abc,def"]],      "abc,def\r\n")+      , ("twoFields",    [["abc","def"]],    "abc,def\r\n")+      , ("twoRecords",   [["abc"], ["def"]], "abc\r\ndef\r\n")+      , ("newline",      [["abc\ndef"]],     "abc\ndef\r\n")+      ]+    , testGroup "encode" $ map encodeTestAllqtd+      [ ("simple",       [["abc"]],          "\"abc\"\r\n")+      , ("quoted",       [["\"abc\""]],      "\"\"\"abc\"\"\"\r\n")+      , ("quote",        [["a\"b"]],         "\"a\"\"b\"\r\n")+      , ("quotedQuote",  [["\"a\"b\""]],     "\"\"\"a\"\"b\"\"\"\r\n")+      , ("leadingSpace", [[" abc"]],         "\" abc\"\r\n")+      , ("comma",        [["abc,def"]],      "\"abc,def\"\r\n")+      , ("twoFields",    [["abc","def"]],    "\"abc\",\"def\"\r\n")+      , ("twoRecords",   [["abc"], ["def"]], "\"abc\"\r\n\"def\"\r\n")+      , ("newline",      [["abc\ndef"]],     "\"abc\ndef\"\r\n")+      ]+     , testGroup "encodeWith"       [ testCase "tab-delim" $ encodesWithAs (defEnc { encDelimiter = 9 })         [["1", "2"]] "1\t2\r\n"@@ -155,6 +178,10 @@      encodeTest (name, input, expected) =         testCase name $ input `encodesAs` expected+    encodeTestUnqtd (name, input, expected) =+        testCase name $ encodesWithAs defEncNoneEnq input expected+    encodeTestAllqtd (name, input, expected) =+        testCase name $ encodesWithAs defEncAllEnq input expected     decodeTest (name, input, expected) =         testCase name $ input `decodesAs` expected     decodeWithTest (name, opts, input, expected) =@@ -164,6 +191,8 @@     streamingDecodeWithTest (name, opts, input, expected) =         testCase name $ decodesWithStreamingAs opts input expected     defEnc = defaultEncodeOptions+    defEncNoneEnq = defaultEncodeOptions { encQuoting = QuoteNone }+    defEncAllEnq  = defaultEncodeOptions { encQuoting = QuoteAll  }     defDec = defaultDecodeOptions  nameBasedTests :: [TF.Test]