diff --git a/Data/Csv.hs b/Data/Csv.hs --- a/Data/Csv.hs +++ b/Data/Csv.hs @@ -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 diff --git a/Data/Csv/Builder.hs b/Data/Csv/Builder.hs new file mode 100644 --- /dev/null +++ b/Data/Csv/Builder.hs @@ -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)) diff --git a/Data/Csv/Conversion.hs b/Data/Csv/Conversion.hs --- a/Data/Csv/Conversion.hs +++ b/Data/Csv/Conversion.hs @@ -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: +-- +-- > :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 diff --git a/Data/Csv/Encoding.hs b/Data/Csv/Encoding.hs --- a/Data/Csv/Encoding.hs +++ b/Data/Csv/Encoding.hs @@ -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 diff --git a/Data/Csv/Incremental.hs b/Data/Csv/Incremental.hs --- a/Data/Csv/Incremental.hs +++ b/Data/Csv/Incremental.hs @@ -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 diff --git a/cassava.cabal b/cassava.cabal --- a/cassava.cabal +++ b/cassava.cabal @@ -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, diff --git a/examples/IncrementalNamedBasedEncode.hs b/examples/IncrementalNamedBasedEncode.hs new file mode 100644 --- /dev/null +++ b/examples/IncrementalNamedBasedEncode.hs @@ -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 diff --git a/examples/NamedBasedGeneric.hs b/examples/NamedBasedGeneric.hs --- a/examples/NamedBasedGeneric.hs +++ b/examples/NamedBasedGeneric.hs @@ -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 diff --git a/tests/UnitTests.hs b/tests/UnitTests.hs --- a/tests/UnitTests.hs +++ b/tests/UnitTests.hs @@ -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]