cassava 0.5.1.0 → 0.5.5.0
raw patch · 26 files changed
Files
- CHANGES.md +82/−0
- Data/Csv.hs +0/−406
- Data/Csv/Builder.hs +0/−72
- Data/Csv/Conversion.hs +0/−1388
- Data/Csv/Conversion/Internal.hs +0/−299
- Data/Csv/Encoding.hs +0/−389
- Data/Csv/Incremental.hs +0/−438
- Data/Csv/Parser.hs +0/−191
- Data/Csv/Streaming.hs +0/−194
- Data/Csv/Types.hs +0/−50
- Data/Csv/Util.hs +0/−68
- README.md +5/−2
- Setup.hs +1/−0
- cassava.cabal +64/−75
- examples/NamedBasedExplicitDecode.hs +21/−0
- src/Data/Csv.hs +470/−0
- src/Data/Csv/Builder.hs +72/−0
- src/Data/Csv/Conversion.hs +1380/−0
- src/Data/Csv/Conversion/Internal.hs +299/−0
- src/Data/Csv/Encoding.hs +439/−0
- src/Data/Csv/Incremental.hs +459/−0
- src/Data/Csv/Parser.hs +189/−0
- src/Data/Csv/Streaming.hs +198/−0
- src/Data/Csv/Types.hs +50/−0
- src/Data/Csv/Util.hs +58/−0
- tests/UnitTests.hs +47/−9
CHANGES.md view
@@ -1,5 +1,77 @@+## Version 0.5.5.0++_Michael Chavinda, 2026-02-22_++ * `Data.Csv.Incremental`: Fixed the `type role`s of `Builder` and `NamedBuilder`; they're now `nominal` in their parameters.+ * `Faster encoding`: Reduce intermediate allocations in encoding logic.+ * `Default values for encoding missing fields`: Provides a way to either specify per-column defaults or a general fallback value.++## Version 0.5.4.1++_Andreas Abel, 2025-09-02_++ * Bump dependency lower bounds to at least GHC 8.0 and Stackage LTS 7.0.+ * Build tested with GHC 8.0 - 9.14 alpha1.+ * Functionality tested with GHC 8.4 - 9.14 alpha1.++## Version 0.5.4.0++_Andreas Abel, 2025-06-10_++ * Add `decodeWithP` and `decodeByNameWithP` to `Streaming` interface ([PR #237](https://github.com/haskell-hvr/cassava/pull/237)).+ * Build tested with GHC 8.0 - 9.12.2.+ * Functionality tested with GHC 8.4 - 9.12.2.++## Version 0.5.3.2++_Andreas Abel, 2024-08-03_++ * Proper exception on hanging doublequote ([PR #222](https://github.com/haskell-hvr/cassava/pull/222)).+ * Allow latest `hashable`.+ * Build tested with GHC 8.0 - 9.10.1.+ * Functionality tested with GHC 8.4 - 9.10.1.++## Version 0.5.3.1++_Andreas Abel, 2024-04-23_++ * Remove support for GHC 7.+ * Remove cabal flag `bytestring--LT-0_10_4` and support for `bytestring < 0.10.4`.+ * Tested with GHC 8.0 - 9.10 alpha3++## Version 0.5.3.0 revision 2++ * Allow `bytestring-0.12`+ * Tested with GHC 7.4 - 9.6.2++## Version 0.5.3.0 revision 1++ * Allow `base-4.18`+ * Tested with GHC 7.4 - 9.6.1 alpha++## Version 0.5.3.0++_Andreas Abel, 2022-07-10_++ * Improve error messages for `lookup` and NamedRecord parsers (#197)+ * Fix bug (infinite loop) in `FromField Const` instance (#185)+ * Turn flag `bytestring--LT-0_10_4` off by default (#183)+ * Doc: Add cassava usage example of reading/writing to file (#97)+ * Update to latest version of dependencies (#190, #193, #199)+ * Tested with GHC 7.4 - 9.4 (#184, #204)++## Version 0.5.2.0++_Herbert Valerio Riedel, 2019-09-01_++ * Add `FromField`/`ToField` instances for `Identity` and `Const` (#158)+ * New `typeclass`-less decoding functions `decodeWithP` and `decodeByNameWithP` (#67,#167)+ * Support for final phase of MFP / base-4.13+ ## Version 0.5.1.0 +_Herbert Valerio Riedel, 2017-08-12_+ * Add `FromField`/`ToField` instance for `Natural` (#141,#142) * Add `FromField`/`ToField` instances for `Scientific` (#143,#144) * Add support for modifying Generics-based instances (adding@@ -10,6 +82,8 @@ ## Version 0.5.0.0 +_Herbert Valerio Riedel, 2017-06-19_+ ### Semantic changes * Don't unecessarily quote spaces with `QuoteMinimal` (#118,#122,#86)@@ -28,10 +102,14 @@ ## Version 0.4.5.1 +_Herbert Valerio Riedel, 2016-11-10_+ * Restore GHC 7.4 support (#124) ## Version 0.4.5.0 +_Herbert Valerio Riedel, 2016-01-19_+ * Support for GHC 8.0 added; support for GHC 7.4 dropped * Fix defect in `Foldable(foldr)` implementation failing to skip@@ -43,6 +121,8 @@ ## Version 0.4.4.0 +_Johan Tibell, 2015-08-30_+ * Added record instances for larger tuples. * Support attoparsec 0.13.@@ -50,6 +130,8 @@ * Add field instances for short bytestrings. ## Version 0.4.3.0++_Johan Tibell, 2015-06-02_ * Documentation overhaul with more examples.
− Data/Csv.hs
@@ -1,406 +0,0 @@--- | This module implements encoding and decoding--- of [comma-separated values (CSV)](https://en.wikipedia.org/wiki/Comma-separated_values)--- data. The implementation is [RFC 4180](https://tools.ietf.org/html/rfc4180)--- compliant, with the following extensions:------ * Empty lines are ignored.------ * Non-escaped fields may contain any characters except--- double-quotes, commas, carriage returns, and newlines.------ * Escaped fields may contain any characters (but double-quotes--- need to be escaped).-module Data.Csv- (- -- * 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-- -- * Custom type conversions for fields- -- $customtypeconversions-- -- ** Dealing with bad data- -- $baddata-- -- * Encoding and decoding- -- $encoding- HasHeader(..)- , decode- , decodeByName- , encode- , encodeByName- , encodeDefaultOrderedByName- , DefaultOrdered(..)-- -- ** Encoding and decoding options- -- $options- , DecodeOptions(..)- , defaultDecodeOptions- , decodeWith- , decodeByNameWith- , EncodeOptions(..)- , Quoting(..)- , defaultEncodeOptions- , encodeWith- , encodeByNameWith- , encodeDefaultOrderedByNameWith-- -- * Core CSV types- , Csv- , Record- , Field- , Header- , Name- , NamedRecord-- -- * Type conversion- -- $typeconversion-- -- ** Index-based record conversion- -- $indexbased- , FromRecord(..)- , Parser- , runParser- , index- , (.!)- , unsafeIndex- , ToRecord(..)- , record- , Only(..)-- -- ** Name-based record conversion- -- $namebased- , FromNamedRecord(..)- , lookup- , (.:)- , ToNamedRecord(..)- , namedRecord- , namedField- , (.=)- , header-- -- ** Field conversion- -- $fieldconversion- , FromField(..)- , ToField(..)-- -- ** 'Generic' record conversion- -- $genericconversion- , genericParseRecord- , genericToRecord- , genericParseNamedRecord- , genericToNamedRecord- , genericHeaderOrder-- -- *** 'Generic' type conversion options- , Options- , defaultOptions- , fieldLabelModifier-- -- *** 'Generic' type conversion class name- -- $genericconversionclass- , GFromRecord- , GToRecord- , GFromNamedRecord- , GToNamedRecordHeader- ) where--import Prelude hiding (lookup)--import Data.Csv.Conversion-import Data.Csv.Encoding-import Data.Csv.Types---- $example------ Encoding standard Haskell types:------ >>> :set -XOverloadedStrings--- >>> import Data.Text (Text)--- >>> encode [("John" :: Text, 27 :: Int), ("Jane", 28)]--- "John,27\r\nJane,28\r\n"------ Since we enabled the [-XOverloadedStrings extension](https://downloads.haskell.org/~ghc/8.2.1/docs/html/users_guide/glasgow_exts.html#overloaded-string-literals),--- string literals are polymorphic and we have to supply a type--- signature as the compiler couldn't deduce which string type (i.e.--- 'String', 'Data.Text.Short.ShortText', or 'Data.Text.Text') we want to use. In most cases--- type inference will infer the type from the context and you can--- omit type signatures.------ Decoding standard Haskell types:------ >>> import Data.Vector (Vector)--- >>> decode NoHeader "John,27\r\nJane,28\r\n" :: Either String (Vector (Text, Int))--- Right [("John",27),("Jane",28)]------ We pass 'NoHeader' as the first argument to indicate that the CSV--- input data isn't preceded by a header.------ In practice, the return type of 'decode' rarely needs to be given,--- 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 the 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------ "GHC.Generics"-derived:------ > {-# LANGUAGE DeriveGeneric #-}--- >--- > import Data.Text (Text)--- > import GHC.Generics (Generic)--- >--- > data Person = Person { name :: !Text , salary :: !Int }--- > deriving (Generic, Show)--- >--- > instance FromRecord Person--- > instance ToRecord Person------ Manually defined:------ > import Control.Monad (mzero)--- >--- > data Person = Person { name :: !Text , salary :: !Int }--- > deriving (Show)--- >--- > 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 [Person {name = "John", salary = 27}]------- $example-named-instance------ "GHC.Generics"-derived:------ > {-# LANGUAGE DeriveGeneric #-}--- >--- > import Data.Text (Text)--- > import GHC.Generics (Generic)--- >--- > data Person = Person { name :: !Text , salary :: !Int }--- > deriving (Generic, Show)--- >--- > instance FromNamedRecord Person--- > instance ToNamedRecord Person--- > instance DefaultOrdered Person------ Manually defined:------ > data Person = Person { name :: !Text , salary :: !Int }--- > deriving (Show)--- >--- > instance FromNamedRecord Person where--- > parseNamedRecord m = Person <$> m .: "name" <*> m .: "salary"--- > instance ToNamedRecord Person where--- > 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--- 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:------ >>> import Data.ByteString (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--- uninterpreted 'ByteString' values.---- $customtypeconversions------ Most of the time the existing 'FromField' and 'ToField' instances--- do what you want. However, if you need to parse a different format--- (e.g. hex) but use a type (e.g. 'Int') for which there's already a--- 'FromField' instance, you need to use a @newtype@. Example:------ > newtype Hex = Hex Int--- >--- > parseHex :: ByteString -> Parser Int--- > parseHex = ...--- >--- > instance FromField Hex where--- > parseField s = Hex <$> parseHex s------ Other than giving an explicit type signature, you can pattern match--- on the @newtype@ constructor to indicate which type conversion you--- want to have the library use:------ > case decode NoHeader "0xff,0xaa\r\n0x11,0x22\r\n" of--- > Left err -> putStrLn err--- > Right v -> forM_ v $ \ (Hex val1, Hex val2) ->--- > print (val1, val2)------ If a field might be in one several different formats, you can use a--- newtype to normalize the result:------ > newtype HexOrDecimal = HexOrDecimal Int--- >--- > instance FromField DefaultToZero where--- > parseField s = case runParser (parseField s :: Parser Hex) of--- > Left err -> HexOrDecimal <$> parseField s -- Uses Int instance--- > Right n -> pure $ HexOrDecimal n------ You can use the unit type, @()@, to ignore a column. The--- 'parseField' method for @()@ doesn't look at the 'Field' and thus--- always decodes successfully. Note that it lacks a corresponding--- 'ToField' instance. Example:------ > case decode NoHeader "foo,1\r\nbar,22" of--- > Left err -> putStrLn err--- > Right v -> forM_ v $ \ ((), i) -> print (i :: Int)---- $baddata------ If your input might contain invalid fields, you can write a custom--- 'FromField' instance to deal with them. Example:------ > newtype DefaultToZero = DefaultToZero Int--- >--- > instance FromField DefaultToZero where--- > parseField s = case runParser (parseField s) of--- > Left err -> pure $ DefaultToZero 0--- > Right n -> pure $ DefaultToZero n---- $encoding------ Encoding and decoding is a two step process. To encode a value, it--- is first converted to a generic representation, using either--- 'ToRecord' or 'ToNamedRecord'. The generic representation is then--- encoded as CSV data. To decode a value the process is reversed and--- either 'FromRecord' or 'FromNamedRecord' is used instead. Both--- these steps are combined in the 'encode' and 'decode' functions.---- $typeconversion------ There are two ways to convert CSV records to and from and--- user-defined data types: index-based conversion and name-based--- conversion.---- $indexbased------ Index-based conversion lets you convert CSV records to and from--- user-defined data types by referring to a field's position (its--- index) in the record. The first column in a CSV file is given index--- 0, the second index 1, and so on.---- $namebased------ Name-based conversion lets you convert CSV records to and from--- user-defined data types by referring to a field's name. The names--- of the fields are defined by the first line in the file, also known--- as the header. Name-based conversion is more robust to changes in--- the file structure e.g. to reording or addition of columns, but can--- be a bit slower.---- $options------ These functions can be used to control how data is encoded and--- decoded. For example, they can be used to encode data in a--- tab-separated format instead of in a comma-separated format.---- $fieldconversion------ The 'FromField' and 'ToField' classes define how to convert between--- 'Field's and values you care about (e.g. 'Int's). Most of the time--- you don't need to write your own instances as the standard ones--- cover most use cases.---- $genericconversion------ There may be times that you do not want to manually write out class--- instances for record conversion, but you can't rely upon the--- default instances (e.g. you can't create field names that match the--- actual column names in expected data).------ For example, consider you have a type @MyType@ where you have--- prefixed certain columns with an underscore, but in the actual data--- they're not. You can then write:------ > myOptions :: Options--- > myOptions = defaultOptions { fieldLabelmodifier = rmUnderscore }--- > where--- > rmUnderscore ('_':str) = str--- > rmUnderscore str = str--- >--- > instance ToNamedRecord MyType where--- > toNamedRecord = genericToNamedRecord myOptions--- >--- > instance FromNamedRecord MyType where--- > parseNamedRecord = genericParseNamedRecord myOptions--- >--- > instance DefaultOrdered MyType where--- > headerOrder = genericHeaderOrder myOptions---- $genericconversionclass------ __NOTE__: Only the class /names/ are exposed in order to make it possible to write type signatures referring to these classes---- $setup--- >>> :set -XOverloadedStrings -XDeriveGeneric--- >>> import Data.Text (Text)--- >>> import Data.Vector (Vector)--- >>> import GHC.Generics (Generic)--- >>>--- >>> data Person = Person { name :: !Text, salary :: !Int } deriving (Generic, Show)--- >>> instance FromRecord Person--- >>> instance ToRecord Person--- >>> instance FromNamedRecord Person--- >>> instance ToNamedRecord Person--- >>> instance DefaultOrdered Person
− Data/Csv/Builder.hs
@@ -1,72 +0,0 @@-{-# 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 Data.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))
− Data/Csv/Conversion.hs
@@ -1,1388 +0,0 @@-{-# LANGUAGE- BangPatterns,- CPP,- DefaultSignatures,- FlexibleContexts,- FlexibleInstances,- KindSignatures,- MultiParamTypeClasses,- OverloadedStrings,- Rank2Types,- ScopedTypeVariables,- TypeOperators,- UndecidableInstances- #-}--#if __GLASGOW_HASKELL__ >= 800-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-#endif--#if !MIN_VERSION_bytestring(0,10,4)-# define MIN_VERSION_text_short(a,b,c) 0-#endif--#if !defined(MIN_VERSION_text_short)-# error **INVARIANT BROKEN** Detected invalid combination of `text-short` and `bytestring` versions. Please verify the `pre-bytestring-0.10-4` flag-logic in the .cabal file wasn't elided.-#endif--module Data.Csv.Conversion- (- -- * Type conversion- Only(..)- , FromRecord(..)- , FromNamedRecord(..)- , ToNamedRecord(..)- , DefaultOrdered(..)- , FromField(..)- , ToRecord(..)- , ToField(..)-- -- ** Generic type conversion- , genericParseRecord- , genericToRecord- , genericParseNamedRecord- , genericToNamedRecord- , genericHeaderOrder-- -- *** Generic type conversion options- , Options- , defaultOptions- , fieldLabelModifier-- -- *** Generic type conversion class names- , GFromRecord- , GToRecord- , GFromNamedRecord- , GToNamedRecordHeader-- -- * Parser- , Parser- , runParser-- -- * Accessors- , index- , (.!)- , unsafeIndex- , lookup- , (.:)- , namedField- , (.=)- , record- , namedRecord- , header- ) where--import Control.Applicative (Alternative, (<|>), empty)-import Control.Monad (MonadPlus, mplus, mzero)-import qualified Control.Monad.Fail as Fail-import Data.Attoparsec.ByteString.Char8 (double)-import qualified Data.Attoparsec.ByteString.Char8 as A8-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import qualified Data.ByteString.Lazy as L-#if MIN_VERSION_bytestring(0,10,4)-import qualified Data.ByteString.Short as SBS-#endif-import Data.List (intercalate)-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 Data.Scientific (Scientific)-import Data.Semigroup (Semigroup, (<>))-import qualified Data.Text as T-import qualified Data.Text.Encoding as T-import qualified Data.Text.Lazy as LT-import qualified Data.Text.Lazy.Encoding as LT-#if MIN_VERSION_text_short(0,1,0)-import qualified Data.Text.Short as T.S-#endif-import Data.Tuple.Only (Only(..))-import Data.Vector (Vector, (!))-import qualified Data.Vector as V-import qualified Data.Vector.Unboxed as U-import Data.Word (Word8, Word16, Word32, Word64)-import GHC.Float (double2Float)-import GHC.Generics-import Numeric.Natural-import Prelude hiding (lookup, takeWhile)--import Data.Csv.Conversion.Internal-import Data.Csv.Types--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative (Applicative, (<$>), (<*>), (<*), (*>), pure)-import Data.Monoid (Monoid, mappend, mempty)-import Data.Traversable (traverse)-import Data.Word (Word)-#endif----------------------------------------------------------------------------- bytestring compatibility--toStrict :: L.ByteString -> B.ByteString-fromStrict :: B.ByteString -> L.ByteString-#if MIN_VERSION_bytestring(0,10,0)-toStrict = L.toStrict-fromStrict = L.fromStrict-#else-toStrict = B.concat . L.toChunks-fromStrict = L.fromChunks . (:[])-#endif-{-# INLINE toStrict #-}-{-# INLINE fromStrict #-}----------------------------------------------------------------------------- Type conversion----------------------------------------------------------------------------- Index-based conversion---- | Options to customise how to generically encode\/decode your--- datatype to\/from CSV.------ @since 0.5.1.0-newtype Options = Options- { fieldLabelModifier :: String -> String- -- ^ How to convert Haskell field labels to CSV fields.- --- -- @since 0.5.1.0- }--instance Show Options where- show (Options fld) =- "Options {"- ++ intercalate ","- [ "fieldLabelModifier =~ " ++ show sampleField ++ " -> " ++ show (fld sampleField)- ]- ++ "}"- where- sampleField = "_column_A"---- | Default conversion options.------ @--- Options--- { 'fieldLabelModifier' = id--- }--- @------ @since 0.5.1.0-defaultOptions :: Options-defaultOptions = Options- { fieldLabelModifier = id- }---- | A type that can be converted from a single CSV record, with the--- possibility of failure.------ When writing an instance, use 'empty', 'mzero', or 'fail' to make a--- conversion fail, e.g. if a 'Record' has the wrong number of--- columns.------ Given this example data:------ > John,56--- > Jane,55------ here's an example type and instance:------ > data Person = Person { name :: !Text, age :: !Int }--- >--- > instance FromRecord Person where--- > parseRecord v--- > | length v == 2 = Person <$>--- > v .! 0 <*>--- > v .! 1--- > | otherwise = mzero-class FromRecord a where- parseRecord :: Record -> Parser a-- default parseRecord :: (Generic a, GFromRecord (Rep a)) => Record -> Parser a- parseRecord = genericParseRecord defaultOptions---- | A configurable CSV record parser. This function applied to--- 'defaultOptions' is used as the default for 'parseRecord' when the--- type is an instance of 'Generic'.------ @since 0.5.1.0-genericParseRecord :: (Generic a, GFromRecord (Rep a)) => Options -> Record -> Parser a-genericParseRecord opts r = to <$> gparseRecord opts r---- | A type that can be converted to a single CSV record.------ An example type and instance:------ > data Person = Person { name :: !Text, age :: !Int }--- >--- > instance ToRecord Person where--- > toRecord (Person name age) = record [--- > toField name, toField age]------ Outputs data on this form:------ > John,56--- > Jane,55-class ToRecord a where- -- | Convert a value to a record.- toRecord :: a -> Record-- default toRecord :: (Generic a, GToRecord (Rep a) Field) => a -> Record- toRecord = genericToRecord defaultOptions---- | A configurable CSV record creator. This function applied to--- 'defaultOptions' is used as the default for 'toRecord' when the--- type is an instance of 'Generic'.------ @since 0.5.1.0-genericToRecord :: (Generic a, GToRecord (Rep a) Field) => Options -> a -> Record-genericToRecord opts = V.fromList . gtoRecord opts . from--instance FromField a => FromRecord (Only a) where- parseRecord v- | n == 1 = Only <$> unsafeIndex v 0- | otherwise = lengthMismatch 1 v- where- n = V.length v---- TODO: Check if we want all toRecord conversions to be stricter.--instance ToField a => ToRecord (Only a) where- toRecord = V.singleton . toField . fromOnly--instance (FromField a, FromField b) => FromRecord (a, b) where- parseRecord v- | n == 2 = (,) <$> unsafeIndex v 0- <*> unsafeIndex v 1- | otherwise = lengthMismatch 2 v- where- n = V.length v--instance (ToField a, ToField b) => ToRecord (a, b) where- toRecord (a, b) = V.fromList [toField a, toField b]--instance (FromField a, FromField b, FromField c) => FromRecord (a, b, c) where- parseRecord v- | n == 3 = (,,) <$> unsafeIndex v 0- <*> unsafeIndex v 1- <*> unsafeIndex v 2- | otherwise = lengthMismatch 3 v- where- n = V.length v--instance (ToField a, ToField b, ToField c) =>- ToRecord (a, b, c) where- toRecord (a, b, c) = V.fromList [toField a, toField b, toField c]--instance (FromField a, FromField b, FromField c, FromField d) =>- FromRecord (a, b, c, d) where- parseRecord v- | n == 4 = (,,,) <$> unsafeIndex v 0- <*> unsafeIndex v 1- <*> unsafeIndex v 2- <*> unsafeIndex v 3- | otherwise = lengthMismatch 4 v- where- n = V.length v--instance (ToField a, ToField b, ToField c, ToField d) =>- ToRecord (a, b, c, d) where- toRecord (a, b, c, d) = V.fromList [- toField a, toField b, toField c, toField d]--instance (FromField a, FromField b, FromField c, FromField d, FromField e) =>- FromRecord (a, b, c, d, e) where- parseRecord v- | n == 5 = (,,,,) <$> unsafeIndex v 0- <*> unsafeIndex v 1- <*> unsafeIndex v 2- <*> unsafeIndex v 3- <*> unsafeIndex v 4- | otherwise = lengthMismatch 5 v- where- n = V.length v--instance (ToField a, ToField b, ToField c, ToField d, ToField e) =>- ToRecord (a, b, c, d, e) where- toRecord (a, b, c, d, e) = V.fromList [- toField a, toField b, toField c, toField d, toField e]--instance (FromField a, FromField b, FromField c, FromField d, FromField e,- FromField f) =>- FromRecord (a, b, c, d, e, f) where- parseRecord v- | n == 6 = (,,,,,) <$> unsafeIndex v 0- <*> unsafeIndex v 1- <*> unsafeIndex v 2- <*> unsafeIndex v 3- <*> unsafeIndex v 4- <*> unsafeIndex v 5- | otherwise = lengthMismatch 6 v- where- n = V.length v--instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f) =>- ToRecord (a, b, c, d, e, f) where- toRecord (a, b, c, d, e, f) = V.fromList [- toField a, toField b, toField c, toField d, toField e, toField f]--instance (FromField a, FromField b, FromField c, FromField d, FromField e,- FromField f, FromField g) =>- FromRecord (a, b, c, d, e, f, g) where- parseRecord v- | n == 7 = (,,,,,,) <$> unsafeIndex v 0- <*> unsafeIndex v 1- <*> unsafeIndex v 2- <*> unsafeIndex v 3- <*> unsafeIndex v 4- <*> unsafeIndex v 5- <*> unsafeIndex v 6- | otherwise = lengthMismatch 7 v- where- n = V.length v--instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,- ToField g) =>- ToRecord (a, b, c, d, e, f, g) where- toRecord (a, b, c, d, e, f, g) = V.fromList [- toField a, toField b, toField c, toField d, toField e, toField f,- toField g]--instance (FromField a, FromField b, FromField c, FromField d, FromField e,- FromField f, FromField g, FromField h) =>- FromRecord (a, b, c, d, e, f, g, h) where- parseRecord v- | n == 8 = (,,,,,,,) <$> unsafeIndex v 0- <*> unsafeIndex v 1- <*> unsafeIndex v 2- <*> unsafeIndex v 3- <*> unsafeIndex v 4- <*> unsafeIndex v 5- <*> unsafeIndex v 6- <*> unsafeIndex v 7- | otherwise = lengthMismatch 8 v- where- n = V.length v--instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,- ToField g, ToField h) =>- ToRecord (a, b, c, d, e, f, g, h) where- toRecord (a, b, c, d, e, f, g, h) = V.fromList [- toField a, toField b, toField c, toField d, toField e, toField f,- toField g, toField h]--instance (FromField a, FromField b, FromField c, FromField d, FromField e,- FromField f, FromField g, FromField h, FromField i) =>- FromRecord (a, b, c, d, e, f, g, h, i) where- parseRecord v- | n == 9 = (,,,,,,,,) <$> unsafeIndex v 0- <*> unsafeIndex v 1- <*> unsafeIndex v 2- <*> unsafeIndex v 3- <*> unsafeIndex v 4- <*> unsafeIndex v 5- <*> unsafeIndex v 6- <*> unsafeIndex v 7- <*> unsafeIndex v 8- | otherwise = lengthMismatch 9 v- where- n = V.length v--instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,- ToField g, ToField h, ToField i) =>- ToRecord (a, b, c, d, e, f, g, h, i) where- toRecord (a, b, c, d, e, f, g, h, i) = V.fromList [- toField a, toField b, toField c, toField d, toField e, toField f,- toField g, toField h, toField i]--instance (FromField a, FromField b, FromField c, FromField d, FromField e,- FromField f, FromField g, FromField h, FromField i, FromField j) =>- FromRecord (a, b, c, d, e, f, g, h, i, j) where- parseRecord v- | n == 10 = (,,,,,,,,,) <$> unsafeIndex v 0- <*> unsafeIndex v 1- <*> unsafeIndex v 2- <*> unsafeIndex v 3- <*> unsafeIndex v 4- <*> unsafeIndex v 5- <*> unsafeIndex v 6- <*> unsafeIndex v 7- <*> unsafeIndex v 8- <*> unsafeIndex v 9- | otherwise = lengthMismatch 10 v- where- n = V.length v--instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,- ToField g, ToField h, ToField i, ToField j) =>- ToRecord (a, b, c, d, e, f, g, h, i, j) where- toRecord (a, b, c, d, e, f, g, h, i, j) = V.fromList [- toField a, toField b, toField c, toField d, toField e, toField f,- toField g, toField h, toField i, toField j]--instance (FromField a, FromField b, FromField c, FromField d, FromField e,- FromField f, FromField g, FromField h, FromField i, FromField j,- FromField k) =>- FromRecord (a, b, c, d, e, f, g, h, i, j, k) where- parseRecord v- | n == 11 = (,,,,,,,,,,) <$> unsafeIndex v 0- <*> unsafeIndex v 1- <*> unsafeIndex v 2- <*> unsafeIndex v 3- <*> unsafeIndex v 4- <*> unsafeIndex v 5- <*> unsafeIndex v 6- <*> unsafeIndex v 7- <*> unsafeIndex v 8- <*> unsafeIndex v 9- <*> unsafeIndex v 10- | otherwise = lengthMismatch 11 v- where- n = V.length v--instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,- ToField g, ToField h, ToField i, ToField j, ToField k) =>- ToRecord (a, b, c, d, e, f, g, h, i, j, k) where- toRecord (a, b, c, d, e, f, g, h, i, j, k) = V.fromList [- toField a, toField b, toField c, toField d, toField e, toField f,- toField g, toField h, toField i, toField j, toField k]--instance (FromField a, FromField b, FromField c, FromField d, FromField e,- FromField f, FromField g, FromField h, FromField i, FromField j,- FromField k, FromField l) =>- FromRecord (a, b, c, d, e, f, g, h, i, j, k, l) where- parseRecord v- | n == 12 = (,,,,,,,,,,,) <$> unsafeIndex v 0- <*> unsafeIndex v 1- <*> unsafeIndex v 2- <*> unsafeIndex v 3- <*> unsafeIndex v 4- <*> unsafeIndex v 5- <*> unsafeIndex v 6- <*> unsafeIndex v 7- <*> unsafeIndex v 8- <*> unsafeIndex v 9- <*> unsafeIndex v 10- <*> unsafeIndex v 11- | otherwise = lengthMismatch 12 v- where- n = V.length v--instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,- ToField g, ToField h, ToField i, ToField j, ToField k, ToField l) =>- ToRecord (a, b, c, d, e, f, g, h, i, j, k, l) where- toRecord (a, b, c, d, e, f, g, h, i, j, k, l) = V.fromList [- toField a, toField b, toField c, toField d, toField e, toField f,- toField g, toField h, toField i, toField j, toField k, toField l]--instance (FromField a, FromField b, FromField c, FromField d, FromField e,- FromField f, FromField g, FromField h, FromField i, FromField j,- FromField k, FromField l, FromField m) =>- FromRecord (a, b, c, d, e, f, g, h, i, j, k, l, m) where- parseRecord v- | n == 13 = (,,,,,,,,,,,,) <$> unsafeIndex v 0- <*> unsafeIndex v 1- <*> unsafeIndex v 2- <*> unsafeIndex v 3- <*> unsafeIndex v 4- <*> unsafeIndex v 5- <*> unsafeIndex v 6- <*> unsafeIndex v 7- <*> unsafeIndex v 8- <*> unsafeIndex v 9- <*> unsafeIndex v 10- <*> unsafeIndex v 11- <*> unsafeIndex v 12- | otherwise = lengthMismatch 13 v- where- n = V.length v--instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,- ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,- ToField m) =>- ToRecord (a, b, c, d, e, f, g, h, i, j, k, l, m) where- toRecord (a, b, c, d, e, f, g, h, i, j, k, l, m) = V.fromList [- toField a, toField b, toField c, toField d, toField e, toField f,- toField g, toField h, toField i, toField j, toField k, toField l,- toField m]--instance (FromField a, FromField b, FromField c, FromField d, FromField e,- FromField f, FromField g, FromField h, FromField i, FromField j,- FromField k, FromField l, FromField m, FromField n) =>- FromRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where- parseRecord v- | n == 14 = (,,,,,,,,,,,,,) <$> unsafeIndex v 0- <*> unsafeIndex v 1- <*> unsafeIndex v 2- <*> unsafeIndex v 3- <*> unsafeIndex v 4- <*> unsafeIndex v 5- <*> unsafeIndex v 6- <*> unsafeIndex v 7- <*> unsafeIndex v 8- <*> unsafeIndex v 9- <*> unsafeIndex v 10- <*> unsafeIndex v 11- <*> unsafeIndex v 12- <*> unsafeIndex v 13- | otherwise = lengthMismatch 14 v- where- n = V.length v--instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,- ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,- ToField m, ToField n) =>- ToRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where- toRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = V.fromList [- toField a, toField b, toField c, toField d, toField e, toField f,- toField g, toField h, toField i, toField j, toField k, toField l,- toField m, toField n]--instance (FromField a, FromField b, FromField c, FromField d, FromField e,- FromField f, FromField g, FromField h, FromField i, FromField j,- FromField k, FromField l, FromField m, FromField n, FromField o) =>- FromRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where- parseRecord v- | n == 15 = (,,,,,,,,,,,,,,) <$> unsafeIndex v 0- <*> unsafeIndex v 1- <*> unsafeIndex v 2- <*> unsafeIndex v 3- <*> unsafeIndex v 4- <*> unsafeIndex v 5- <*> unsafeIndex v 6- <*> unsafeIndex v 7- <*> unsafeIndex v 8- <*> unsafeIndex v 9- <*> unsafeIndex v 10- <*> unsafeIndex v 11- <*> unsafeIndex v 12- <*> unsafeIndex v 13- <*> unsafeIndex v 14- | otherwise = lengthMismatch 15 v- where- n = V.length v--instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,- ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,- ToField m, ToField n, ToField o) =>- ToRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where- toRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = V.fromList [- toField a, toField b, toField c, toField d, toField e, toField f,- toField g, toField h, toField i, toField j, toField k, toField l,- toField m, toField n, toField o]--lengthMismatch :: Int -> Record -> Parser a-lengthMismatch expected v =- fail $ "cannot unpack array of length " ++- show n ++ " into a " ++ desired ++ ". Input record: " ++- show v- where- n = V.length v- desired | expected == 1 = "Only"- | expected == 2 = "pair"- | otherwise = show expected ++ "-tuple"--instance FromField a => FromRecord [a] where- parseRecord = traverse parseField . V.toList--instance ToField a => ToRecord [a] where- toRecord = V.fromList . map toField--instance FromField a => FromRecord (V.Vector a) where- parseRecord = traverse parseField--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---- | A type that can be converted from a single CSV record, with the--- possibility of failure.------ When writing an instance, use 'empty', 'mzero', or 'fail' to make a--- conversion fail, e.g. if a 'Record' has the wrong number of--- columns.------ Given this example data:------ > name,age--- > John,56--- > Jane,55------ here's an example type and instance:------ > {-# LANGUAGE OverloadedStrings #-}--- >--- > data Person = Person { name :: !Text, age :: !Int }--- >--- > instance FromNamedRecord Person where--- > parseNamedRecord m = Person <$>--- > m .: "name" <*>--- > m .: "age"------ Note the use of the @OverloadedStrings@ language extension which--- enables 'B8.ByteString' values to be written as string literals.-class FromNamedRecord a where- parseNamedRecord :: NamedRecord -> Parser a-- default parseNamedRecord :: (Generic a, GFromNamedRecord (Rep a)) => NamedRecord -> Parser a- parseNamedRecord = genericParseNamedRecord defaultOptions---- | A configurable CSV named record parser. This function applied to--- 'defaultOptions' is used as the default for 'parseNamedRecord'--- when the type is an instance of 'Generic'.------ @since 0.5.1.0-genericParseNamedRecord :: (Generic a, GFromNamedRecord (Rep a)) => Options -> NamedRecord -> Parser a-genericParseNamedRecord opts r = to <$> gparseNamedRecord opts r---- | A type that can be converted to a single CSV record.------ An example type and instance:------ > data Person = Person { name :: !Text, age :: !Int }--- >--- > instance ToNamedRecord Person where--- > toNamedRecord (Person name age) = namedRecord [--- > "name" .= name, "age" .= age]-class ToNamedRecord a where- -- | Convert a value to a named record.- toNamedRecord :: a -> NamedRecord-- default toNamedRecord ::- (Generic a, GToRecord (Rep a) (B.ByteString, B.ByteString)) =>- a -> NamedRecord- toNamedRecord = genericToNamedRecord defaultOptions---- | A configurable CSV named record creator. This function applied--- to 'defaultOptions' is used as the default for 'toNamedRecord' when--- the type is an instance of 'Generic'.------ @since 0.5.1.0-genericToNamedRecord :: (Generic a, GToRecord (Rep a) (B.ByteString, B.ByteString))- => Options -> a -> NamedRecord-genericToNamedRecord opts = namedRecord . gtoRecord opts . from---- | 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 = genericHeaderOrder defaultOptions---- | A configurable CSV header record generator. This function--- applied to 'defaultOptions' is used as the default for--- 'headerOrder' when the type is an instance of 'Generic'.------ @since 0.5.1.0-genericHeaderOrder :: (Generic a, GToNamedRecordHeader (Rep a))- => Options -> a -> Header-genericHeaderOrder opts = V.fromList. gtoNamedRecordHeader opts . from--instance (FromField a, FromField b, Ord a) => FromNamedRecord (M.Map a b) where- parseNamedRecord m = M.fromList <$>- (traverse parseBoth $ HM.toList m)--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 (Eq a, FromField a, FromField b, Hashable a) => FromNamedRecord (HM.HashMap a b) where- parseNamedRecord m = HM.fromList <$>- (traverse parseBoth $ HM.toList m)--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---- | A type that can be converted from a single CSV field, with the--- possibility of failure.------ When writing an instance, use 'empty', 'mzero', or 'fail' to make a--- conversion fail, e.g. if a 'Field' can't be converted to the given--- type.------ Example type and instance:------ > {-# LANGUAGE OverloadedStrings #-}--- >--- > data Color = Red | Green | Blue--- >--- > instance FromField Color where--- > parseField s--- > | s == "R" = pure Red--- > | s == "G" = pure Green--- > | s == "B" = pure Blue--- > | otherwise = mzero-class FromField a where- parseField :: Field -> Parser a---- | A type that can be converted to a single CSV field.------ Example type and instance:------ > {-# LANGUAGE OverloadedStrings #-}--- >--- > data Color = Red | Green | Blue--- >--- > instance ToField Color where--- > toField Red = "R"--- > toField Green = "G"--- > toField Blue = "B"-class ToField a where- toField :: a -> Field---- | 'Nothing' if the 'Field' is 'B.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 'B.empty' field.-instance ToField a => ToField (Maybe a) where- toField = maybe B.empty toField- {-# INLINE toField #-}---- | @'Left' field@ if conversion failed, 'Right' otherwise.-instance FromField a => FromField (Either Field a) where- parseField s = case runParser (parseField s) of- Left _ -> pure $ Left s- Right a -> pure $ Right a- {-# INLINE parseField #-}---- | Ignores the 'Field'. Always succeeds.-instance FromField () where- parseField _ = pure ()- {-# INLINE parseField #-}---- | Assumes UTF-8 encoding.-instance FromField Char where- parseField s =- case T.decodeUtf8' s of- Left e -> fail $ show e- Right t- | T.compareLength t 1 == EQ -> pure (T.head t)- | otherwise -> typeError "Char" s Nothing- {-# INLINE parseField #-}---- | Uses UTF-8 encoding.-instance ToField Char where- toField = toField . T.encodeUtf8 . T.singleton- {-# INLINE toField #-}---- | Accepts the same syntax as 'rational'. Ignores whitespace.------ @since 0.5.1.0-instance FromField Scientific where- parseField s = case parseOnly (ws *> A8.scientific <* ws) s of- Left err -> typeError "Scientific" s (Just err)- Right n -> pure n- {-# INLINE parseField #-}---- | Uses decimal notation or scientific notation, depending on the number.------ @since 0.5.1.0-instance ToField Scientific where- toField = scientific- {-# INLINE toField #-}---- | Accepts same syntax as 'rational'. Ignores whitespace.-instance FromField Double where- parseField = parseDouble- {-# INLINE parseField #-}---- | Uses decimal notation or scientific notation, depending on the--- number.-instance ToField Double where- toField = realFloat- {-# INLINE toField #-}---- | Accepts same syntax as 'rational'. Ignores whitespace.-instance FromField Float where- parseField s = double2Float <$> parseDouble s- {-# INLINE parseField #-}---- | Uses decimal notation or scientific notation, depending on the--- number.-instance ToField Float where- toField = realFloat- {-# INLINE toField #-}--parseDouble :: B.ByteString -> Parser Double-parseDouble s = case parseOnly (ws *> double <* ws) s of- Left err -> typeError "Double" s (Just err)- Right n -> pure n-{-# INLINE parseDouble #-}---- | Accepts a signed decimal number. Ignores whitespace.-instance FromField Int where- parseField = parseSigned "Int"- {-# INLINE parseField #-}---- | Uses decimal encoding with optional sign.-instance ToField Int where- toField = decimal- {-# INLINE toField #-}---- | Accepts a signed decimal number. Ignores whitespace.-instance FromField Integer where- parseField = parseSigned "Integer"- {-# INLINE parseField #-}---- | Uses decimal encoding with optional sign.-instance ToField Integer where- toField = decimal- {-# INLINE toField #-}---- | Accepts a signed decimal number. Ignores whitespace.-instance FromField Int8 where- parseField = parseSigned "Int8"- {-# INLINE parseField #-}---- | Uses decimal encoding with optional sign.-instance ToField Int8 where- toField = decimal- {-# INLINE toField #-}---- | Accepts a signed decimal number. Ignores whitespace.-instance FromField Int16 where- parseField = parseSigned "Int16"- {-# INLINE parseField #-}---- | Uses decimal encoding with optional sign.-instance ToField Int16 where- toField = decimal- {-# INLINE toField #-}---- | Accepts a signed decimal number. Ignores whitespace.-instance FromField Int32 where- parseField = parseSigned "Int32"- {-# INLINE parseField #-}---- | Uses decimal encoding with optional sign.-instance ToField Int32 where- toField = decimal- {-# INLINE toField #-}---- | Accepts a signed decimal number. Ignores whitespace.-instance FromField Int64 where- parseField = parseSigned "Int64"- {-# INLINE parseField #-}---- | Uses decimal encoding with optional sign.-instance ToField Int64 where- toField = decimal- {-# INLINE toField #-}---- | Accepts an unsigned decimal number. Ignores whitespace.-instance FromField Word where- parseField = parseUnsigned "Word"- {-# INLINE parseField #-}---- | Uses decimal encoding.-instance ToField Word where- toField = decimal- {-# INLINE toField #-}---- | Accepts an unsigned decimal number. Ignores whitespace.------ @since 0.5.1.0-instance FromField Natural where- parseField = parseUnsigned "Natural"- {-# INLINE parseField #-}---- | Uses decimal encoding.------ @since 0.5.1.0-instance ToField Natural where- toField = decimal- {-# INLINE toField #-}---- | Accepts an unsigned decimal number. Ignores whitespace.-instance FromField Word8 where- parseField = parseUnsigned "Word8"- {-# INLINE parseField #-}---- | Uses decimal encoding.-instance ToField Word8 where- toField = decimal- {-# INLINE toField #-}---- | Accepts an unsigned decimal number. Ignores whitespace.-instance FromField Word16 where- parseField = parseUnsigned "Word16"- {-# INLINE parseField #-}---- | Uses decimal encoding.-instance ToField Word16 where- toField = decimal- {-# INLINE toField #-}---- | Accepts an unsigned decimal number. Ignores whitespace.-instance FromField Word32 where- parseField = parseUnsigned "Word32"- {-# INLINE parseField #-}---- | Uses decimal encoding.-instance ToField Word32 where- toField = decimal- {-# INLINE toField #-}---- | Accepts an unsigned decimal number. Ignores whitespace.-instance FromField Word64 where- parseField = parseUnsigned "Word64"- {-# INLINE parseField #-}---- | Uses decimal encoding.-instance ToField Word64 where- toField = decimal- {-# INLINE toField #-}--instance FromField B.ByteString where- parseField = pure- {-# INLINE parseField #-}--instance ToField B.ByteString where- toField = id- {-# INLINE toField #-}--instance FromField L.ByteString where- parseField = pure . fromStrict- {-# INLINE parseField #-}--instance ToField L.ByteString where- toField = toStrict- {-# INLINE toField #-}--#if MIN_VERSION_bytestring(0,10,4)-instance FromField SBS.ShortByteString where- parseField = pure . SBS.toShort- {-# INLINE parseField #-}--instance ToField SBS.ShortByteString where- toField = SBS.fromShort- {-# INLINE toField #-}-#endif--#if MIN_VERSION_text_short(0,1,0)--- | Assumes UTF-8 encoding. Fails on invalid byte sequences.------ @since 0.5.0.0-instance FromField T.S.ShortText where- parseField = maybe (fail "Invalid UTF-8 stream") pure . T.S.fromByteString- {-# INLINE parseField #-}---- | Uses UTF-8 encoding.------ @since 0.5.0.0-instance ToField T.S.ShortText where- toField = T.S.toByteString- {-# INLINE toField #-}-#endif---- | Assumes UTF-8 encoding. Fails on invalid byte sequences.-instance FromField T.Text where- parseField = either (fail . show) pure . T.decodeUtf8'- {-# INLINE parseField #-}---- | Uses UTF-8 encoding.-instance ToField T.Text where- toField = toField . T.encodeUtf8- {-# INLINE toField #-}---- | Assumes UTF-8 encoding. Fails on invalid byte sequences.-instance FromField LT.Text where- parseField = either (fail . show) (pure . LT.fromStrict) . T.decodeUtf8'- {-# INLINE parseField #-}---- | Uses UTF-8 encoding.-instance ToField LT.Text where- toField = toField . toStrict . LT.encodeUtf8- {-# INLINE toField #-}---- | Assumes UTF-8 encoding. Fails on invalid byte sequences.-instance FromField [Char] where- parseField = fmap T.unpack . parseField- {-# INLINE parseField #-}---- | Uses UTF-8 encoding.-instance ToField [Char] where- toField = toField . T.pack- {-# INLINE toField #-}--parseSigned :: (Integral a, Num a) => String -> B.ByteString -> Parser a-parseSigned typ s = case parseOnly (ws *> A8.signed A8.decimal <* ws) s of- Left err -> typeError typ s (Just err)- Right n -> pure n-{-# INLINE parseSigned #-}--parseUnsigned :: Integral a => String -> B.ByteString -> Parser a-parseUnsigned typ s = case parseOnly (ws *> A8.decimal <* ws) s of- Left err -> typeError typ s (Just err)- Right n -> pure n-{-# INLINE parseUnsigned #-}--ws :: A8.Parser ()-ws = A8.skipWhile (\c -> c == ' ' || c == '\t')------------------------------------------------------------------------------- Custom version of attoparsec @parseOnly@ function which fails if--- there is leftover content after parsing a field.-parseOnly :: A8.Parser a -> B.ByteString -> Either String a-parseOnly parser input = go (A8.parse parser input) where- go (A8.Fail _ _ err) = Left err- go (A8.Partial f) = go2 (f B.empty)- go (A8.Done leftover result)- | B.null leftover = Right result- | otherwise = Left ("incomplete field parse, leftover: "- ++ show (B.unpack leftover))-- go2 (A8.Fail _ _ err) = Left err- go2 (A8.Partial _) = error "parseOnly: impossible error!"- go2 (A8.Done leftover result)- | B.null leftover = Right result- | otherwise = Left ("incomplete field parse, leftover: "- ++ show (B.unpack leftover))-{-# INLINE parseOnly #-}--typeError :: String -> B.ByteString -> Maybe String -> Parser a-typeError typ s mmsg =- fail $ "expected " ++ typ ++ ", got " ++ show (B8.unpack s) ++ cause- where- cause = case mmsg of- Just msg -> " (" ++ msg ++ ")"- Nothing -> ""----------------------------------------------------------------------------- Constructors and accessors---- | Retrieve the /n/th field in the given record. The result is--- 'empty' if the value cannot be converted to the desired type.--- Raises an exception if the index is out of bounds.------ 'index' is a simple convenience function that is equivalent to--- @'parseField' (v '!' idx)@. If you're certain that the index is not--- out of bounds, using 'unsafeIndex' is somewhat faster.-index :: FromField a => Record -> Int -> Parser a-index v idx = parseField (v ! idx)-{-# INLINE index #-}---- | Alias for 'index'.-(.!) :: FromField a => Record -> Int -> Parser a-(.!) = index-{-# INLINE (.!) #-}-infixl 9 .!---- | Like 'index' but without bounds checking.-unsafeIndex :: FromField a => Record -> Int -> Parser a-unsafeIndex v idx = parseField (V.unsafeIndex v idx)-{-# INLINE unsafeIndex #-}---- | Retrieve a field in the given record by name. The result is--- 'empty' if the field is missing or if the value cannot be converted--- to the desired type.-lookup :: FromField a => NamedRecord -> B.ByteString -> Parser a-lookup m name = maybe (fail err) parseField $ HM.lookup name m- where err = "no field named " ++ show (B8.unpack name)-{-# INLINE lookup #-}---- | Alias for 'lookup'.-(.:) :: FromField a => NamedRecord -> B.ByteString -> Parser a-(.:) = lookup-{-# INLINE (.:) #-}---- | Construct a pair from a name and a value. For use with--- 'namedRecord'.-namedField :: ToField a => B.ByteString -> a -> (B.ByteString, B.ByteString)-namedField name val = (name, toField val)-{-# INLINE namedField #-}---- | Alias for 'namedField'.-(.=) :: ToField a => B.ByteString -> a -> (B.ByteString, B.ByteString)-(.=) = namedField-{-# INLINE (.=) #-}---- | Construct a record from a list of 'B.ByteString's. Use 'toField'--- to convert values to 'B.ByteString's for use with 'record'.-record :: [B.ByteString] -> Record-record = V.fromList---- | Construct a named record from a list of name-value 'B.ByteString'--- pairs. Use '.=' to construct such a pair from a name and a value.-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---- | Failure continuation.-type Failure f r = String -> f r--- | Success continuation.-type Success a f r = a -> f r---- | Conversion of a field to a value might fail e.g. if the field is--- malformed. This possibility is captured by the 'Parser' type, which--- lets you compose several field conversions together in such a way--- that if any of them fail, the whole record conversion fails.-newtype Parser a = Parser {- unParser :: forall (f :: * -> *) (r :: *).- Failure f r- -> Success a f r- -> f r- }--instance Monad Parser where- m >>= g = Parser $ \kf ks -> let ks' a = unParser (g a) kf ks- in unParser m kf ks'- {-# INLINE (>>=) #-}- (>>) = (*>)- {-# INLINE (>>) #-}- return = pure- {-# INLINE return #-}- fail = Fail.fail- {-# INLINE fail #-}---- | @since 0.5.0.0-instance Fail.MonadFail Parser where- fail msg = Parser $ \kf _ks -> kf msg- {-# INLINE fail #-}--instance Functor Parser where- fmap f m = Parser $ \kf ks -> let ks' a = ks (f a)- in unParser m kf ks'- {-# INLINE fmap #-}--instance Applicative Parser where- pure a = Parser $ \_kf ks -> ks a- {-# INLINE pure #-}- (<*>) = apP- {-# INLINE (<*>) #-}--instance Alternative Parser where- empty = fail "empty"- {-# INLINE empty #-}- (<|>) = mplus- {-# INLINE (<|>) #-}--instance MonadPlus Parser where- mzero = fail "mzero"- {-# INLINE mzero #-}- mplus a b = Parser $ \kf ks -> let kf' _ = unParser b kf ks- in unParser a kf' ks- {-# INLINE mplus #-}---- | @since 0.5.0.0-instance Semigroup (Parser a) where- (<>) = mplus- {-# INLINE (<>) #-}--instance Monoid (Parser a) where- mempty = fail "mempty"- {-# INLINE mempty #-}- mappend = (<>)- {-# INLINE mappend #-}--apP :: Parser (a -> b) -> Parser a -> Parser b-apP d e = do- b <- d- a <- e- pure (b a)-{-# INLINE apP #-}---- | Run a 'Parser', returning either @'Left' errMsg@ or @'Right'--- result@. Forces the value in the 'Left' or 'Right' constructors to--- weak head normal form.------ You most likely won't need to use this function directly, but it's--- included for completeness.-runParser :: Parser a -> Either String a-runParser p = unParser p left right- where- left !errMsg = Left errMsg- right !x = Right x-{-# INLINE runParser #-}----------------------------------------------------------------------------- Generics--class GFromRecord f where- gparseRecord :: Options -> Record -> Parser (f p)--instance GFromRecordSum f Record => GFromRecord (M1 i n f) where- gparseRecord opts v =- case IM.lookup n (gparseRecordSum opts) of- Nothing -> lengthMismatch n v- Just p -> M1 <$> p v- where- n = V.length v--class GFromNamedRecord f where- gparseNamedRecord :: Options -> NamedRecord -> Parser (f p)--instance GFromRecordSum f NamedRecord => GFromNamedRecord (M1 i n f) where- gparseNamedRecord opts v =- foldr (\f p -> p <|> M1 <$> f v) empty (IM.elems (gparseRecordSum opts))--class GFromRecordSum f r where- gparseRecordSum :: Options -> IM.IntMap (r -> Parser (f p))--instance (GFromRecordSum a r, GFromRecordSum b r) => GFromRecordSum (a :+: b) r where- gparseRecordSum opts =- IM.unionWith (\a b r -> a r <|> b r)- (fmap (L1 <$>) <$> gparseRecordSum opts)- (fmap (R1 <$>) <$> gparseRecordSum opts)--instance GFromRecordProd f r => GFromRecordSum (M1 i n f) r where- gparseRecordSum opts = IM.singleton n (fmap (M1 <$>) f)- where- (n, f) = gparseRecordProd opts 0--class GFromRecordProd f r where- gparseRecordProd :: Options -> 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 opts n0 = (n2, f)- where- f r = (:*:) <$> fa r <*> fb r- (n1, fa) = gparseRecordProd opts n0- (n2, fb) = gparseRecordProd opts n1--instance GFromRecordProd f Record => GFromRecordProd (M1 i n f) Record where- gparseRecordProd opts n = fmap (M1 <$>) <$> gparseRecordProd opts 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 opts n = (n + 1, \v -> (M1 . K1) <$> v .: name)- where- name = T.encodeUtf8 (T.pack (fieldLabelModifier opts (selName (Proxy :: Proxy s f a))))---class GToRecord a f where- gtoRecord :: Options -> a p -> [f]--instance GToRecord U1 f where- gtoRecord _ U1 = []--instance (GToRecord a f, GToRecord b f) => GToRecord (a :*: b) f where- gtoRecord opts (a :*: b) = gtoRecord opts a ++ gtoRecord opts b--instance (GToRecord a f, GToRecord b f) => GToRecord (a :+: b) f where- gtoRecord opts (L1 a) = gtoRecord opts a- gtoRecord opts (R1 b) = gtoRecord opts b--instance GToRecord a f => GToRecord (M1 D c a) f where- gtoRecord opts (M1 a) = gtoRecord opts a--instance GToRecord a f => GToRecord (M1 C c a) f where- gtoRecord opts (M1 a) = gtoRecord opts a--instance GToRecord a Field => GToRecord (M1 S c a) Field where- gtoRecord opts (M1 a) = gtoRecord opts 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 opts m@(M1 (K1 a)) = [name .= toField a]- where- name = T.encodeUtf8 (T.pack (fieldLabelModifier opts (selName m)))---- We statically fail on sum types and product types without selectors--- (field names).--class GToNamedRecordHeader a- where- gtoNamedRecordHeader :: Options -> a p -> [Name]--instance GToNamedRecordHeader U1- where- gtoNamedRecordHeader _ _ = []--instance (GToNamedRecordHeader a, GToNamedRecordHeader b) =>- GToNamedRecordHeader (a :*: b)- where- gtoNamedRecordHeader opts _ = gtoNamedRecordHeader opts (undefined :: a p) ++- gtoNamedRecordHeader opts (undefined :: b p)--instance GToNamedRecordHeader a => GToNamedRecordHeader (M1 D c a)- where- gtoNamedRecordHeader opts _ = gtoNamedRecordHeader opts (undefined :: a p)--instance GToNamedRecordHeader a => GToNamedRecordHeader (M1 C c a)- where- gtoNamedRecordHeader opts _ = gtoNamedRecordHeader opts (undefined :: a p)---- | Instance to ensure that you cannot derive DefaultOrdered for--- constructors without selectors.-#if MIN_VERSION_base(4,9,0)-instance DefaultOrdered (M1 S ('MetaSel 'Nothing srcpk srcstr decstr) a ())- => GToNamedRecordHeader (M1 S ('MetaSel 'Nothing srcpk srcstr decstr) a)-#else-instance DefaultOrdered (M1 S NoSelector a ()) => GToNamedRecordHeader (M1 S NoSelector a)-#endif- where- gtoNamedRecordHeader _ _ =- error "You cannot derive DefaultOrdered for constructors without selectors."--instance Selector s => GToNamedRecordHeader (M1 S s a)- where- gtoNamedRecordHeader opts m- | null name = error "Cannot derive DefaultOrdered for constructors without selectors"- | otherwise = [B8.pack (fieldLabelModifier opts (selName m))]- where name = selName m
− Data/Csv/Conversion/Internal.hs
@@ -1,299 +0,0 @@-module Data.Csv.Conversion.Internal- ( decimal- , scientific- , realFloat- ) where--import Data.ByteString.Builder (Builder, toLazyByteString, word8, char8,- string8, byteString)-import qualified Data.ByteString.Builder.Prim as BP-import Data.ByteString.Builder.Scientific (scientificBuilder)-import Data.Array.Base (unsafeAt)-import Data.Array.IArray-import qualified Data.ByteString as B-import Data.Char (ord)-import Data.Int-import Data.Monoid-import Data.Scientific (Scientific)-import Data.Word--import Data.Csv.Util (toStrict)----------------------------------------------------------------------------- Integers--decimal :: Integral a => a -> B.ByteString-decimal = toStrict . toLazyByteString . formatDecimal-{-# INLINE decimal #-}---- TODO: Add an optimized version for Integer.--formatDecimal :: Integral a => a -> Builder-{-# RULES "formatDecimal/Int" formatDecimal = formatBoundedSigned- :: Int -> Builder #-}-{-# RULES "formatDecimal/Int8" formatDecimal = formatBoundedSigned- :: Int8 -> Builder #-}-{-# RULES "formatDecimal/Int16" formatDecimal = formatBoundedSigned- :: Int16 -> Builder #-}-{-# RULES "formatDecimal/Int32" formatDecimal = formatBoundedSigned- :: Int32 -> Builder #-}-{-# RULES "formatDecimal/Int64" formatDecimal = formatBoundedSigned- :: Int64 -> Builder #-}-{-# RULES "formatDecimal/Word" formatDecimal = formatPositive- :: Word -> Builder #-}-{-# RULES "formatDecimal/Word8" formatDecimal = formatPositive- :: Word8 -> Builder #-}-{-# RULES "formatDecimal/Word16" formatDecimal = formatPositive- :: Word16 -> Builder #-}-{-# RULES "formatDecimal/Word32" formatDecimal = formatPositive- :: Word32 -> Builder #-}-{-# RULES "formatDecimal/Word64" formatDecimal = formatPositive- :: Word64 -> Builder #-}-{-# NOINLINE formatDecimal #-}-formatDecimal i- | i < 0 = minus <>- if i <= -128- then formatPositive (-(i `quot` 10)) <> digit (-(i `rem` 10))- else formatPositive (-i)- | otherwise = formatPositive i--formatBoundedSigned :: (Integral a, Bounded a) => a -> Builder-{-# SPECIALIZE formatBoundedSigned :: Int -> Builder #-}-{-# SPECIALIZE formatBoundedSigned :: Int8 -> Builder #-}-{-# SPECIALIZE formatBoundedSigned :: Int16 -> Builder #-}-{-# SPECIALIZE formatBoundedSigned :: Int32 -> Builder #-}-{-# SPECIALIZE formatBoundedSigned :: Int64 -> Builder #-}-formatBoundedSigned i- | i < 0 = minus <>- if i == minBound- then formatPositive (-(i `quot` 10)) <> digit (-(i `rem` 10))- else formatPositive (-i)- | otherwise = formatPositive i--formatPositive :: Integral a => a -> Builder-{-# SPECIALIZE formatPositive :: Int -> Builder #-}-{-# SPECIALIZE formatPositive :: Int8 -> Builder #-}-{-# SPECIALIZE formatPositive :: Int16 -> Builder #-}-{-# SPECIALIZE formatPositive :: Int32 -> Builder #-}-{-# SPECIALIZE formatPositive :: Int64 -> Builder #-}-{-# SPECIALIZE formatPositive :: Word -> Builder #-}-{-# SPECIALIZE formatPositive :: Word8 -> Builder #-}-{-# SPECIALIZE formatPositive :: Word16 -> Builder #-}-{-# SPECIALIZE formatPositive :: Word32 -> Builder #-}-{-# SPECIALIZE formatPositive :: Word64 -> Builder #-}-formatPositive = go- where go n | n < 10 = digit n- | otherwise = go (n `quot` 10) <> digit (n `rem` 10)--minus :: Builder-minus = word8 45--zero :: Word8-zero = 48--digit :: Integral a => a -> Builder-digit n = word8 $! i2w (fromIntegral n)-{-# INLINE digit #-}--i2w :: Int -> Word8-i2w i = zero + fromIntegral i-{-# INLINE i2w #-}----------------------------------------------------------------------------- Floating point numbers--scientific :: Scientific -> B.ByteString-scientific = toStrict . toLazyByteString . scientificBuilder-{-# INLINE scientific #-}--realFloat :: RealFloat a => a -> B.ByteString-{-# SPECIALIZE realFloat :: Float -> B.ByteString #-}-{-# SPECIALIZE realFloat :: Double -> B.ByteString #-}-realFloat = toStrict . toLazyByteString . formatRealFloat Generic---- | Control the rendering of floating point numbers.-data FPFormat = Exponent- -- ^ Scientific notation (e.g. @2.3e123@).- | Fixed- -- ^ Standard decimal notation.- | Generic- -- ^ Use decimal notation for values between @0.1@ and- -- @9,999,999@, and scientific notation otherwise.- deriving (Enum, Read, Show)--formatRealFloat :: RealFloat a => FPFormat -> a -> Builder-{-# SPECIALIZE formatRealFloat :: FPFormat -> Float -> Builder #-}-{-# SPECIALIZE formatRealFloat :: FPFormat -> Double -> Builder #-}-formatRealFloat fmt x- | isNaN x = string8 "NaN"- | isInfinite x = if x < 0- then string8 "-Infinity"- else string8 "Infinity"- | x < 0 || isNegativeZero x = minus <> doFmt fmt (floatToDigits (-x))- | otherwise = doFmt fmt (floatToDigits x)- where- doFmt format (is, e) =- let ds = map i2d is in- case format of- Generic ->- doFmt (if e < 0 || e > 7 then Exponent else Fixed)- (is,e)- Exponent ->- let show_e' = formatDecimal (e-1) in- case ds of- [48] -> string8 "0.0e0"- [d] -> word8 d <> string8 ".0e" <> show_e'- (d:ds') -> word8 d <> char8 '.' <> word8s ds' <>- char8 'e' <> show_e'- [] -> error "formatRealFloat/doFmt/Exponent: []"- Fixed- | e <= 0 -> string8 "0." <>- byteString (B.replicate (-e) zero) <>- word8s ds- | otherwise ->- let- f 0 s rs = mk0 (reverse s) <> char8 '.' <> mk0 rs- f n s [] = f (n-1) (zero:s) []- f n s (r:rs) = f (n-1) (r:s) rs- in- f e [] ds- where mk0 ls = case ls of { [] -> word8 zero ; _ -> word8s ls}---- Based on "Printing Floating-Point Numbers Quickly and Accurately"--- by R.G. Burger and R.K. Dybvig in PLDI 96.--- This version uses a much slower logarithm estimator. It should be improved.---- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,--- and returns a list of digits and an exponent.--- In particular, if @x>=0@, and------ > floatToDigits base x = ([d1,d2,...,dn], e)------ then------ (1) @n >= 1@------ (2) @x = 0.d1d2...dn * (base**e)@------ (3) @0 <= di <= base-1@--floatToDigits :: (RealFloat a) => a -> ([Int], Int)-{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}-{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}-floatToDigits 0 = ([0], 0)-floatToDigits x =- let- (f0, e0) = decodeFloat x- (minExp0, _) = floatRange x- p = floatDigits x- b = floatRadix x- minExp = minExp0 - p -- the real minimum exponent- -- Haskell requires that f be adjusted so denormalized numbers- -- will have an impossibly low exponent. Adjust for this.- (f, e) =- let n = minExp - e0 in- if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)- (r, s, mUp, mDn) =- if e >= 0 then- let be = expt b e in- if f == expt b (p-1) then- (f*be*b*2, 2*b, be*b, be) -- according to Burger and Dybvig- else- (f*be*2, 2, be, be)- else- if e > minExp && f == expt b (p-1) then- (f*b*2, expt b (-e+1)*2, b, 1)- else- (f*2, expt b (-e)*2, 1, 1)- k :: Int- k =- let- k0 :: Int- k0 =- if b == 2 then- -- logBase 10 2 is very slightly larger than 8651/28738- -- (about 5.3558e-10), so if log x >= 0, the approximation- -- k1 is too small, hence we add one and need one fixup step less.- -- If log x < 0, the approximation errs rather on the high side.- -- That is usually more than compensated for by ignoring the- -- fractional part of logBase 2 x, but when x is a power of 1/2- -- or slightly larger and the exponent is a multiple of the- -- denominator of the rational approximation to logBase 10 2,- -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,- -- we get a leading zero-digit we don't want.- -- With the approximation 3/10, this happened for- -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.- -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x- -- for IEEE-ish floating point types with exponent fields- -- <= 17 bits and mantissae of several thousand bits, earlier- -- convergents to logBase 10 2 would fail for long double.- -- Using quot instead of div is a little faster and requires- -- fewer fixup steps for negative lx.- let lx = p - 1 + e0- k1 = (lx * 8651) `quot` 28738- in if lx >= 0 then k1 + 1 else k1- else- -- f :: Integer, log :: Float -> Float,- -- ceiling :: Float -> Int- ceiling ((log (fromInteger (f+1) :: Float) +- fromIntegral e * log (fromInteger b)) /- log 10)---WAS: fromInt e * log (fromInteger b))-- fixup n =- if n >= 0 then- if r + mUp <= expt 10 n * s then n else fixup (n+1)- else- if expt 10 (-n) * (r + mUp) <= s then n else fixup (n+1)- in- fixup k0-- gen ds rn sN mUpN mDnN =- let- (dn, rn') = (rn * 10) `quotRem` sN- mUpN' = mUpN * 10- mDnN' = mDnN * 10- in- case (rn' < mDnN', rn' + mUpN' > sN) of- (True, False) -> dn : ds- (False, True) -> dn+1 : ds- (True, True) -> if rn' * 2 < sN then dn : ds else dn+1 : ds- (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'-- rds =- if k >= 0 then- gen [] r (s * expt 10 k) mUp mDn- else- let bk = expt 10 (-k) in- gen [] (r * bk) s (mUp * bk) (mDn * bk)- in- (map fromIntegral (reverse rds), k)---- Exponentiation with a cache for the most common numbers.-minExpt, maxExpt :: Int-minExpt = 0-maxExpt = 1100--expt :: Integer -> Int -> Integer-expt base n- | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n- | base == 10 && n <= maxExpt10 = expts10 `unsafeAt` n- | otherwise = base^n--expts :: Array Int Integer-expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]--maxExpt10 :: Int-maxExpt10 = 324--expts10 :: Array Int Integer-expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]---- | Unsafe conversion for decimal digits.-{-# INLINE i2d #-}-i2d :: Int -> Word8-i2d i = fromIntegral (ord '0' + i)---- | Word8 list rendering-word8s :: [Word8] -> Builder-word8s = BP.primMapListFixed BP.word8
− Data/Csv/Encoding.hs
@@ -1,389 +0,0 @@-{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}---- Module: Data.Csv.Encoding--- Copyright: (c) 2011 MailRank, Inc.--- (c) 2012 Johan Tibell--- License: BSD3--- Maintainer: Johan Tibell <johan.tibell@gmail.com>--- Stability: experimental--- Portability: portable------ Encoding and decoding of data types into CSV.-module Data.Csv.Encoding- (- -- * Encoding and decoding- HasHeader(..)- , decode- , decodeByName- , Quoting(..)- , encode- , encodeByName- , encodeDefaultOrderedByName-- -- ** Encoding and decoding options- , DecodeOptions(..)- , defaultDecodeOptions- , decodeWith- , decodeByNameWith- , EncodeOptions(..)- , defaultEncodeOptions- , encodeWith- , encodeByNameWith- , encodeDefaultOrderedByNameWith-- -- ** Encoding and decoding single records- , encodeRecord- , encodeNamedRecord- , recordSep- ) where--import Data.ByteString.Builder-import Control.Applicative as AP (Applicative(..), (<|>))-import Data.Attoparsec.ByteString.Char8 (endOfInput)-import qualified Data.Attoparsec.ByteString.Lazy as AL-import qualified Data.ByteString as B-import qualified Data.ByteString.Char8 as B8-import qualified Data.ByteString.Lazy as L-import qualified Data.ByteString.Lazy.Char8 as BL8-import qualified Data.HashMap.Strict as HM-import Data.Vector (Vector)-import qualified Data.Vector as V-import Data.Word (Word8)-import Data.Monoid-import Prelude hiding (unlines)--import qualified Data.Csv.Conversion as Conversion-import Data.Csv.Conversion (FromNamedRecord, FromRecord, ToNamedRecord,- ToRecord, parseNamedRecord, parseRecord, runParser,- toNamedRecord, toRecord)-import Data.Csv.Parser hiding (csv, csvWithHeader)-import qualified Data.Csv.Parser as Parser-import Data.Csv.Types hiding (toNamedRecord)-import qualified Data.Csv.Types as Types-import Data.Csv.Util (blankLine, endOfLine, toStrict)----- TODO: 'encode' isn't as efficient as it could be.----------------------------------------------------------------------------- * Encoding and decoding---- | 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- => HasHeader -- ^ Data contains header that should be- -- skipped- -> L.ByteString -- ^ CSV data- -> Either String (Vector a)-decode = decodeWith defaultDecodeOptions-{-# INLINE decode #-}---- | Efficiently deserialize CSV records from a lazy 'L.ByteString'.--- 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 -- ^ CSV data- -> Either String (Header, Vector a)-decodeByName = decodeByNameWith defaultDecodeOptions-{-# INLINE decodeByName #-}---- | Efficiently serialize CSV records as a lazy 'L.ByteString'.-encode :: ToRecord a => [a] -> L.ByteString-encode = encodeWith defaultEncodeOptions-{-# INLINE encode #-}---- | Efficiently serialize CSV records as a lazy 'L.ByteString'. The--- header is written before any records and dictates the field order.-encodeByName :: ToNamedRecord a => Header -> [a] -> L.ByteString-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---- | Like 'decode', but lets you customize how the CSV data is parsed.-decodeWith :: FromRecord a- => DecodeOptions -- ^ Decoding options- -> HasHeader -- ^ Data contains header that should be- -- skipped- -> L.ByteString -- ^ CSV data- -> Either String (Vector a)-decodeWith = decodeWithC csv-{-# INLINE [1] decodeWith #-}--{-# RULES- "idDecodeWith" decodeWith = idDecodeWith- #-}---- | Same as 'decodeWith', but more efficient as no type--- conversion is performed.-idDecodeWith :: DecodeOptions -> HasHeader -> L.ByteString- -> Either String (Vector (Vector B.ByteString))-idDecodeWith = decodeWithC Parser.csv---- | Decode CSV data using the provided parser, skipping a leading--- header if 'hasHeader' is 'HasHeader'. Returns 'Left' @errMsg@ on--- failure.-decodeWithC :: (DecodeOptions -> AL.Parser a) -> DecodeOptions -> HasHeader- -> BL8.ByteString -> Either String a-decodeWithC p !opts hasHeader = decodeWithP parser- where parser = case hasHeader of- HasHeader -> header (decDelimiter opts) *> p opts- NoHeader -> p opts-{-# INLINE decodeWithC #-}---- | Like 'decodeByName', but lets you customize how the CSV data is--- parsed.-decodeByNameWith :: FromNamedRecord a- => DecodeOptions -- ^ Decoding options- -> L.ByteString -- ^ CSV data- -> 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.------ To avoid having your program stop compiling when new fields are--- added to 'EncodeOptions', create option records by overriding--- values in 'defaultEncodeOptions'. Example:------ > myOptions = defaultEncodeOptions {--- > encDelimiter = fromIntegral (ord '\t')--- > }------ /N.B./ The 'encDelimiter' must /not/ be the quote character (i.e.--- @\"@) or one of the record separator characters (i.e. @\\n@ or--- @\\r@).-data EncodeOptions = EncodeOptions- { -- | Field delimiter.- encDelimiter :: {-# UNPACK #-} !Word8-- -- | Record separator selection. @True@ for CRLF (@\\r\\n@) and- -- @False@ for LF (@\\n@).- , encUseCrLf :: !Bool-- -- | 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.-defaultEncodeOptions :: EncodeOptions-defaultEncodeOptions = EncodeOptions- { encDelimiter = 44 -- comma- , encUseCrLf = True- , encIncludeHeader = True- , encQuoting = QuoteMinimal- }---- | Like 'encode', but lets you customize how the CSV data is--- encoded.-encodeWith :: ToRecord a => EncodeOptions -> [a] -> L.ByteString-encodeWith opts- | validDelim (encDelimiter opts) =- toLazyByteString- . unlines (recordSep (encUseCrLf opts))- . map (encodeRecord (encQuoting opts) (encDelimiter opts)- . toRecord)- | otherwise = encodeOptionsError-{-# INLINE encodeWith #-}---- | Check if the delimiter is valid.-validDelim :: Word8 -> Bool-validDelim delim = delim `notElem` [cr, nl, dquote]- where- nl = 10- cr = 13- dquote = 34---- | Raises an exception indicating that the provided delimiter isn't--- valid. See 'validDelim'.------ Keep this message consistent with the documentation of--- 'EncodeOptions'.-encodeOptionsError :: a-encodeOptionsError = error $ "Data.Csv: " ++- "The 'encDelimiter' must /not/ be the quote character (i.e. " ++- "\") or one of the record separator characters (i.e. \\n or " ++- "\\r)"---- | Encode a single record, without the trailing record separator--- (i.e. newline).-encodeRecord :: Quoting -> Word8 -> Record -> Builder-encodeRecord qtng delim = mconcat . intersperse (word8 delim)- . map byteString . map (escape qtng delim) . V.toList-{-# 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 :: Quoting -> Word8 -> B.ByteString -> B.ByteString-escape !qtng !delim !s- | (qtng == QuoteMinimal &&- B.any (\ b -> b == dquote || b == delim || b == nl || b == cr) s- ) || qtng == QuoteAll- = toStrict . toLazyByteString $- word8 dquote- <> B.foldl- (\ acc b -> acc <> if b == dquote- then byteString "\"\""- else word8 b)- mempty- s- <> word8 dquote- | otherwise = s- where- dquote = 34- nl = 10- cr = 13---- | Like 'encodeByName', but lets you customize how the CSV data is--- encoded.-encodeByNameWith :: ToNamedRecord a => EncodeOptions -> Header -> [a]- -> L.ByteString-encodeByNameWith opts hdr v- | validDelim (encDelimiter opts) =- toLazyByteString (rows (encIncludeHeader opts))- | otherwise = encodeOptionsError- where- 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 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- where- find n = case HM.lookup n nr of- Nothing -> moduleError "namedRecordToRecord" $- "header contains name " ++ show (B8.unpack n) ++- " which is not present in the named record"- Just v -> v--moduleError :: String -> String -> a-moduleError func msg = error $ "Data.Csv.Encoding." ++ func ++ ": " ++ msg-{-# NOINLINE moduleError #-}--recordSep :: Bool -> Builder-recordSep False = word8 10 -- new line (\n)-recordSep True = string8 "\r\n"--unlines :: Builder -> [Builder] -> Builder-unlines _ [] = mempty-unlines sep (b:bs) = b <> sep <> unlines sep bs--intersperse :: Builder -> [Builder] -> [Builder]-intersperse _ [] = []-intersperse sep (x:xs) = x : prependToAll sep xs--prependToAll :: Builder -> [Builder] -> [Builder]-prependToAll _ [] = []-prependToAll sep (x:xs) = sep <> x : prependToAll sep xs--decodeWithP :: AL.Parser a -> L.ByteString -> Either String a-decodeWithP p s =- case AL.parse p s of- AL.Done _ v -> Right v- AL.Fail left _ msg -> Left errMsg- where- errMsg = "parse error (" ++ msg ++ ") at " ++- (if BL8.length left > 100- then (take 100 $ BL8.unpack left) ++ " (truncated)"- else show (BL8.unpack left))-{-# INLINE decodeWithP #-}---- These alternative implementation of the 'csv' and 'csvWithHeader'--- parsers from the 'Parser' module performs the--- 'FromRecord'/'FromNamedRecord' conversions on-the-fly, thereby--- avoiding the need to hold a big 'CSV' value in memory. The 'CSV'--- type has a quite large memory overhead due to high constant--- overheads of 'B.ByteString' and 'V.Vector'.---- TODO: Check that the error messages don't duplicate prefixes, as in--- "parse error: conversion error: ...".---- | Parse a CSV file that does not include a header.-csv :: FromRecord a => DecodeOptions -> AL.Parser (V.Vector a)-csv !opts = do- vals <- records- return $! V.fromList vals- where- records = do- !r <- record (decDelimiter opts)- if blankLine r- then (endOfInput *> pure []) <|> (endOfLine *> records)- else case runParser (parseRecord r) of- Left msg -> fail $ "conversion error: " ++ msg- Right val -> do- !vals <- (endOfInput *> AP.pure []) <|> (endOfLine *> records)- return (val : vals)-{-# INLINE csv #-}---- | Parse a CSV file that includes a header.-csvWithHeader :: FromNamedRecord a => DecodeOptions- -> AL.Parser (Header, V.Vector a)-csvWithHeader !opts = do- !hdr <- header (decDelimiter opts)- vals <- records hdr- let !v = V.fromList vals- return (hdr, v)- where- records hdr = do- !r <- record (decDelimiter opts)- if blankLine r- then (endOfInput *> pure []) <|> (endOfLine *> records hdr)- else case runParser (convert hdr r) of- Left msg -> fail $ "conversion error: " ++ msg- Right val -> do- !vals <- (endOfInput *> pure []) <|> (endOfLine *> records hdr)- return (val : vals)-- convert hdr = parseNamedRecord . Types.toNamedRecord hdr
− Data/Csv/Incremental.hs
@@ -1,438 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, DeriveFunctor, ScopedTypeVariables #-}---- | 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- HeaderParser(..)- , decodeHeader- , decodeHeaderWith-- -- $typeconversion- , Parser(..)-- -- ** Index-based record conversion- -- $indexbased- , HasHeader(..)- , decode- , decodeWith-- -- ** Name-based record conversion- -- $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 Data.ByteString.Builder as Builder-import qualified Data.ByteString.Lazy as L-import Data.Semigroup (Semigroup, (<>))-import qualified Data.Vector as V-import Data.Word (Word8)--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)--#if !MIN_VERSION_base(4,8,0)-import Data.Monoid (Monoid(mappend, mempty))-import Control.Applicative ((<*))-#endif---- $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---- | Parse a CSV header in an incremental fashion. When done, the--- 'HeaderParser' returns any unconsumed input in the second field of--- the 'DoneH' constructor.-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 parsed and converted zero or more records. Any- -- records that failed type conversion are returned as @'Left'- -- errMsg@ and the rest as @'Right' val@. Feed a 'B.ByteString'- -- to the continuation to continue parsing. Use an 'B.empty'- -- string to indicate that no more input data is available. If- -- fed an 'B.empty' string, the continuation is guaranteed to- -- return either 'Fail' or 'Done'.- | Many [Either String a] (B.ByteString -> Parser a)-- -- | The parser parsed and converted some records. Any records- -- that failed type conversion are returned as @'Left' errMsg@- -- 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 d (Many rs _) = showParen (d > appPrec) showStr- where- showStr = showString "Many " . showsPrec (appPrec+1) rs .- showString " <function>"- showsPrec d (Done rs) = showParen (d > appPrec) showStr- where- showStr = showString "Done " . showsPrec (appPrec+1) rs---- | Have we read all available input?-data More = Incomplete | Complete- deriving (Eq, Show)---- | Efficiently deserialize CSV in an incremental fashion. Equivalent--- to @'decodeWith' 'defaultDecodeOptions'@.-decode :: FromRecord a- => HasHeader -- ^ 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- -> HasHeader -- ^ Data contains header that should be- -- skipped- -> Parser a-decodeWith !opts hasHeader = case hasHeader of- HasHeader -> go (decodeHeaderWith opts)- NoHeader -> Many [] $ \ s -> decodeWithP parseRecord opts s- where go (FailH rest msg) = Fail rest msg- go (PartialH k) = Many [] $ \ 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 = go (decodeHeaderWith opts)- where- go (FailH rest msg) = FailH rest msg- go (PartialH k) = PartialH $ \ s -> go (k s)- go (DoneH hdr rest) =- DoneH hdr (decodeWithP (parseNamedRecord . toNamedRecord hdr) opts rest)------------------------------------------------------------------------------ TODO: 'decodeWithP' should probably not take an initial--- 'B.ByteString' input.---- | Like 'decode', but lets you customize how the CSV data is parsed.-decodeWithP :: (Record -> Conversion.Parser a) -> DecodeOptions -> B.ByteString- -> Parser a-decodeWithP p !opts = go Incomplete [] . parser- where- go !_ !acc (A.Fail rest _ msg)- | null acc = Fail rest err- | otherwise = Many (reverse acc) (\ s -> Fail (rest `B.append` s) err)- where err = "parse error (" ++ msg ++ ")"- go Incomplete acc (A.Partial k) = Many (reverse acc) cont- where cont s = go m [] (k s)- where m | B.null s = Complete- | otherwise = Incomplete- 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 -> Many (reverse acc') (cont [])- | otherwise = go m acc' (parser rest)- where cont acc'' s- | B.null s = Done (reverse acc'')- | otherwise = go Incomplete acc'' (parser s)- acc' | blankLine r = acc- | otherwise = let !r' = convert r in r' : acc-- parser = A.parse (record (decDelimiter opts) <* (endOfLine <|> endOfInput))- convert = runParser . p-{-# INLINE decodeWithP #-}--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- }---- | @since 0.5.0.0-instance Semigroup (Builder a) where- Builder f <> Builder g =- Builder $ \ qtng delim useCrlf ->- f qtng delim useCrlf <> g qtng delim useCrlf--instance Monoid (Builder a) where- mempty = Builder (\ _ _ _ -> mempty)- mappend = (<>)----------------------------------------------------------------------------- ** 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.headerOrder' 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 $- encHdr <>- runNamedBuilder b hdr (encQuoting opts) (encDelimiter opts)- (encUseCrLf opts)- where- encHdr- | encIncludeHeader opts =- Encoding.encodeRecord (encQuoting opts) (encDelimiter opts) hdr- <> recordSep (encUseCrLf opts)- | otherwise = mempty---- | 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 $- encHdr <>- runNamedBuilder b hdr (encQuoting opts)- (encDelimiter opts) (encUseCrLf opts)- where- hdr = Conversion.headerOrder (undefined :: a)-- encHdr- | encIncludeHeader opts =- Encoding.encodeRecord (encQuoting opts) (encDelimiter opts) hdr- <> recordSep (encUseCrLf opts)- | otherwise = mempty---- | 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- }---- | @since 0.5.0.0-instance Semigroup (NamedBuilder a) where- NamedBuilder f <> NamedBuilder g =- NamedBuilder $ \ hdr qtng delim useCrlf ->- f hdr qtng delim useCrlf <> g hdr qtng delim useCrlf--instance Monoid (NamedBuilder a) where- mempty = NamedBuilder (\ _ _ _ _ -> mempty)- mappend = (<>)----------------------------------------------------------------------------moduleError :: String -> String -> a-moduleError func msg = error $ "Data.Csv.Incremental." ++ func ++ ": " ++ msg-{-# NOINLINE moduleError #-}
− Data/Csv/Parser.hs
@@ -1,191 +0,0 @@-{-# LANGUAGE BangPatterns, CPP #-}---- | A CSV parser. The parser defined here is RFC 4180 compliant, with--- the following extensions:------ * Empty lines are ignored.------ * Non-escaped fields may contain any characters except--- double-quotes, commas, carriage returns, and newlines.------ * Escaped fields may contain any characters (but double-quotes--- need to be escaped).------ The functions in this module can be used to implement e.g. a--- resumable parser that is fed input incrementally.-module Data.Csv.Parser- ( DecodeOptions(..)- , defaultDecodeOptions- , csv- , csvWithHeader- , header- , record- , name- , field- ) where--import Data.ByteString.Builder (byteString, toLazyByteString, charUtf8)-import Control.Applicative (optional)-import Data.Attoparsec.ByteString.Char8 (char, endOfInput)-import qualified Data.Attoparsec.ByteString as A-import qualified Data.Attoparsec.Lazy as AL-import qualified Data.Attoparsec.Zepto as Z-import qualified Data.ByteString as S-import qualified Data.ByteString.Unsafe as S-import qualified Data.Vector as V-import Data.Word (Word8)--import Data.Csv.Types-import Data.Csv.Util ((<$!>), blankLine, endOfLine, liftM2', cr, newline, doubleQuote, toStrict)--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>), (*>), (<*), pure)-import Data.Monoid (mappend, mempty)-#endif---- | Options that controls how data is decoded. These options can be--- used to e.g. decode tab-separated data instead of comma-separated--- data.------ To avoid having your program stop compiling when new fields are--- added to 'DecodeOptions', create option records by overriding--- values in 'defaultDecodeOptions'. Example:------ > myOptions = defaultDecodeOptions {--- > decDelimiter = fromIntegral (ord '\t')--- > }-data DecodeOptions = DecodeOptions- { -- | Field delimiter.- decDelimiter :: {-# UNPACK #-} !Word8- } deriving (Eq, Show)---- | Decoding options for parsing CSV files.-defaultDecodeOptions :: DecodeOptions-defaultDecodeOptions = DecodeOptions- { decDelimiter = 44 -- comma- }---- | Parse a CSV file that does not include a header.-csv :: DecodeOptions -> AL.Parser Csv-csv !opts = do- vals <- sepByEndOfLine1' (record (decDelimiter opts))- _ <- optional endOfLine- endOfInput- let nonEmpty = removeBlankLines vals- return $! V.fromList nonEmpty-{-# INLINE csv #-}---- | Specialized version of 'sepBy1'' which is faster due to not--- accepting an arbitrary separator.-sepByDelim1' :: AL.Parser a- -> Word8 -- ^ Field delimiter- -> AL.Parser [a]-sepByDelim1' p !delim = liftM2' (:) p loop- where- loop = do- mb <- A.peekWord8- case mb of- Just b | b == delim -> liftM2' (:) (A.anyWord8 *> p) loop- _ -> pure []-{-# INLINE sepByDelim1' #-}---- | Specialized version of 'sepBy1'' which is faster due to not--- accepting an arbitrary separator.-sepByEndOfLine1' :: AL.Parser a- -> AL.Parser [a]-sepByEndOfLine1' p = liftM2' (:) p loop- where- loop = do- mb <- A.peekWord8- case mb of- Just b | b == cr ->- liftM2' (:) (A.anyWord8 *> A.word8 newline *> p) loop- | b == newline ->- liftM2' (:) (A.anyWord8 *> p) loop- _ -> pure []-{-# INLINE sepByEndOfLine1' #-}---- | Parse a CSV file that includes a header.-csvWithHeader :: DecodeOptions -> AL.Parser (Header, V.Vector NamedRecord)-csvWithHeader !opts = do- !hdr <- header (decDelimiter opts)- vals <- map (toNamedRecord hdr) . removeBlankLines <$>- sepByEndOfLine1' (record (decDelimiter opts))- _ <- optional endOfLine- endOfInput- let !v = V.fromList vals- return (hdr, v)---- | Parse a header, including the terminating line separator.-header :: Word8 -- ^ Field delimiter- -> AL.Parser Header-header !delim = V.fromList <$!> name delim `sepByDelim1'` delim <* endOfLine---- | Parse a header name. Header names have the same format as regular--- 'field's.-name :: Word8 -> AL.Parser Name-name !delim = field delim--removeBlankLines :: [Record] -> [Record]-removeBlankLines = filter (not . blankLine)---- | Parse a record, not including the terminating line separator. The--- terminating line separate is not included as the last record in a--- CSV file is allowed to not have a terminating line separator. You--- most likely want to use the 'endOfLine' parser in combination with--- this parser.-record :: Word8 -- ^ Field delimiter- -> AL.Parser Record-record !delim = V.fromList <$!> field delim `sepByDelim1'` delim-{-# INLINE record #-}---- | Parse a field. The field may be in either the escaped or--- non-escaped format. The return value is unescaped.-field :: Word8 -> AL.Parser Field-field !delim = do- mb <- A.peekWord8- -- We purposely don't use <|> as we want to commit to the first- -- choice if we see a double quote.- case mb of- Just b | b == doubleQuote -> escapedField- _ -> unescapedField delim-{-# INLINE field #-}--escapedField :: AL.Parser S.ByteString-escapedField = do- _ <- dquote- -- The scan state is 'True' if the previous character was a double- -- quote. We need to drop a trailing double quote left by scan.- s <- S.init <$> (A.scan False $ \s c -> if c == doubleQuote- then Just (not s)- else if s then Nothing- else Just False)- if doubleQuote `S.elem` s- then case Z.parse unescape s of- Right r -> return r- Left err -> fail err- else return s--unescapedField :: Word8 -> AL.Parser S.ByteString-unescapedField !delim = A.takeWhile (\ c -> c /= doubleQuote &&- c /= newline &&- c /= delim &&- c /= cr)--dquote :: AL.Parser Char-dquote = char '"'--unescape :: Z.Parser S.ByteString-unescape = (toStrict . toLazyByteString) <$!> go mempty where- go acc = do- h <- Z.takeWhile (/= doubleQuote)- let rest = do- start <- Z.take 2- if (S.unsafeHead start == doubleQuote &&- S.unsafeIndex start 1 == doubleQuote)- then go (acc `mappend` byteString h `mappend` charUtf8 '"')- else fail "invalid CSV escape sequence"- done <- Z.atEnd- if done- then return (acc `mappend` byteString h)- else rest
− Data/Csv/Streaming.hs
@@ -1,194 +0,0 @@-{-# 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- (- -- * Usage example- -- $example-- -- * Stream representation- -- $stream-representation- Records(..)-- -- * Decoding records- -- $typeconversion-- -- ** Index-based record conversion- -- $indexbased- , HasHeader(..)- , decode- , decodeWith-- -- ** Name-based record conversion- -- $namebased- , decodeByName- , decodeByNameWith- ) where--import Control.DeepSeq (NFData(rnf))-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 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--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>), (<*>), pure)-import Data.Traversable (Traversable(..))-#endif--#if !MIN_VERSION_bytestring(0,10,0)-import qualified Data.ByteString.Lazy.Internal as BL -- for constructors-#endif---- $example------ A short usage example:------ > for_ (decode NoHeader "John,27\r\nJane,28\r\n") $ \ (name, age :: Int) ->--- > putStrLn $ name ++ " is " ++ show age ++ " years old"------ N.B. The 'Foldable' instance, which is used above, skips records--- that failed to convert. If you don't want this behavior, work--- directly with the 'Cons' and 'Nil' constructors.---- $stream-representation------ A stream of records is represented as a (lazy) list that may--- contain errors.---- $typeconversion------ Just like in the case of non-streaming decoding, there are two ways--- to convert CSV records to and from and user-defined data types:--- index-based conversion and name-based conversion.---- $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.---- | 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)---- | Skips records that failed to convert.-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 (Cons (Left _) rs) = 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 (Cons (Left _) rs) = 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--instance NFData a => NFData (Records a) where- rnf (Cons r rs) = rnf r `seq` rnf rs-#if MIN_VERSION_bytestring(0,10,0)- rnf (Nil errMsg rest) = rnf errMsg `seq` rnf rest-#else- rnf (Nil errMsg rest) = rnf errMsg `seq` rnfLazyByteString rest--rnfLazyByteString :: BL.ByteString -> ()-rnfLazyByteString BL.Empty = ()-rnfLazyByteString (BL.Chunk _ b) = rnfLazyByteString b-#endif---- | Efficiently deserialize CSV records in a streaming fashion.--- Equivalent to @'decodeWith' 'defaultDecodeOptions'@.-decode :: FromRecord a- => HasHeader -- ^ 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- -> HasHeader -- ^ Data contains header that should be- -- skipped- -> BL.ByteString -- ^ CSV data- -> Records a-decodeWith !opts hasHeader s0 =- go (BL.toChunks s0) (I.decodeWith opts hasHeader)- where- go ss (Done xs) = foldr Cons (Nil Nothing (BL.fromChunks ss)) xs- go ss (Fail rest err) = Nil (Just err) (BL.fromChunks (rest:ss))- go [] (Many xs k) = foldr Cons (go [] (k B.empty)) xs- go (s:ss) (Many xs k) = foldr Cons (go ss (k s)) xs---- | Efficiently deserialize CSV in a streaming fashion. The data is--- assumed to be preceeded by a header. Returns @'Left' errMsg@ if--- 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 = go (BL.toChunks s0) (I.decodeByNameWith opts)- where- go ss (DoneH hdr p) = Right (hdr, go2 ss p)- go ss (FailH rest err) = Left $ err ++ " at " ++- 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 [] (Many xs k) = foldr Cons (go2 [] (k B.empty)) xs- go2 (s:ss) (Many xs k) = foldr Cons (go2 ss (k s)) xs
− Data/Csv/Types.hs
@@ -1,50 +0,0 @@-module Data.Csv.Types- (- -- * Core CSV types- Csv- , Record- , Header- , Name- , NamedRecord- , Field- , toNamedRecord-- -- * Header handling- , HasHeader(..)- ) where--import qualified Data.ByteString as S-import qualified Data.HashMap.Strict as HM-import Data.Vector (Vector)-import qualified Data.Vector as V---- | CSV data represented as a Haskell vector of vector of--- bytestrings.-type Csv = Vector Record---- | A record corresponds to a single line in a CSV file.-type Record = Vector Field---- | The header corresponds to the first line a CSV file. Not all CSV--- files have a header.-type Header = Vector Name---- | A header has one or more names, describing the data in the column--- following the name.-type Name = S.ByteString---- | A record corresponds to a single line in a CSV file, indexed by--- the column name rather than the column index.-type NamedRecord = HM.HashMap S.ByteString S.ByteString---- | A single field within a record.-type Field = S.ByteString---- | Convert a 'Record' to a 'NamedRecord' by attaching column names.--- The 'Header' and 'Record' must be of the same length.-toNamedRecord :: Header -> Record -> NamedRecord-toNamedRecord hdr v = HM.fromList . V.toList $ V.zip hdr v---- | Is the CSV data preceded by a header?-data HasHeader = HasHeader -- ^ The CSV data is preceded by a header- | NoHeader -- ^ The CSV data is not preceded by a header
− Data/Csv/Util.hs
@@ -1,68 +0,0 @@-{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-}--module Data.Csv.Util- ( (<$!>)- , blankLine- , liftM2'- , endOfLine- , doubleQuote- , newline- , cr- , toStrict- ) where--import Control.Applicative ((<|>))-import Data.Word (Word8)-import Data.Attoparsec.ByteString.Char8 (string)-import qualified Data.Attoparsec.ByteString as A-import qualified Data.ByteString as B-import qualified Data.Vector as V-import Data.Attoparsec.ByteString (Parser)--#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((*>))-#endif--#if MIN_VERSION_bytestring(0,10,0)-import Data.ByteString.Lazy (toStrict)-#else-import qualified Data.ByteString.Lazy as L--toStrict :: L.ByteString -> B.ByteString-toStrict = B.concat . L.toChunks-#endif---- | 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 <$!>---- | Is this an empty record (i.e. a blank line)?-blankLine :: V.Vector B.ByteString -> Bool-blankLine v = V.length v == 1 && (B.null (V.head v))---- | A version of 'liftM2' that is strict in the result of its first--- action.-liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c-liftM2' f a b = do- !x <- a- y <- b- return (f x y)-{-# INLINE liftM2' #-}----- | Match either a single newline character @\'\\n\'@, or a carriage--- return followed by a newline character @\"\\r\\n\"@, or a single--- carriage return @\'\\r\'@.-endOfLine :: Parser ()-endOfLine = (A.word8 newline *> return ()) <|> (string "\r\n" *> return ()) <|> (A.word8 cr *> return ())-{-# INLINE endOfLine #-}--doubleQuote, newline, cr :: Word8-doubleQuote = 34-newline = 10-cr = 13
README.md view
@@ -1,5 +1,8 @@-# `cassava`: A CSV parsing and encoding library [](https://hackage.haskell.org/package/cassava) [](https://travis-ci.org/hvr/cassava)+[](https://hackage.haskell.org/package/cassava)+[](https://github.com/haskell-hvr/cassava/actions) +# `cassava`: A CSV parsing and encoding library+ **Please refer to the [package description](https://hackage.haskell.org/package/cassava#description) for an overview of `cassava`.** ## Usage example@@ -91,7 +94,7 @@ ## Further reading -The primary API documentation for `cassava` is its Haddock documentation which can be found at http://hackage.haskell.org/package/cassava/docs/Data-Csv.html +The primary API documentation for `cassava` is its Haddock documentation which can be found at http://hackage.haskell.org/package/cassava/docs/Data-Csv.html Below are listed additional recommended third-party blogposts and tutorials
Setup.hs view
@@ -1,2 +1,3 @@ import Distribution.Simple main = defaultMain+
cassava.cabal view
@@ -1,6 +1,7 @@-cabal-version: 1.12+cabal-version: 1.18 Name: cassava-Version: 0.5.1.0+Version: 0.5.5.0+ Synopsis: A CSV parsing and encoding library Description: { @@ -28,30 +29,41 @@ Please refer to the documentation in "Data.Csv" and the included [README](#readme) for more usage examples. }-Homepage: https://github.com/hvr/cassava+Homepage: https://github.com/haskell-hvr/cassava License: BSD3 License-file: LICENSE-Bug-reports: https://github.com/hvr/cassava/issues+Bug-reports: https://github.com/haskell-hvr/cassava/issues Copyright: (c) 2012 Johan Tibell (c) 2012 Bryan O'Sullivan (c) 2011 MailRank, Inc. Author: Johan Tibell-Maintainer: hvr@gnu.org+Maintainer: https://github.com/haskell-hvr/cassava Category: Text, Web, CSV Build-type: Simple-Extra-source-files: examples/*.hs,- CHANGES.md,+Extra-source-files: examples/*.hs+Extra-doc-files: CHANGES.md README.md-Tested-with: GHC ==8.2.1, GHC ==8.0.2, GHC ==8.0.1, GHC ==7.10.3, GHC ==7.8.4, GHC ==7.6.3, GHC ==7.4.2+Tested-with:+ GHC == 9.14.1+ GHC == 9.12.2+ GHC == 9.10.2+ GHC == 9.8.4+ GHC == 9.6.7+ GHC == 9.4.8+ GHC == 9.2.8+ GHC == 9.0.2+ GHC == 8.10.7+ GHC == 8.8.4+ GHC == 8.6.5+ GHC == 8.4.4+ GHC == 8.2.2+ GHC == 8.0.2 ---------------------------------------------------------------------------- source-repository head type: git- location: https://github.com/hvr/cassava.git--flag bytestring--LT-0_10_4- description: [bytestring](https://hackage.haskell.org/haskell/package/bytestring) < 0.10.4+ location: https://github.com/haskell-hvr/cassava.git Library default-language: Haskell2010@@ -64,6 +76,7 @@ FlexibleContexts FlexibleInstances KindSignatures+ RoleAnnotations MultiParamTypeClasses OverloadedStrings PolyKinds@@ -72,10 +85,7 @@ TypeOperators UndecidableInstances - if impl(ghc >= 8.0)- other-extensions:- DataKinds- PolyKinds+ hs-source-dirs: src Exposed-modules: Data.Csv@@ -91,47 +101,36 @@ Data.Csv.Types Data.Csv.Util + -- Lower bounds from GHC 8.0 and Stackage LTS 7.0 Build-depends:- array >= 0.4 && < 0.6,- attoparsec >= 0.11.3.0 && < 0.14,- base >= 4.5 && < 5,- bytestring >= 0.9.2 && < 0.11,- containers >= 0.4.2 && < 0.6,- deepseq >= 1.1 && < 1.5,- hashable < 1.3,- scientific >= 0.3.4.7 && < 0.4,- text < 1.3,- unordered-containers < 0.3,- vector >= 0.8 && < 0.13,- Only >= 0.1 && < 0.1.1-- if flag(bytestring--LT-0_10_4)- build-depends: bytestring < 0.10.4- , bytestring-builder >= 0.10.8 && < 0.11- else- build-depends: bytestring >= 0.10.4- , text-short == 0.1.*-- -- 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.*+ base >= 4.9 && < 5+ , array >= 0.5.1.1 && < 0.6+ , attoparsec >= 0.11.3.0 && < 0.15+ , bytestring >= 0.10.8.0 && < 0.13+ , containers >= 0.5.7.1 && < 1+ , deepseq >= 1.4.2.0 && < 1.6+ , hashable >= 1.2.4.0 && < 2+ , scientific >= 0.3.4.9 && < 0.4+ , text >= 1.2.2.1 && < 2.2+ , text-short == 0.1.*+ , unordered-containers >= 0.2.7.1 && < 0.3+ , vector >= 0.11.0.0 && < 0.14+ , Only >= 0.1 && < 0.1.1 - -- For Numeric.Natural- if impl(ghc < 7.10)- build-depends: nats >= 1 && < 1.2+ ghc-options:+ -Wall+ -- https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0#Recommendationsforforward-compatibility+ -Wcompat+ -Wnoncanonical-monad-instances - -- https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0#Recommendationsforforward-compatibility- if impl(ghc >= 8.0)- ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances+ if impl(ghc >= 8.8)+ ghc-options: -Wno-star-is-type else- -- provide/emulate `Control.Monad.Fail` and `Data.Semigroups` API for pre-GHC8- build-depends: fail == 4.9.*, semigroups == 0.18.*+ ghc-options: -Wnoncanonical-monadfail-instances if impl(ghc >= 8.2) ghc-options: -Wcpp-undef - ghc-options: -Wall -O2- ---------------------------------------------------------------------------- Test-suite unit-tests@@ -140,41 +139,31 @@ Type: exitcode-stdio-1.0 Main-is: UnitTests.hs -- dependencies with version constraints inherited via lib:cassava- Build-depends: attoparsec- , base+ Build-depends: base >= 4.11 && < 5 , bytestring , cassava- , hashable , scientific , text , unordered-containers , vector -- extra dependencies not already used by lib:cassava- build-depends: HUnit < 1.7- , QuickCheck == 2.10.*- , quickcheck-instances >= 0.3.12 && < 0.4- , test-framework == 0.8.*- , test-framework-hunit == 0.3.*- , test-framework-quickcheck2 == 0.3.*+ build-depends: HUnit >= 1.3.1.2 && < 1.7+ , QuickCheck >= 2.14 && < 3+ , quickcheck-instances >= 0.3.12 && < 0.4+ , test-framework == 0.8.*+ , test-framework-hunit == 0.3.*+ , test-framework-quickcheck2 == 0.3.* hs-source-dirs: tests - -- 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.*-- -- For Numeric.Natural- if impl(ghc < 7.10)- build-depends: nats >= 1 && < 1.2+ ghc-options:+ -Wall+ -- https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0#Recommendationsforforward-compatibility+ -Wcompat+ -Wcpp-undef+ -Wnoncanonical-monad-instances - -- https://ghc.haskell.org/trac/ghc/wiki/Migration/8.0#Recommendationsforforward-compatibility- if impl(ghc >= 8.0)- ghc-options: -Wcompat -Wnoncanonical-monad-instances -Wnoncanonical-monadfail-instances+ if impl(ghc >= 8.8)+ ghc-options: -Wno-star-is-type else- -- provide/emulate `Control.Monad.Fail` and `Data.Semigroups` API for pre-GHC8- build-depends: fail == 4.9.*, semigroups == 0.18.*-- if impl(ghc >= 8.2)- ghc-options: -Wcpp-undef-- ghc-options: -Wall+ ghc-options: -Wnoncanonical-monadfail-instances
+ examples/NamedBasedExplicitDecode.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}++import qualified Data.ByteString.Lazy as BL+import Data.Csv+import qualified Data.Vector as V++data Person = Person+ { name :: String+ , salary :: Int+ }++valueParse :: NamedRecord -> Parser Person+valueParse r = Person <$> r .: "name" <*> r .: "salary"++main :: IO ()+main = do+ csvData <- BL.readFile "salaries.csv"+ case decodeByNameWithP valueParse defaultDecodeOptions csvData of+ Left err -> putStrLn err+ Right (_, v) -> V.forM_ v $ \ p ->+ putStrLn $ name p ++ " earns " ++ show (salary p) ++ " dollars"
+ src/Data/Csv.hs view
@@ -0,0 +1,470 @@+-- | This module implements encoding and decoding+-- of [comma-separated values (CSV)](https://en.wikipedia.org/wiki/Comma-separated_values)+-- data. The implementation is [RFC 4180](https://tools.ietf.org/html/rfc4180)+-- compliant, with the following extensions:+--+-- * Empty lines are ignored.+--+-- * Non-escaped fields may contain any characters except+-- double-quotes, commas, carriage returns, and newlines.+--+-- * Escaped fields may contain any characters (but double-quotes+-- need to be escaped).+module Data.Csv+ (+ -- * 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++ -- ** Reading/writing CSV files+ -- $example-file++ -- * Treating CSV data as opaque byte strings+ -- $generic-processing++ -- * Custom type conversions for fields+ -- $customtypeconversions++ -- ** Dealing with bad data+ -- $baddata++ -- * Encoding and decoding+ -- $encoding+ HasHeader(..)+ , decode+ , decodeByName+ , encode+ , encodeByName+ , encodeDefaultOrderedByName+ , DefaultOrdered(..)++ -- ** Encoding and decoding options+ -- $options+ , DecodeOptions(..)+ , defaultDecodeOptions+ , decodeWith+ , decodeWithP+ , decodeByNameWith+ , decodeByNameWithP+ , EncodeOptions(..)+ , Quoting(..)+ , MissingFieldPolicy(..)+ , defaultMissingFieldPolicy+ , defaultEncodeOptions+ , encodeWith+ , encodeByNameWith+ , encodeDefaultOrderedByNameWith++ -- * Core CSV types+ , Csv+ , Record+ , Field+ , Header+ , Name+ , NamedRecord++ -- * Type conversion+ -- $typeconversion++ -- ** Index-based record conversion+ -- $indexbased+ , FromRecord(..)+ , Parser+ , runParser+ , index+ , (.!)+ , unsafeIndex+ , ToRecord(..)+ , record+ , Only(..)++ -- ** Name-based record conversion+ -- $namebased+ , FromNamedRecord(..)+ , lookup+ , (.:)+ , ToNamedRecord(..)+ , namedRecord+ , namedField+ , (.=)+ , header++ -- ** Field conversion+ -- $fieldconversion+ , FromField(..)+ , ToField(..)++ -- ** 'Generic' record conversion+ -- $genericconversion+ , genericParseRecord+ , genericToRecord+ , genericParseNamedRecord+ , genericToNamedRecord+ , genericHeaderOrder++ -- *** 'Generic' type conversion options+ , Options+ , defaultOptions+ , fieldLabelModifier++ -- *** 'Generic' type conversion class name+ -- $genericconversionclass+ , GFromRecord+ , GToRecord+ , GFromNamedRecord+ , GToNamedRecordHeader+ ) where++import Prelude hiding (lookup)++import Data.Csv.Conversion+import Data.Csv.Encoding+import Data.Csv.Types++-- $example+--+-- Encoding standard Haskell types:+--+-- >>> :set -XOverloadedStrings+-- >>> import Data.Text (Text)+-- >>> encode [("John" :: Text, 27 :: Int), ("Jane", 28)]+-- "John,27\r\nJane,28\r\n"+--+-- Since we enabled the [-XOverloadedStrings extension](https://downloads.haskell.org/~ghc/8.2.1/docs/html/users_guide/glasgow_exts.html#overloaded-string-literals),+-- string literals are polymorphic and we have to supply a type+-- signature as the compiler couldn't deduce which string type (i.e.+-- 'String', 'Data.Text.Short.ShortText', or 'Data.Text.Text') we want to use. In most cases+-- type inference will infer the type from the context and you can+-- omit type signatures.+--+-- Decoding standard Haskell types:+--+-- >>> import Data.Vector (Vector)+-- >>> decode NoHeader "John,27\r\nJane,28\r\n" :: Either String (Vector (Text, Int))+-- Right [("John",27),("Jane",28)]+--+-- We pass 'NoHeader' as the first argument to indicate that the CSV+-- input data isn't preceded by a header.+--+-- In practice, the return type of 'decode' rarely needs to be given,+-- as it can often be inferred from the context.++-- $example-file+--+-- Demonstration of reading from a CSV file/ writing to a CSV file+-- using the incremental API:+--+-- > {-# LANGUAGE BangPatterns #-}+-- > {-# LANGUAGE DeriveGeneric #-}+-- > {-# LANGUAGE LambdaCase #-}+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > -- from base+-- > import GHC.Generics+-- > import System.IO+-- > import System.Exit (exitFailure)+-- > -- from bytestring+-- > import Data.ByteString (ByteString, hGetSome, empty)+-- > import qualified Data.ByteString.Lazy as BL+-- > -- from cassava+-- > import Data.Csv.Incremental+-- > import Data.Csv (FromRecord, ToRecord)+-- >+-- > data Person = Person+-- > { name :: !ByteString+-- > , age :: !Int+-- > } deriving (Show, Eq, Generic)+-- >+-- > instance FromRecord Person+-- > instance ToRecord Person+-- >+-- > persons :: [Person]+-- > persons = [Person "John Doe" 19, Person "Smith" 20]+-- >+-- > writeToFile :: IO ()+-- > writeToFile = do+-- > BL.writeFile "persons.csv" $ encode $+-- > foldMap encodeRecord persons+-- >+-- > feed :: (ByteString -> Parser Person) -> Handle -> IO (Parser Person)+-- > feed k csvFile = do+-- > hIsEOF csvFile >>= \case+-- > True -> return $ k empty+-- > False -> k <$> hGetSome csvFile 4096+-- >+-- > readFromFile :: IO ()+-- > readFromFile = do+-- > withFile "persons.csv" ReadMode $ \ csvFile -> do+-- > let loop !_ (Fail _ errMsg) = do putStrLn errMsg; exitFailure+-- > loop acc (Many rs k) = loop (acc <> rs) =<< feed k csvFile+-- > loop acc (Done rs) = print (acc <> rs)+-- > loop [] (decode NoHeader)+-- >+-- > main :: IO ()+-- > main = do+-- > writeToFile+-- > readFromFile+-- >++-- $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 the 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+--+-- "GHC.Generics"-derived:+--+-- > {-# LANGUAGE DeriveGeneric #-}+-- >+-- > import Data.Text (Text)+-- > import GHC.Generics (Generic)+-- >+-- > data Person = Person { name :: !Text , salary :: !Int }+-- > deriving (Generic, Show)+-- >+-- > instance FromRecord Person+-- > instance ToRecord Person+--+-- Manually defined:+--+-- > import Control.Monad (mzero)+-- >+-- > data Person = Person { name :: !Text , salary :: !Int }+-- > deriving (Show)+-- >+-- > 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 [Person {name = "John", salary = 27}]+--++-- $example-named-instance+--+-- "GHC.Generics"-derived:+--+-- > {-# LANGUAGE DeriveGeneric #-}+-- >+-- > import Data.Text (Text)+-- > import GHC.Generics (Generic)+-- >+-- > data Person = Person { name :: !Text , salary :: !Int }+-- > deriving (Generic, Show)+-- >+-- > instance FromNamedRecord Person+-- > instance ToNamedRecord Person+-- > instance DefaultOrdered Person+--+-- Manually defined:+--+-- > data Person = Person { name :: !Text , salary :: !Int }+-- > deriving (Show)+-- >+-- > instance FromNamedRecord Person where+-- > parseNamedRecord m = Person <$> m .: "name" <*> m .: "salary"+-- > instance ToNamedRecord Person where+-- > 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+-- 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:+--+-- >>> import Data.ByteString (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+-- uninterpreted 'ByteString' values.++-- $customtypeconversions+--+-- Most of the time the existing 'FromField' and 'ToField' instances+-- do what you want. However, if you need to parse a different format+-- (e.g. hex) but use a type (e.g. 'Int') for which there's already a+-- 'FromField' instance, you need to use a @newtype@. Example:+--+-- > newtype Hex = Hex Int+-- >+-- > parseHex :: ByteString -> Parser Int+-- > parseHex = ...+-- >+-- > instance FromField Hex where+-- > parseField s = Hex <$> parseHex s+--+-- Other than giving an explicit type signature, you can pattern match+-- on the @newtype@ constructor to indicate which type conversion you+-- want to have the library use:+--+-- > case decode NoHeader "0xff,0xaa\r\n0x11,0x22\r\n" of+-- > Left err -> putStrLn err+-- > Right v -> forM_ v $ \ (Hex val1, Hex val2) ->+-- > print (val1, val2)+--+-- If a field might be in one several different formats, you can use a+-- newtype to normalize the result:+--+-- > newtype HexOrDecimal = HexOrDecimal Int+-- >+-- > instance FromField DefaultToZero where+-- > parseField s = case runParser (parseField s :: Parser Hex) of+-- > Left err -> HexOrDecimal <$> parseField s -- Uses Int instance+-- > Right n -> pure $ HexOrDecimal n+--+-- You can use the unit type, @()@, to ignore a column. The+-- 'parseField' method for @()@ doesn't look at the 'Field' and thus+-- always decodes successfully. Note that it lacks a corresponding+-- 'ToField' instance. Example:+--+-- > case decode NoHeader "foo,1\r\nbar,22" of+-- > Left err -> putStrLn err+-- > Right v -> forM_ v $ \ ((), i) -> print (i :: Int)++-- $baddata+--+-- If your input might contain invalid fields, you can write a custom+-- 'FromField' instance to deal with them. Example:+--+-- > newtype DefaultToZero = DefaultToZero Int+-- >+-- > instance FromField DefaultToZero where+-- > parseField s = case runParser (parseField s) of+-- > Left err -> pure $ DefaultToZero 0+-- > Right n -> pure $ DefaultToZero n++-- $encoding+--+-- Encoding and decoding is a two step process. To encode a value, it+-- is first converted to a generic representation, using either+-- 'ToRecord' or 'ToNamedRecord'. The generic representation is then+-- encoded as CSV data. To decode a value the process is reversed and+-- either 'FromRecord' or 'FromNamedRecord' is used instead. Both+-- these steps are combined in the 'encode' and 'decode' functions.++-- $typeconversion+--+-- There are two ways to convert CSV records to and from and+-- user-defined data types: index-based conversion and name-based+-- conversion.++-- $indexbased+--+-- Index-based conversion lets you convert CSV records to and from+-- user-defined data types by referring to a field's position (its+-- index) in the record. The first column in a CSV file is given index+-- 0, the second index 1, and so on.++-- $namebased+--+-- Name-based conversion lets you convert CSV records to and from+-- user-defined data types by referring to a field's name. The names+-- of the fields are defined by the first line in the file, also known+-- as the header. Name-based conversion is more robust to changes in+-- the file structure e.g. to reording or addition of columns, but can+-- be a bit slower.++-- $options+--+-- These functions can be used to control how data is encoded and+-- decoded. For example, they can be used to encode data in a+-- tab-separated format instead of in a comma-separated format.++-- $fieldconversion+--+-- The 'FromField' and 'ToField' classes define how to convert between+-- 'Field's and values you care about (e.g. 'Int's). Most of the time+-- you don't need to write your own instances as the standard ones+-- cover most use cases.++-- $genericconversion+--+-- There may be times that you do not want to manually write out class+-- instances for record conversion, but you can't rely upon the+-- default instances (e.g. you can't create field names that match the+-- actual column names in expected data).+--+-- For example, consider you have a type @MyType@ where you have+-- prefixed certain columns with an underscore, but in the actual data+-- they're not. You can then write:+--+-- > myOptions :: Options+-- > myOptions = defaultOptions { fieldLabelModifier = rmUnderscore }+-- > where+-- > rmUnderscore ('_':str) = str+-- > rmUnderscore str = str+-- >+-- > instance ToNamedRecord MyType where+-- > toNamedRecord = genericToNamedRecord myOptions+-- >+-- > instance FromNamedRecord MyType where+-- > parseNamedRecord = genericParseNamedRecord myOptions+-- >+-- > instance DefaultOrdered MyType where+-- > headerOrder = genericHeaderOrder myOptions++-- $genericconversionclass+--+-- __NOTE__: Only the class /names/ are exposed in order to make it possible to write type signatures referring to these classes++-- $setup+-- >>> :set -XOverloadedStrings -XDeriveGeneric+-- >>> import Data.Text (Text)+-- >>> import Data.Vector (Vector)+-- >>> import GHC.Generics (Generic)+-- >>>+-- >>> data Person = Person { name :: !Text, salary :: !Int } deriving (Generic, Show)+-- >>> instance FromRecord Person+-- >>> instance ToRecord Person+-- >>> instance FromNamedRecord Person+-- >>> instance ToNamedRecord Person+-- >>> instance DefaultOrdered Person
+ src/Data/Csv/Builder.hs view
@@ -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 qualified Data.Monoid as Mon++import Data.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)+ Mon.<> 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) (encMissingFieldPolicy opts)+ (toNamedRecord nr) Mon.<> 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))
+ src/Data/Csv/Conversion.hs view
@@ -0,0 +1,1380 @@+{-# LANGUAGE+ BangPatterns,+ CPP,+ DefaultSignatures,+ FlexibleContexts,+ FlexibleInstances,+ KindSignatures,+ MultiParamTypeClasses,+ OverloadedStrings,+ Rank2Types,+ ScopedTypeVariables,+ TypeOperators,+ UndecidableInstances+ #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}++module Data.Csv.Conversion+ (+ -- * Type conversion+ Only(..)+ , FromRecord(..)+ , FromNamedRecord(..)+ , ToNamedRecord(..)+ , DefaultOrdered(..)+ , FromField(..)+ , ToRecord(..)+ , ToField(..)++ -- ** Generic type conversion+ , genericParseRecord+ , genericToRecord+ , genericParseNamedRecord+ , genericToNamedRecord+ , genericHeaderOrder++ -- *** Generic type conversion options+ , Options+ , defaultOptions+ , fieldLabelModifier++ -- *** Generic type conversion class names+ , GFromRecord+ , GToRecord+ , GFromNamedRecord+ , GToNamedRecordHeader++ -- * Parser+ , Parser+ , runParser++ -- * Accessors+ , index+ , (.!)+ , unsafeIndex+ , lookup+ , (.:)+ , namedField+ , (.=)+ , record+ , namedRecord+ , header+ ) where++import Control.Applicative (Alternative, (<|>), empty, Const(..))+import Control.Monad (MonadPlus, mplus, mzero)+import qualified Control.Monad.Fail as Fail+import Data.Attoparsec.ByteString.Char8 (double)+import qualified Data.Attoparsec.ByteString.Char8 as A8+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Short as SBS+import Data.Functor.Identity+import Data.List (intercalate)+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 Data.Scientific (Scientific)+import Data.Semigroup as Semi (Semigroup, (<>))+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Encoding as LT+import qualified Data.Text.Short as T.S+import Data.Tuple.Only (Only(..))+import Data.Vector (Vector, (!))+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U+import Data.Word (Word8, Word16, Word32, Word64)+import GHC.Float (double2Float)+import GHC.Generics+import Numeric.Natural+import Prelude hiding (lookup, takeWhile)++import Data.Csv.Conversion.Internal+import Data.Csv.Types++------------------------------------------------------------------------+-- bytestring compatibility++toStrict :: L.ByteString -> B.ByteString+fromStrict :: B.ByteString -> L.ByteString+toStrict = L.toStrict+fromStrict = L.fromStrict+{-# INLINE toStrict #-}+{-# INLINE fromStrict #-}++------------------------------------------------------------------------+-- Type conversion++------------------------------------------------------------------------+-- Index-based conversion++-- | Options to customise how to generically encode\/decode your+-- datatype to\/from CSV.+--+-- @since 0.5.1.0+newtype Options = Options+ { fieldLabelModifier :: String -> String+ -- ^ How to convert Haskell field labels to CSV fields.+ --+ -- @since 0.5.1.0+ }++instance Show Options where+ show (Options fld) =+ "Options {"+ ++ intercalate ","+ [ "fieldLabelModifier =~ " ++ show sampleField ++ " -> " ++ show (fld sampleField)+ ]+ ++ "}"+ where+ sampleField = "_column_A"++-- | Default conversion options.+--+-- @+-- Options+-- { 'fieldLabelModifier' = id+-- }+-- @+--+-- @since 0.5.1.0+defaultOptions :: Options+defaultOptions = Options+ { fieldLabelModifier = id+ }++-- | A type that can be converted from a single CSV record, with the+-- possibility of failure.+--+-- When writing an instance, use 'empty', 'mzero', or 'fail' to make a+-- conversion fail, e.g. if a 'Record' has the wrong number of+-- columns.+--+-- Given this example data:+--+-- > John,56+-- > Jane,55+--+-- here's an example type and instance:+--+-- > data Person = Person { name :: !Text, age :: !Int }+-- >+-- > instance FromRecord Person where+-- > parseRecord v+-- > | length v == 2 = Person <$>+-- > v .! 0 <*>+-- > v .! 1+-- > | otherwise = mzero+class FromRecord a where+ parseRecord :: Record -> Parser a++ default parseRecord :: (Generic a, GFromRecord (Rep a)) => Record -> Parser a+ parseRecord = genericParseRecord defaultOptions++-- | A configurable CSV record parser. This function applied to+-- 'defaultOptions' is used as the default for 'parseRecord' when the+-- type is an instance of 'Generic'.+--+-- @since 0.5.1.0+genericParseRecord :: (Generic a, GFromRecord (Rep a)) => Options -> Record -> Parser a+genericParseRecord opts r = to <$> gparseRecord opts r++-- | A type that can be converted to a single CSV record.+--+-- An example type and instance:+--+-- > data Person = Person { name :: !Text, age :: !Int }+-- >+-- > instance ToRecord Person where+-- > toRecord (Person name age) = record [+-- > toField name, toField age]+--+-- Outputs data on this form:+--+-- > John,56+-- > Jane,55+class ToRecord a where+ -- | Convert a value to a record.+ toRecord :: a -> Record++ default toRecord :: (Generic a, GToRecord (Rep a) Field) => a -> Record+ toRecord = genericToRecord defaultOptions++-- | A configurable CSV record creator. This function applied to+-- 'defaultOptions' is used as the default for 'toRecord' when the+-- type is an instance of 'Generic'.+--+-- @since 0.5.1.0+genericToRecord :: (Generic a, GToRecord (Rep a) Field) => Options -> a -> Record+genericToRecord opts = V.fromList . gtoRecord opts . from++instance FromField a => FromRecord (Only a) where+ parseRecord v+ | n == 1 = Only <$> unsafeIndex v 0+ | otherwise = lengthMismatch 1 v+ where+ n = V.length v++-- TODO: Check if we want all toRecord conversions to be stricter.++instance ToField a => ToRecord (Only a) where+ toRecord = V.singleton . toField . fromOnly++instance (FromField a, FromField b) => FromRecord (a, b) where+ parseRecord v+ | n == 2 = (,) <$> unsafeIndex v 0+ <*> unsafeIndex v 1+ | otherwise = lengthMismatch 2 v+ where+ n = V.length v++instance (ToField a, ToField b) => ToRecord (a, b) where+ toRecord (a, b) = V.fromList [toField a, toField b]++instance (FromField a, FromField b, FromField c) => FromRecord (a, b, c) where+ parseRecord v+ | n == 3 = (,,) <$> unsafeIndex v 0+ <*> unsafeIndex v 1+ <*> unsafeIndex v 2+ | otherwise = lengthMismatch 3 v+ where+ n = V.length v++instance (ToField a, ToField b, ToField c) =>+ ToRecord (a, b, c) where+ toRecord (a, b, c) = V.fromList [toField a, toField b, toField c]++instance (FromField a, FromField b, FromField c, FromField d) =>+ FromRecord (a, b, c, d) where+ parseRecord v+ | n == 4 = (,,,) <$> unsafeIndex v 0+ <*> unsafeIndex v 1+ <*> unsafeIndex v 2+ <*> unsafeIndex v 3+ | otherwise = lengthMismatch 4 v+ where+ n = V.length v++instance (ToField a, ToField b, ToField c, ToField d) =>+ ToRecord (a, b, c, d) where+ toRecord (a, b, c, d) = V.fromList [+ toField a, toField b, toField c, toField d]++instance (FromField a, FromField b, FromField c, FromField d, FromField e) =>+ FromRecord (a, b, c, d, e) where+ parseRecord v+ | n == 5 = (,,,,) <$> unsafeIndex v 0+ <*> unsafeIndex v 1+ <*> unsafeIndex v 2+ <*> unsafeIndex v 3+ <*> unsafeIndex v 4+ | otherwise = lengthMismatch 5 v+ where+ n = V.length v++instance (ToField a, ToField b, ToField c, ToField d, ToField e) =>+ ToRecord (a, b, c, d, e) where+ toRecord (a, b, c, d, e) = V.fromList [+ toField a, toField b, toField c, toField d, toField e]++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f) =>+ FromRecord (a, b, c, d, e, f) where+ parseRecord v+ | n == 6 = (,,,,,) <$> unsafeIndex v 0+ <*> unsafeIndex v 1+ <*> unsafeIndex v 2+ <*> unsafeIndex v 3+ <*> unsafeIndex v 4+ <*> unsafeIndex v 5+ | otherwise = lengthMismatch 6 v+ where+ n = V.length v++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f) =>+ ToRecord (a, b, c, d, e, f) where+ toRecord (a, b, c, d, e, f) = V.fromList [+ toField a, toField b, toField c, toField d, toField e, toField f]++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g) =>+ FromRecord (a, b, c, d, e, f, g) where+ parseRecord v+ | n == 7 = (,,,,,,) <$> unsafeIndex v 0+ <*> unsafeIndex v 1+ <*> unsafeIndex v 2+ <*> unsafeIndex v 3+ <*> unsafeIndex v 4+ <*> unsafeIndex v 5+ <*> unsafeIndex v 6+ | otherwise = lengthMismatch 7 v+ where+ n = V.length v++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g) =>+ ToRecord (a, b, c, d, e, f, g) where+ toRecord (a, b, c, d, e, f, g) = V.fromList [+ toField a, toField b, toField c, toField d, toField e, toField f,+ toField g]++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h) =>+ FromRecord (a, b, c, d, e, f, g, h) where+ parseRecord v+ | n == 8 = (,,,,,,,) <$> unsafeIndex v 0+ <*> unsafeIndex v 1+ <*> unsafeIndex v 2+ <*> unsafeIndex v 3+ <*> unsafeIndex v 4+ <*> unsafeIndex v 5+ <*> unsafeIndex v 6+ <*> unsafeIndex v 7+ | otherwise = lengthMismatch 8 v+ where+ n = V.length v++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h) =>+ ToRecord (a, b, c, d, e, f, g, h) where+ toRecord (a, b, c, d, e, f, g, h) = V.fromList [+ toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h]++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i) =>+ FromRecord (a, b, c, d, e, f, g, h, i) where+ parseRecord v+ | n == 9 = (,,,,,,,,) <$> unsafeIndex v 0+ <*> unsafeIndex v 1+ <*> unsafeIndex v 2+ <*> unsafeIndex v 3+ <*> unsafeIndex v 4+ <*> unsafeIndex v 5+ <*> unsafeIndex v 6+ <*> unsafeIndex v 7+ <*> unsafeIndex v 8+ | otherwise = lengthMismatch 9 v+ where+ n = V.length v++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i) =>+ ToRecord (a, b, c, d, e, f, g, h, i) where+ toRecord (a, b, c, d, e, f, g, h, i) = V.fromList [+ toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i]++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j) =>+ FromRecord (a, b, c, d, e, f, g, h, i, j) where+ parseRecord v+ | n == 10 = (,,,,,,,,,) <$> unsafeIndex v 0+ <*> unsafeIndex v 1+ <*> unsafeIndex v 2+ <*> unsafeIndex v 3+ <*> unsafeIndex v 4+ <*> unsafeIndex v 5+ <*> unsafeIndex v 6+ <*> unsafeIndex v 7+ <*> unsafeIndex v 8+ <*> unsafeIndex v 9+ | otherwise = lengthMismatch 10 v+ where+ n = V.length v++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j) =>+ ToRecord (a, b, c, d, e, f, g, h, i, j) where+ toRecord (a, b, c, d, e, f, g, h, i, j) = V.fromList [+ toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j]++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k) =>+ FromRecord (a, b, c, d, e, f, g, h, i, j, k) where+ parseRecord v+ | n == 11 = (,,,,,,,,,,) <$> unsafeIndex v 0+ <*> unsafeIndex v 1+ <*> unsafeIndex v 2+ <*> unsafeIndex v 3+ <*> unsafeIndex v 4+ <*> unsafeIndex v 5+ <*> unsafeIndex v 6+ <*> unsafeIndex v 7+ <*> unsafeIndex v 8+ <*> unsafeIndex v 9+ <*> unsafeIndex v 10+ | otherwise = lengthMismatch 11 v+ where+ n = V.length v++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j, ToField k) =>+ ToRecord (a, b, c, d, e, f, g, h, i, j, k) where+ toRecord (a, b, c, d, e, f, g, h, i, j, k) = V.fromList [+ toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j, toField k]++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l) =>+ FromRecord (a, b, c, d, e, f, g, h, i, j, k, l) where+ parseRecord v+ | n == 12 = (,,,,,,,,,,,) <$> unsafeIndex v 0+ <*> unsafeIndex v 1+ <*> unsafeIndex v 2+ <*> unsafeIndex v 3+ <*> unsafeIndex v 4+ <*> unsafeIndex v 5+ <*> unsafeIndex v 6+ <*> unsafeIndex v 7+ <*> unsafeIndex v 8+ <*> unsafeIndex v 9+ <*> unsafeIndex v 10+ <*> unsafeIndex v 11+ | otherwise = lengthMismatch 12 v+ where+ n = V.length v++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l) =>+ ToRecord (a, b, c, d, e, f, g, h, i, j, k, l) where+ toRecord (a, b, c, d, e, f, g, h, i, j, k, l) = V.fromList [+ toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j, toField k, toField l]++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m) =>+ FromRecord (a, b, c, d, e, f, g, h, i, j, k, l, m) where+ parseRecord v+ | n == 13 = (,,,,,,,,,,,,) <$> unsafeIndex v 0+ <*> unsafeIndex v 1+ <*> unsafeIndex v 2+ <*> unsafeIndex v 3+ <*> unsafeIndex v 4+ <*> unsafeIndex v 5+ <*> unsafeIndex v 6+ <*> unsafeIndex v 7+ <*> unsafeIndex v 8+ <*> unsafeIndex v 9+ <*> unsafeIndex v 10+ <*> unsafeIndex v 11+ <*> unsafeIndex v 12+ | otherwise = lengthMismatch 13 v+ where+ n = V.length v++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,+ ToField m) =>+ ToRecord (a, b, c, d, e, f, g, h, i, j, k, l, m) where+ toRecord (a, b, c, d, e, f, g, h, i, j, k, l, m) = V.fromList [+ toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j, toField k, toField l,+ toField m]++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n) =>+ FromRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where+ parseRecord v+ | n == 14 = (,,,,,,,,,,,,,) <$> unsafeIndex v 0+ <*> unsafeIndex v 1+ <*> unsafeIndex v 2+ <*> unsafeIndex v 3+ <*> unsafeIndex v 4+ <*> unsafeIndex v 5+ <*> unsafeIndex v 6+ <*> unsafeIndex v 7+ <*> unsafeIndex v 8+ <*> unsafeIndex v 9+ <*> unsafeIndex v 10+ <*> unsafeIndex v 11+ <*> unsafeIndex v 12+ <*> unsafeIndex v 13+ | otherwise = lengthMismatch 14 v+ where+ n = V.length v++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,+ ToField m, ToField n) =>+ ToRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where+ toRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n) = V.fromList [+ toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j, toField k, toField l,+ toField m, toField n]++instance (FromField a, FromField b, FromField c, FromField d, FromField e,+ FromField f, FromField g, FromField h, FromField i, FromField j,+ FromField k, FromField l, FromField m, FromField n, FromField o) =>+ FromRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where+ parseRecord v+ | n == 15 = (,,,,,,,,,,,,,,) <$> unsafeIndex v 0+ <*> unsafeIndex v 1+ <*> unsafeIndex v 2+ <*> unsafeIndex v 3+ <*> unsafeIndex v 4+ <*> unsafeIndex v 5+ <*> unsafeIndex v 6+ <*> unsafeIndex v 7+ <*> unsafeIndex v 8+ <*> unsafeIndex v 9+ <*> unsafeIndex v 10+ <*> unsafeIndex v 11+ <*> unsafeIndex v 12+ <*> unsafeIndex v 13+ <*> unsafeIndex v 14+ | otherwise = lengthMismatch 15 v+ where+ n = V.length v++instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,+ ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,+ ToField m, ToField n, ToField o) =>+ ToRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where+ toRecord (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) = V.fromList [+ toField a, toField b, toField c, toField d, toField e, toField f,+ toField g, toField h, toField i, toField j, toField k, toField l,+ toField m, toField n, toField o]++lengthMismatch :: Int -> Record -> Parser a+lengthMismatch expected v =+ fail $ "cannot unpack array of length " +++ show n ++ " into a " ++ desired ++ ". Input record: " +++ show v+ where+ n = V.length v+ desired | expected == 1 = "Only"+ | expected == 2 = "pair"+ | otherwise = show expected ++ "-tuple"++instance FromField a => FromRecord [a] where+ parseRecord = traverse parseField . V.toList++instance ToField a => ToRecord [a] where+ toRecord = V.fromList . map toField++instance FromField a => FromRecord (V.Vector a) where+ parseRecord = traverse parseField++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++-- | A type that can be converted from a single CSV record, with the+-- possibility of failure.+--+-- When writing an instance, use 'empty', 'mzero', or 'fail' to make a+-- conversion fail, e.g. if a 'Record' has the wrong number of+-- columns.+--+-- Given this example data:+--+-- > name,age+-- > John,56+-- > Jane,55+--+-- here's an example type and instance:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > data Person = Person { name :: !Text, age :: !Int }+-- >+-- > instance FromNamedRecord Person where+-- > parseNamedRecord m = Person <$>+-- > m .: "name" <*>+-- > m .: "age"+--+-- Note the use of the @OverloadedStrings@ language extension which+-- enables 'B8.ByteString' values to be written as string literals.+class FromNamedRecord a where+ parseNamedRecord :: NamedRecord -> Parser a++ default parseNamedRecord :: (Generic a, GFromNamedRecord (Rep a)) => NamedRecord -> Parser a+ parseNamedRecord = genericParseNamedRecord defaultOptions++-- | A configurable CSV named record parser. This function applied to+-- 'defaultOptions' is used as the default for 'parseNamedRecord'+-- when the type is an instance of 'Generic'.+--+-- @since 0.5.1.0+genericParseNamedRecord :: (Generic a, GFromNamedRecord (Rep a)) => Options -> NamedRecord -> Parser a+genericParseNamedRecord opts r = to <$> gparseNamedRecord opts r++-- | A type that can be converted to a single CSV record.+--+-- An example type and instance:+--+-- > data Person = Person { name :: !Text, age :: !Int }+-- >+-- > instance ToNamedRecord Person where+-- > toNamedRecord (Person name age) = namedRecord [+-- > "name" .= name, "age" .= age]+class ToNamedRecord a where+ -- | Convert a value to a named record.+ toNamedRecord :: a -> NamedRecord++ default toNamedRecord ::+ (Generic a, GToRecord (Rep a) (B.ByteString, B.ByteString)) =>+ a -> NamedRecord+ toNamedRecord = genericToNamedRecord defaultOptions++-- | A configurable CSV named record creator. This function applied+-- to 'defaultOptions' is used as the default for 'toNamedRecord' when+-- the type is an instance of 'Generic'.+--+-- @since 0.5.1.0+genericToNamedRecord :: (Generic a, GToRecord (Rep a) (B.ByteString, B.ByteString))+ => Options -> a -> NamedRecord+genericToNamedRecord opts = namedRecord . gtoRecord opts . from++-- | 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 = genericHeaderOrder defaultOptions++-- | A configurable CSV header record generator. This function+-- applied to 'defaultOptions' is used as the default for+-- 'headerOrder' when the type is an instance of 'Generic'.+--+-- @since 0.5.1.0+genericHeaderOrder :: (Generic a, GToNamedRecordHeader (Rep a))+ => Options -> a -> Header+genericHeaderOrder opts = V.fromList. gtoNamedRecordHeader opts . from++instance (FromField a, FromField b, Ord a) => FromNamedRecord (M.Map a b) where+ parseNamedRecord m = M.fromList <$>+ (traverse parseBoth $ HM.toList m)++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 (Eq a, FromField a, FromField b, Hashable a) => FromNamedRecord (HM.HashMap a b) where+ parseNamedRecord m = HM.fromList <$>+ (traverse parseBoth $ HM.toList m)++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++-- | A type that can be converted from a single CSV field, with the+-- possibility of failure.+--+-- When writing an instance, use 'empty', 'mzero', or 'fail' to make a+-- conversion fail, e.g. if a 'Field' can't be converted to the given+-- type.+--+-- Example type and instance:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > data Color = Red | Green | Blue+-- >+-- > instance FromField Color where+-- > parseField s+-- > | s == "R" = pure Red+-- > | s == "G" = pure Green+-- > | s == "B" = pure Blue+-- > | otherwise = mzero+class FromField a where+ parseField :: Field -> Parser a++-- | A type that can be converted to a single CSV field.+--+-- Example type and instance:+--+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > data Color = Red | Green | Blue+-- >+-- > instance ToField Color where+-- > toField Red = "R"+-- > toField Green = "G"+-- > toField Blue = "B"+class ToField a where+ toField :: a -> Field++-- | 'Nothing' if the 'Field' is 'B.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 'B.empty' field.+instance ToField a => ToField (Maybe a) where+ toField = maybe B.empty toField+ {-# INLINE toField #-}++-- | @'Left' field@ if conversion failed, 'Right' otherwise.+instance FromField a => FromField (Either Field a) where+ parseField s = case runParser (parseField s) of+ Left _ -> pure $ Left s+ Right a -> pure $ Right a+ {-# INLINE parseField #-}++-- | Ignores the 'Field'. Always succeeds.+instance FromField () where+ parseField _ = pure ()+ {-# INLINE parseField #-}++-- | @since 0.5.2.0+instance FromField a => FromField (Identity a) where+ parseField = fmap Identity . parseField+ {-# INLINE parseField #-}++-- | @since 0.5.2.0+instance ToField a => ToField (Identity a) where+ toField = toField . runIdentity+ {-# INLINE toField #-}++-- | @since 0.5.2.0+instance FromField a => FromField (Const a b) where+ parseField = fmap Const . parseField+ {-# INLINE parseField #-}++-- | @since 0.5.2.0+instance ToField a => ToField (Const a b) where+ toField = toField . getConst+ {-# INLINE toField #-}++-- | Assumes UTF-8 encoding.+instance FromField Char where+ parseField s =+ case T.decodeUtf8' s of+ Left e -> fail $ show e+ Right t+ | T.compareLength t 1 == EQ -> pure (T.head t)+ | otherwise -> typeError "Char" s Nothing+ {-# INLINE parseField #-}++-- | Uses UTF-8 encoding.+instance ToField Char where+ toField = toField . T.encodeUtf8 . T.singleton+ {-# INLINE toField #-}++-- | Accepts the same syntax as 'rational'. Ignores whitespace.+--+-- @since 0.5.1.0+instance FromField Scientific where+ parseField s = case parseOnly (ws *> A8.scientific <* ws) s of+ Left err -> typeError "Scientific" s (Just err)+ Right n -> pure n+ {-# INLINE parseField #-}++-- | Uses decimal notation or scientific notation, depending on the number.+--+-- @since 0.5.1.0+instance ToField Scientific where+ toField = scientific+ {-# INLINE toField #-}++-- | Accepts same syntax as 'rational'. Ignores whitespace.+instance FromField Double where+ parseField = parseDouble+ {-# INLINE parseField #-}++-- | Uses decimal notation or scientific notation, depending on the+-- number.+instance ToField Double where+ toField = realFloat+ {-# INLINE toField #-}++-- | Accepts same syntax as 'rational'. Ignores whitespace.+instance FromField Float where+ parseField s = double2Float <$> parseDouble s+ {-# INLINE parseField #-}++-- | Uses decimal notation or scientific notation, depending on the+-- number.+instance ToField Float where+ toField = realFloat+ {-# INLINE toField #-}++parseDouble :: B.ByteString -> Parser Double+parseDouble s = case parseOnly (ws *> double <* ws) s of+ Left err -> typeError "Double" s (Just err)+ Right n -> pure n+{-# INLINE parseDouble #-}++-- | Accepts a signed decimal number. Ignores whitespace.+instance FromField Int where+ parseField = parseSigned "Int"+ {-# INLINE parseField #-}++-- | Uses decimal encoding with optional sign.+instance ToField Int where+ toField = decimal+ {-# INLINE toField #-}++-- | Accepts a signed decimal number. Ignores whitespace.+instance FromField Integer where+ parseField = parseSigned "Integer"+ {-# INLINE parseField #-}++-- | Uses decimal encoding with optional sign.+instance ToField Integer where+ toField = decimal+ {-# INLINE toField #-}++-- | Accepts a signed decimal number. Ignores whitespace.+instance FromField Int8 where+ parseField = parseSigned "Int8"+ {-# INLINE parseField #-}++-- | Uses decimal encoding with optional sign.+instance ToField Int8 where+ toField = decimal+ {-# INLINE toField #-}++-- | Accepts a signed decimal number. Ignores whitespace.+instance FromField Int16 where+ parseField = parseSigned "Int16"+ {-# INLINE parseField #-}++-- | Uses decimal encoding with optional sign.+instance ToField Int16 where+ toField = decimal+ {-# INLINE toField #-}++-- | Accepts a signed decimal number. Ignores whitespace.+instance FromField Int32 where+ parseField = parseSigned "Int32"+ {-# INLINE parseField #-}++-- | Uses decimal encoding with optional sign.+instance ToField Int32 where+ toField = decimal+ {-# INLINE toField #-}++-- | Accepts a signed decimal number. Ignores whitespace.+instance FromField Int64 where+ parseField = parseSigned "Int64"+ {-# INLINE parseField #-}++-- | Uses decimal encoding with optional sign.+instance ToField Int64 where+ toField = decimal+ {-# INLINE toField #-}++-- | Accepts an unsigned decimal number. Ignores whitespace.+instance FromField Word where+ parseField = parseUnsigned "Word"+ {-# INLINE parseField #-}++-- | Uses decimal encoding.+instance ToField Word where+ toField = decimal+ {-# INLINE toField #-}++-- | Accepts an unsigned decimal number. Ignores whitespace.+--+-- @since 0.5.1.0+instance FromField Natural where+ parseField = parseUnsigned "Natural"+ {-# INLINE parseField #-}++-- | Uses decimal encoding.+--+-- @since 0.5.1.0+instance ToField Natural where+ toField = decimal+ {-# INLINE toField #-}++-- | Accepts an unsigned decimal number. Ignores whitespace.+instance FromField Word8 where+ parseField = parseUnsigned "Word8"+ {-# INLINE parseField #-}++-- | Uses decimal encoding.+instance ToField Word8 where+ toField = decimal+ {-# INLINE toField #-}++-- | Accepts an unsigned decimal number. Ignores whitespace.+instance FromField Word16 where+ parseField = parseUnsigned "Word16"+ {-# INLINE parseField #-}++-- | Uses decimal encoding.+instance ToField Word16 where+ toField = decimal+ {-# INLINE toField #-}++-- | Accepts an unsigned decimal number. Ignores whitespace.+instance FromField Word32 where+ parseField = parseUnsigned "Word32"+ {-# INLINE parseField #-}++-- | Uses decimal encoding.+instance ToField Word32 where+ toField = decimal+ {-# INLINE toField #-}++-- | Accepts an unsigned decimal number. Ignores whitespace.+instance FromField Word64 where+ parseField = parseUnsigned "Word64"+ {-# INLINE parseField #-}++-- | Uses decimal encoding.+instance ToField Word64 where+ toField = decimal+ {-# INLINE toField #-}++instance FromField B.ByteString where+ parseField = pure+ {-# INLINE parseField #-}++instance ToField B.ByteString where+ toField = id+ {-# INLINE toField #-}++instance FromField L.ByteString where+ parseField = pure . fromStrict+ {-# INLINE parseField #-}++instance ToField L.ByteString where+ toField = toStrict+ {-# INLINE toField #-}++instance FromField SBS.ShortByteString where+ parseField = pure . SBS.toShort+ {-# INLINE parseField #-}++instance ToField SBS.ShortByteString where+ toField = SBS.fromShort+ {-# INLINE toField #-}++-- | Assumes UTF-8 encoding. Fails on invalid byte sequences.+--+-- @since 0.5.0.0+instance FromField T.S.ShortText where+ parseField = maybe (fail "Invalid UTF-8 stream") pure . T.S.fromByteString+ {-# INLINE parseField #-}++-- | Uses UTF-8 encoding.+--+-- @since 0.5.0.0+instance ToField T.S.ShortText where+ toField = T.S.toByteString+ {-# INLINE toField #-}++-- | Assumes UTF-8 encoding. Fails on invalid byte sequences.+instance FromField T.Text where+ parseField = either (fail . show) pure . T.decodeUtf8'+ {-# INLINE parseField #-}++-- | Uses UTF-8 encoding.+instance ToField T.Text where+ toField = toField . T.encodeUtf8+ {-# INLINE toField #-}++-- | Assumes UTF-8 encoding. Fails on invalid byte sequences.+instance FromField LT.Text where+ parseField = either (fail . show) (pure . LT.fromStrict) . T.decodeUtf8'+ {-# INLINE parseField #-}++-- | Uses UTF-8 encoding.+instance ToField LT.Text where+ toField = toField . toStrict . LT.encodeUtf8+ {-# INLINE toField #-}++-- | Assumes UTF-8 encoding. Fails on invalid byte sequences.+instance FromField [Char] where+ parseField = fmap T.unpack . parseField+ {-# INLINE parseField #-}++-- | Uses UTF-8 encoding.+instance ToField [Char] where+ toField = toField . T.pack+ {-# INLINE toField #-}++parseSigned :: (Integral a, Num a) => String -> B.ByteString -> Parser a+parseSigned typ s = case parseOnly (ws *> A8.signed A8.decimal <* ws) s of+ Left err -> typeError typ s (Just err)+ Right n -> pure n+{-# INLINE parseSigned #-}++parseUnsigned :: Integral a => String -> B.ByteString -> Parser a+parseUnsigned typ s = case parseOnly (ws *> A8.decimal <* ws) s of+ Left err -> typeError typ s (Just err)+ Right n -> pure n+{-# INLINE parseUnsigned #-}++ws :: A8.Parser ()+ws = A8.skipWhile (\c -> c == ' ' || c == '\t')++++------------------------------------------------------------------------+-- Custom version of attoparsec @parseOnly@ function which fails if+-- there is leftover content after parsing a field.+parseOnly :: A8.Parser a -> B.ByteString -> Either String a+parseOnly parser input = go (A8.parse parser input) where+ go (A8.Fail _ _ err) = Left err+ go (A8.Partial f) = go2 (f B.empty)+ go (A8.Done leftover result)+ | B.null leftover = Right result+ | otherwise = Left ("incomplete field parse, leftover: "+ ++ show (B.unpack leftover))++ go2 (A8.Fail _ _ err) = Left err+ go2 (A8.Partial _) = error "parseOnly: impossible error!"+ go2 (A8.Done leftover result)+ | B.null leftover = Right result+ | otherwise = Left ("incomplete field parse, leftover: "+ ++ show (B.unpack leftover))+{-# INLINE parseOnly #-}++typeError :: String -> B.ByteString -> Maybe String -> Parser a+typeError typ s mmsg =+ fail $ "expected " ++ typ ++ ", got " ++ show (B8.unpack s) ++ cause+ where+ cause = case mmsg of+ Just msg -> " (" ++ msg ++ ")"+ Nothing -> ""++------------------------------------------------------------------------+-- Constructors and accessors++-- | Retrieve the /n/th field in the given record. The result is+-- 'empty' if the value cannot be converted to the desired type.+-- Raises an exception if the index is out of bounds.+--+-- 'index' is a simple convenience function that is equivalent to+-- @'parseField' (v '!' idx)@. If you're certain that the index is not+-- out of bounds, using 'unsafeIndex' is somewhat faster.+index :: FromField a => Record -> Int -> Parser a+index v idx = parseField (v ! idx)+{-# INLINE index #-}++-- | Alias for 'index'.+(.!) :: FromField a => Record -> Int -> Parser a+(.!) = index+{-# INLINE (.!) #-}+infixl 9 .!++-- | Like 'index' but without bounds checking.+unsafeIndex :: FromField a => Record -> Int -> Parser a+unsafeIndex v idx = parseField (V.unsafeIndex v idx)+{-# INLINE unsafeIndex #-}++-- | Retrieve a field in the given record by name. The result is+-- 'empty' if the field is missing or if the value cannot be converted+-- to the desired type.+lookup :: FromField a => NamedRecord -> B.ByteString -> Parser a+lookup m name = maybe (fail err) parseField' $ HM.lookup name m+ where err = "no field named " ++ show (B8.unpack name)+ parseField' fld = case runParser (parseField fld) of+ Left e -> fail $ "in named field " ++ show (B8.unpack name) ++ ": " ++ e+ Right res -> pure res+{-# INLINE lookup #-}++-- | Alias for 'lookup'.+(.:) :: FromField a => NamedRecord -> B.ByteString -> Parser a+(.:) = lookup+{-# INLINE (.:) #-}++-- | Construct a pair from a name and a value. For use with+-- 'namedRecord'.+namedField :: ToField a => B.ByteString -> a -> (B.ByteString, B.ByteString)+namedField name val = (name, toField val)+{-# INLINE namedField #-}++-- | Alias for 'namedField'.+(.=) :: ToField a => B.ByteString -> a -> (B.ByteString, B.ByteString)+(.=) = namedField+{-# INLINE (.=) #-}++-- | Construct a record from a list of 'B.ByteString's. Use 'toField'+-- to convert values to 'B.ByteString's for use with 'record'.+record :: [B.ByteString] -> Record+record = V.fromList++-- | Construct a named record from a list of name-value 'B.ByteString'+-- pairs. Use '.=' to construct such a pair from a name and a value.+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++-- | Failure continuation.+type Failure f r = String -> f r+-- | Success continuation.+type Success a f r = a -> f r++-- | Conversion of a field to a value might fail e.g. if the field is+-- malformed. This possibility is captured by the 'Parser' type, which+-- lets you compose several field conversions together in such a way+-- that if any of them fail, the whole record conversion fails.+newtype Parser a = Parser {+ unParser :: forall (f :: * -> *) (r :: *).+ Failure f r+ -> Success a f r+ -> f r+ }++instance Monad Parser where+ m >>= g = Parser $ \kf ks -> let ks' a = unParser (g a) kf ks+ in unParser m kf ks'+ {-# INLINE (>>=) #-}+ (>>) = (*>)+ {-# INLINE (>>) #-}+ return = pure+ {-# INLINE return #-}++#if !MIN_VERSION_base(4,13,0)+ fail = Fail.fail+ {-# INLINE fail #-}+#endif++-- | @since 0.5.0.0+instance Fail.MonadFail Parser where+ fail msg = Parser $ \kf _ks -> kf msg+ {-# INLINE fail #-}++instance Functor Parser where+ fmap f m = Parser $ \kf ks -> let ks' a = ks (f a)+ in unParser m kf ks'+ {-# INLINE fmap #-}++instance Applicative Parser where+ pure a = Parser $ \_kf ks -> ks a+ {-# INLINE pure #-}+ (<*>) = apP+ {-# INLINE (<*>) #-}++instance Alternative Parser where+ empty = fail "empty"+ {-# INLINE empty #-}+ (<|>) = mplus+ {-# INLINE (<|>) #-}++instance MonadPlus Parser where+ mzero = fail "mzero"+ {-# INLINE mzero #-}+ mplus a b = Parser $ \kf ks -> let kf' _ = unParser b kf ks+ in unParser a kf' ks+ {-# INLINE mplus #-}++-- | @since 0.5.0.0+instance Semi.Semigroup (Parser a) where+ (<>) = mplus+ {-# INLINE (<>) #-}++instance Monoid (Parser a) where+ mempty = fail "mempty"+ {-# INLINE mempty #-}+ mappend = (Semi.<>)+ {-# INLINE mappend #-}++apP :: Parser (a -> b) -> Parser a -> Parser b+apP d e = do+ b <- d+ a <- e+ pure (b a)+{-# INLINE apP #-}++-- | Run a 'Parser', returning either @'Left' errMsg@ or @'Right'+-- result@. Forces the value in the 'Left' or 'Right' constructors to+-- weak head normal form.+--+-- You most likely won't need to use this function directly, but it's+-- included for completeness.+runParser :: Parser a -> Either String a+runParser p = unParser p left right+ where+ left !errMsg = Left errMsg+ right !x = Right x+{-# INLINE runParser #-}++------------------------------------------------------------------------+-- Generics++class GFromRecord f where+ gparseRecord :: Options -> Record -> Parser (f p)++instance GFromRecordSum f Record => GFromRecord (M1 i n f) where+ gparseRecord opts v =+ case IM.lookup n (gparseRecordSum opts) of+ Nothing -> lengthMismatch n v+ Just p -> M1 <$> p v+ where+ n = V.length v++class GFromNamedRecord f where+ gparseNamedRecord :: Options -> NamedRecord -> Parser (f p)++instance GFromRecordSum f NamedRecord => GFromNamedRecord (M1 i n f) where+ gparseNamedRecord opts v =+ foldr (\f p -> p <|> M1 <$> f v) empty (IM.elems (gparseRecordSum opts))++class GFromRecordSum f r where+ gparseRecordSum :: Options -> IM.IntMap (r -> Parser (f p))++instance (GFromRecordSum a r, GFromRecordSum b r) => GFromRecordSum (a :+: b) r where+ gparseRecordSum opts =+ IM.unionWith (\a b r -> a r <|> b r)+ (fmap (L1 <$>) <$> gparseRecordSum opts)+ (fmap (R1 <$>) <$> gparseRecordSum opts)++instance GFromRecordProd f r => GFromRecordSum (M1 i n f) r where+ gparseRecordSum opts = IM.singleton n (fmap (M1 <$>) f)+ where+ (n, f) = gparseRecordProd opts 0++class GFromRecordProd f r where+ gparseRecordProd :: Options -> 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 opts n0 = (n2, f)+ where+ f r = (:*:) <$> fa r <*> fb r+ (n1, fa) = gparseRecordProd opts n0+ (n2, fb) = gparseRecordProd opts n1++instance GFromRecordProd f Record => GFromRecordProd (M1 i n f) Record where+ gparseRecordProd opts n = fmap (M1 <$>) <$> gparseRecordProd opts 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 opts n = (n + 1, \v -> (M1 . K1) <$> v .: name)+ where+ name = T.encodeUtf8 (T.pack (fieldLabelModifier opts (selName (Proxy :: Proxy s f a))))+++class GToRecord a f where+ gtoRecord :: Options -> a p -> [f]++instance GToRecord U1 f where+ gtoRecord _ U1 = []++instance (GToRecord a f, GToRecord b f) => GToRecord (a :*: b) f where+ gtoRecord opts (a :*: b) = gtoRecord opts a ++ gtoRecord opts b++instance (GToRecord a f, GToRecord b f) => GToRecord (a :+: b) f where+ gtoRecord opts (L1 a) = gtoRecord opts a+ gtoRecord opts (R1 b) = gtoRecord opts b++instance GToRecord a f => GToRecord (M1 D c a) f where+ gtoRecord opts (M1 a) = gtoRecord opts a++instance GToRecord a f => GToRecord (M1 C c a) f where+ gtoRecord opts (M1 a) = gtoRecord opts a++instance GToRecord a Field => GToRecord (M1 S c a) Field where+ gtoRecord opts (M1 a) = gtoRecord opts 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 opts m@(M1 (K1 a)) = [name .= toField a]+ where+ name = T.encodeUtf8 (T.pack (fieldLabelModifier opts (selName m)))++-- We statically fail on sum types and product types without selectors+-- (field names).++class GToNamedRecordHeader a+ where+ gtoNamedRecordHeader :: Options -> a p -> [Name]++instance GToNamedRecordHeader U1+ where+ gtoNamedRecordHeader _ _ = []++instance (GToNamedRecordHeader a, GToNamedRecordHeader b) =>+ GToNamedRecordHeader (a :*: b)+ where+ gtoNamedRecordHeader opts _ = gtoNamedRecordHeader opts (undefined :: a p) +++ gtoNamedRecordHeader opts (undefined :: b p)++instance GToNamedRecordHeader a => GToNamedRecordHeader (M1 D c a)+ where+ gtoNamedRecordHeader opts _ = gtoNamedRecordHeader opts (undefined :: a p)++instance GToNamedRecordHeader a => GToNamedRecordHeader (M1 C c a)+ where+ gtoNamedRecordHeader opts _ = gtoNamedRecordHeader opts (undefined :: a p)++-- | Instance to ensure that you cannot derive DefaultOrdered for+-- constructors without selectors.+instance DefaultOrdered (M1 S ('MetaSel 'Nothing srcpk srcstr decstr) a ())+ => GToNamedRecordHeader (M1 S ('MetaSel 'Nothing srcpk srcstr decstr) a)+ where+ gtoNamedRecordHeader _ _ =+ error "You cannot derive DefaultOrdered for constructors without selectors."++instance Selector s => GToNamedRecordHeader (M1 S s a)+ where+ gtoNamedRecordHeader opts m+ | null name = error "Cannot derive DefaultOrdered for constructors without selectors"+ | otherwise = [B8.pack (fieldLabelModifier opts (selName m))]+ where name = selName m
+ src/Data/Csv/Conversion/Internal.hs view
@@ -0,0 +1,299 @@+module Data.Csv.Conversion.Internal+ ( decimal+ , scientific+ , realFloat+ ) where++import Data.ByteString.Builder (Builder, toLazyByteString, word8, char8,+ string8, byteString)+import qualified Data.ByteString.Builder.Prim as BP+import Data.ByteString.Builder.Scientific (scientificBuilder)+import Data.Array.Base (unsafeAt)+import Data.Array.IArray+import qualified Data.ByteString as B+import Data.Char (ord)+import Data.Int+import qualified Data.Monoid as Mon+import Data.Scientific (Scientific)+import Data.Word++import Data.Csv.Util (toStrict)++------------------------------------------------------------------------+-- Integers++decimal :: Integral a => a -> B.ByteString+decimal = toStrict . toLazyByteString . formatDecimal+{-# INLINE decimal #-}++-- TODO: Add an optimized version for Integer.++formatDecimal :: Integral a => a -> Builder+{-# RULES "formatDecimal/Int" formatDecimal = formatBoundedSigned+ :: Int -> Builder #-}+{-# RULES "formatDecimal/Int8" formatDecimal = formatBoundedSigned+ :: Int8 -> Builder #-}+{-# RULES "formatDecimal/Int16" formatDecimal = formatBoundedSigned+ :: Int16 -> Builder #-}+{-# RULES "formatDecimal/Int32" formatDecimal = formatBoundedSigned+ :: Int32 -> Builder #-}+{-# RULES "formatDecimal/Int64" formatDecimal = formatBoundedSigned+ :: Int64 -> Builder #-}+{-# RULES "formatDecimal/Word" formatDecimal = formatPositive+ :: Word -> Builder #-}+{-# RULES "formatDecimal/Word8" formatDecimal = formatPositive+ :: Word8 -> Builder #-}+{-# RULES "formatDecimal/Word16" formatDecimal = formatPositive+ :: Word16 -> Builder #-}+{-# RULES "formatDecimal/Word32" formatDecimal = formatPositive+ :: Word32 -> Builder #-}+{-# RULES "formatDecimal/Word64" formatDecimal = formatPositive+ :: Word64 -> Builder #-}+{-# NOINLINE formatDecimal #-}+formatDecimal i+ | i < 0 = minus Mon.<>+ if i <= -128+ then formatPositive (-(i `quot` 10)) Mon.<> digit (-(i `rem` 10))+ else formatPositive (-i)+ | otherwise = formatPositive i++formatBoundedSigned :: (Integral a, Bounded a) => a -> Builder+{-# SPECIALIZE formatBoundedSigned :: Int -> Builder #-}+{-# SPECIALIZE formatBoundedSigned :: Int8 -> Builder #-}+{-# SPECIALIZE formatBoundedSigned :: Int16 -> Builder #-}+{-# SPECIALIZE formatBoundedSigned :: Int32 -> Builder #-}+{-# SPECIALIZE formatBoundedSigned :: Int64 -> Builder #-}+formatBoundedSigned i+ | i < 0 = minus Mon.<>+ if i == minBound+ then formatPositive (-(i `quot` 10)) Mon.<> digit (-(i `rem` 10))+ else formatPositive (-i)+ | otherwise = formatPositive i++formatPositive :: Integral a => a -> Builder+{-# SPECIALIZE formatPositive :: Int -> Builder #-}+{-# SPECIALIZE formatPositive :: Int8 -> Builder #-}+{-# SPECIALIZE formatPositive :: Int16 -> Builder #-}+{-# SPECIALIZE formatPositive :: Int32 -> Builder #-}+{-# SPECIALIZE formatPositive :: Int64 -> Builder #-}+{-# SPECIALIZE formatPositive :: Word -> Builder #-}+{-# SPECIALIZE formatPositive :: Word8 -> Builder #-}+{-# SPECIALIZE formatPositive :: Word16 -> Builder #-}+{-# SPECIALIZE formatPositive :: Word32 -> Builder #-}+{-# SPECIALIZE formatPositive :: Word64 -> Builder #-}+formatPositive = go+ where go n | n < 10 = digit n+ | otherwise = go (n `quot` 10) Mon.<> digit (n `rem` 10)++minus :: Builder+minus = word8 45++zero :: Word8+zero = 48++digit :: Integral a => a -> Builder+digit n = word8 $! i2w (fromIntegral n)+{-# INLINE digit #-}++i2w :: Int -> Word8+i2w i = zero + fromIntegral i+{-# INLINE i2w #-}++------------------------------------------------------------------------+-- Floating point numbers++scientific :: Scientific -> B.ByteString+scientific = toStrict . toLazyByteString . scientificBuilder+{-# INLINE scientific #-}++realFloat :: RealFloat a => a -> B.ByteString+{-# SPECIALIZE realFloat :: Float -> B.ByteString #-}+{-# SPECIALIZE realFloat :: Double -> B.ByteString #-}+realFloat = toStrict . toLazyByteString . formatRealFloat Generic++-- | Control the rendering of floating point numbers.+data FPFormat = Exponent+ -- ^ Scientific notation (e.g. @2.3e123@).+ | Fixed+ -- ^ Standard decimal notation.+ | Generic+ -- ^ Use decimal notation for values between @0.1@ and+ -- @9,999,999@, and scientific notation otherwise.+ deriving (Enum, Read, Show)++formatRealFloat :: RealFloat a => FPFormat -> a -> Builder+{-# SPECIALIZE formatRealFloat :: FPFormat -> Float -> Builder #-}+{-# SPECIALIZE formatRealFloat :: FPFormat -> Double -> Builder #-}+formatRealFloat fmt x+ | isNaN x = string8 "NaN"+ | isInfinite x = if x < 0+ then string8 "-Infinity"+ else string8 "Infinity"+ | x < 0 || isNegativeZero x = minus Mon.<> doFmt fmt (floatToDigits (-x))+ | otherwise = doFmt fmt (floatToDigits x)+ where+ doFmt format (is, e) =+ let ds = map i2d is in+ case format of+ Generic ->+ doFmt (if e < 0 || e > 7 then Exponent else Fixed)+ (is,e)+ Exponent ->+ let show_e' = formatDecimal (e-1) in+ case ds of+ [48] -> string8 "0.0e0"+ [d] -> word8 d Mon.<> string8 ".0e" Mon.<> show_e'+ (d:ds') -> word8 d Mon.<> char8 '.' Mon.<> word8s ds' Mon.<>+ char8 'e' Mon.<> show_e'+ [] -> error "formatRealFloat/doFmt/Exponent: []"+ Fixed+ | e <= 0 -> string8 "0." Mon.<>+ byteString (B.replicate (-e) zero) Mon.<>+ word8s ds+ | otherwise ->+ let+ f 0 s rs = mk0 (reverse s) Mon.<> char8 '.' Mon.<> mk0 rs+ f n s [] = f (n-1) (zero:s) []+ f n s (r:rs) = f (n-1) (r:s) rs+ in+ f e [] ds+ where mk0 ls = case ls of { [] -> word8 zero ; _ -> word8s ls}++-- Based on "Printing Floating-Point Numbers Quickly and Accurately"+-- by R.G. Burger and R.K. Dybvig in PLDI 96.+-- This version uses a much slower logarithm estimator. It should be improved.++-- | 'floatToDigits' takes a base and a non-negative 'RealFloat' number,+-- and returns a list of digits and an exponent.+-- In particular, if @x>=0@, and+--+-- > floatToDigits base x = ([d1,d2,...,dn], e)+--+-- then+--+-- (1) @n >= 1@+--+-- (2) @x = 0.d1d2...dn * (base**e)@+--+-- (3) @0 <= di <= base-1@++floatToDigits :: (RealFloat a) => a -> ([Int], Int)+{-# SPECIALIZE floatToDigits :: Float -> ([Int], Int) #-}+{-# SPECIALIZE floatToDigits :: Double -> ([Int], Int) #-}+floatToDigits 0 = ([0], 0)+floatToDigits x =+ let+ (f0, e0) = decodeFloat x+ (minExp0, _) = floatRange x+ p = floatDigits x+ b = floatRadix x+ minExp = minExp0 - p -- the real minimum exponent+ -- Haskell requires that f be adjusted so denormalized numbers+ -- will have an impossibly low exponent. Adjust for this.+ (f, e) =+ let n = minExp - e0 in+ if n > 0 then (f0 `quot` (expt b n), e0+n) else (f0, e0)+ (r, s, mUp, mDn) =+ if e >= 0 then+ let be = expt b e in+ if f == expt b (p-1) then+ (f*be*b*2, 2*b, be*b, be) -- according to Burger and Dybvig+ else+ (f*be*2, 2, be, be)+ else+ if e > minExp && f == expt b (p-1) then+ (f*b*2, expt b (-e+1)*2, b, 1)+ else+ (f*2, expt b (-e)*2, 1, 1)+ k :: Int+ k =+ let+ k0 :: Int+ k0 =+ if b == 2 then+ -- logBase 10 2 is very slightly larger than 8651/28738+ -- (about 5.3558e-10), so if log x >= 0, the approximation+ -- k1 is too small, hence we add one and need one fixup step less.+ -- If log x < 0, the approximation errs rather on the high side.+ -- That is usually more than compensated for by ignoring the+ -- fractional part of logBase 2 x, but when x is a power of 1/2+ -- or slightly larger and the exponent is a multiple of the+ -- denominator of the rational approximation to logBase 10 2,+ -- k1 is larger than logBase 10 x. If k1 > 1 + logBase 10 x,+ -- we get a leading zero-digit we don't want.+ -- With the approximation 3/10, this happened for+ -- 0.5^1030, 0.5^1040, ..., 0.5^1070 and values close above.+ -- The approximation 8651/28738 guarantees k1 < 1 + logBase 10 x+ -- for IEEE-ish floating point types with exponent fields+ -- <= 17 bits and mantissae of several thousand bits, earlier+ -- convergents to logBase 10 2 would fail for long double.+ -- Using quot instead of div is a little faster and requires+ -- fewer fixup steps for negative lx.+ let lx = p - 1 + e0+ k1 = (lx * 8651) `quot` 28738+ in if lx >= 0 then k1 + 1 else k1+ else+ -- f :: Integer, log :: Float -> Float,+ -- ceiling :: Float -> Int+ ceiling ((log (fromInteger (f+1) :: Float) ++ fromIntegral e * log (fromInteger b)) /+ log 10)+--WAS: fromInt e * log (fromInteger b))++ fixup n =+ if n >= 0 then+ if r + mUp <= expt 10 n * s then n else fixup (n+1)+ else+ if expt 10 (-n) * (r + mUp) <= s then n else fixup (n+1)+ in+ fixup k0++ gen ds rn sN mUpN mDnN =+ let+ (dn, rn') = (rn * 10) `quotRem` sN+ mUpN' = mUpN * 10+ mDnN' = mDnN * 10+ in+ case (rn' < mDnN', rn' + mUpN' > sN) of+ (True, False) -> dn : ds+ (False, True) -> dn+1 : ds+ (True, True) -> if rn' * 2 < sN then dn : ds else dn+1 : ds+ (False, False) -> gen (dn:ds) rn' sN mUpN' mDnN'++ rds =+ if k >= 0 then+ gen [] r (s * expt 10 k) mUp mDn+ else+ let bk = expt 10 (-k) in+ gen [] (r * bk) s (mUp * bk) (mDn * bk)+ in+ (map fromIntegral (reverse rds), k)++-- Exponentiation with a cache for the most common numbers.+minExpt, maxExpt :: Int+minExpt = 0+maxExpt = 1100++expt :: Integer -> Int -> Integer+expt base n+ | base == 2 && n >= minExpt && n <= maxExpt = expts `unsafeAt` n+ | base == 10 && n <= maxExpt10 = expts10 `unsafeAt` n+ | otherwise = base^n++expts :: Array Int Integer+expts = array (minExpt,maxExpt) [(n,2^n) | n <- [minExpt .. maxExpt]]++maxExpt10 :: Int+maxExpt10 = 324++expts10 :: Array Int Integer+expts10 = array (minExpt,maxExpt10) [(n,10^n) | n <- [minExpt .. maxExpt10]]++-- | Unsafe conversion for decimal digits.+{-# INLINE i2d #-}+i2d :: Int -> Word8+i2d i = fromIntegral (ord '0' + i)++-- | Word8 list rendering+word8s :: [Word8] -> Builder+word8s = BP.primMapListFixed BP.word8
+ src/Data/Csv/Encoding.hs view
@@ -0,0 +1,439 @@+{-# LANGUAGE BangPatterns, OverloadedStrings, ScopedTypeVariables #-}++-- Module: Data.Csv.Encoding+-- Copyright: (c) 2011 MailRank, Inc.+-- (c) 2012 Johan Tibell+-- License: BSD3+-- Maintainer: Johan Tibell <johan.tibell@gmail.com>+-- Stability: experimental+-- Portability: portable+--+-- Encoding and decoding of data types into CSV.+module Data.Csv.Encoding+ (+ -- * Encoding and decoding+ HasHeader(..)+ , decode+ , decodeByName+ , Quoting(..)+ , MissingFieldPolicy(..)+ , defaultMissingFieldPolicy+ , encode+ , encodeByName+ , encodeDefaultOrderedByName++ -- ** Encoding and decoding options+ , DecodeOptions(..)+ , defaultDecodeOptions+ , decodeWith+ , decodeWithP+ , decodeByNameWith+ , decodeByNameWithP+ , EncodeOptions(..)+ , defaultEncodeOptions+ , encodeWith+ , encodeByNameWith+ , encodeDefaultOrderedByNameWith++ -- ** Encoding and decoding single records+ , encodeRecord+ , encodeNamedRecord+ , recordSep+ ) where++import Data.ByteString.Builder++import Control.Applicative as AP ((<|>))+import Data.Attoparsec.ByteString.Char8 (endOfInput)+import qualified Data.Attoparsec.ByteString.Lazy as AL+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.Lazy.Char8 as BL8+import Data.Foldable (asum)+import qualified Data.ByteString.Builder.Prim as P+import qualified Data.HashMap.Strict as HM+import Data.Maybe (fromMaybe)+import Data.Vector (Vector)+import qualified Data.Vector as V+import Data.Word (Word8)+import Data.Monoid+import Prelude hiding (unlines)++import qualified Data.Csv.Conversion as Conversion+import Data.Csv.Conversion (FromNamedRecord, FromRecord, ToNamedRecord,+ ToRecord, parseNamedRecord, parseRecord, runParser,+ toNamedRecord, toRecord)+import Data.Csv.Parser hiding (csv, csvWithHeader)+import qualified Data.Csv.Parser as Parser+import Data.Csv.Types hiding (toNamedRecord)+import qualified Data.Csv.Types as Types+import Data.Csv.Util (blankLine, endOfLine, doubleQuote, cr, newline, comma)+import Data.Functor (($>))++------------------------------------------------------------------------+-- * Encoding and decoding++-- | 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+ => HasHeader -- ^ Data contains header that should be+ -- skipped+ -> L.ByteString -- ^ CSV data+ -> Either String (Vector a)+decode = decodeWith defaultDecodeOptions+{-# INLINE decode #-}++-- | Efficiently deserialize CSV records from a lazy 'L.ByteString'.+-- If this fails due to incomplete or invalid input, @'Left' msg@ is+-- returned. The data is assumed to be preceded by a header.+-- Equivalent to @'decodeByNameWith' 'defaultDecodeOptions'@.+decodeByName :: FromNamedRecord a+ => L.ByteString -- ^ CSV data+ -> Either String (Header, Vector a)+decodeByName = decodeByNameWith defaultDecodeOptions+{-# INLINE decodeByName #-}++-- | Efficiently serialize CSV records as a lazy 'L.ByteString'.+encode :: ToRecord a => [a] -> L.ByteString+encode = encodeWith defaultEncodeOptions+{-# INLINE encode #-}++-- | Efficiently serialize CSV records as a lazy 'L.ByteString'. The+-- header is written before any records and dictates the field order.+encodeByName :: ToNamedRecord a => Header -> [a] -> L.ByteString+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++-- | Like 'decode', but lets you customize how the CSV data is parsed.+decodeWith :: FromRecord a+ => DecodeOptions -- ^ Decoding options+ -> HasHeader -- ^ Data contains header that should be+ -- skipped+ -> L.ByteString -- ^ CSV data+ -> Either String (Vector a)+decodeWith = decodeWithC (csv parseRecord)+{-# INLINE [1] decodeWith #-}++{-# RULES+ "idDecodeWith" decodeWith = idDecodeWith+ #-}++-- | Same as 'decodeWith', but more efficient as no type+-- conversion is performed.+idDecodeWith :: DecodeOptions -> HasHeader -> L.ByteString+ -> Either String (Vector (Vector B.ByteString))+idDecodeWith = decodeWithC Parser.csv++-- | Like 'decodeWith'', but lets you specify a parser function.+--+-- @since 0.5.2.0+decodeWithP :: (Record -> Conversion.Parser a)+ -- ^ Custom parser function+ -> DecodeOptions -- ^ Decoding options+ -> HasHeader -- ^ Data contains header that should be+ -- skipped+ -> L.ByteString -- ^ CSV data+ -> Either String (Vector a)+decodeWithP _parseRecord = decodeWithC (csv _parseRecord)+{-# INLINE [1] decodeWithP #-}++-- | Decode CSV data using the provided parser, skipping a leading+-- header if 'hasHeader' is 'HasHeader'. Returns 'Left' @errMsg@ on+-- failure.+decodeWithC :: (DecodeOptions -> AL.Parser a) -> DecodeOptions -> HasHeader+ -> BL8.ByteString -> Either String a+decodeWithC p !opts hasHeader = decodeWithP' parser+ where parser = case hasHeader of+ HasHeader -> header (decDelimiter opts) *> p opts+ NoHeader -> p opts+{-# INLINE decodeWithC #-}++-- | Like 'decodeByName', but lets you customize how the CSV data is+-- parsed.+decodeByNameWith :: FromNamedRecord a+ => DecodeOptions -- ^ Decoding options+ -> L.ByteString -- ^ CSV data+ -> Either String (Header, Vector a)+decodeByNameWith !opts = decodeWithP' (csvWithHeader parseNamedRecord opts)++-- | Like 'decodeByNameWith', but lets you specify a parser function.+--+-- @since 0.5.2.0+decodeByNameWithP :: (NamedRecord -> Conversion.Parser a)+ -- ^ Custom parser function+ -> DecodeOptions -- ^ Decoding options+ -> L.ByteString -- ^ CSV data+ -> Either String (Header, Vector a)+decodeByNameWithP _parseNamedRecord !opts =+ decodeWithP' (csvWithHeader _parseNamedRecord 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)++-- | How to encode missing fields.+data MissingFieldPolicy = MissingFieldPolicy+ { -- | Specify a default field value for each column.+ mfpDefaultByColumn :: NamedRecord++ -- | Specify a default field value to use for columns unspecified in+ -- 'mfpDefaultByColumn'. If 'Nothing', this situation results in an+ -- exception.+ , mfpOtherwise :: Maybe Field+ } deriving (Eq, Show)++defaultMissingFieldPolicy :: MissingFieldPolicy+defaultMissingFieldPolicy = MissingFieldPolicy+ { mfpDefaultByColumn = HM.empty+ , mfpOtherwise = Nothing+ }++-- | Options that controls how data is encoded. These options can be+-- used to e.g. encode data in a tab-separated format instead of in a+-- comma-separated format.+--+-- To avoid having your program stop compiling when new fields are+-- added to 'EncodeOptions', create option records by overriding+-- values in 'defaultEncodeOptions'. Example:+--+-- > myOptions = defaultEncodeOptions {+-- > encDelimiter = fromIntegral (ord '\t')+-- > }+--+-- /N.B./ The 'encDelimiter' must /not/ be the quote character (i.e.+-- @\"@) or one of the record separator characters (i.e. @\\n@ or+-- @\\r@).+data EncodeOptions = EncodeOptions+ { -- | Field delimiter.+ encDelimiter :: {-# UNPACK #-} !Word8++ -- | Record separator selection. @True@ for CRLF (@\\r\\n@) and+ -- @False@ for LF (@\\n@).+ , encUseCrLf :: !Bool++ -- | Include a header row when encoding @ToNamedRecord@+ -- instances.+ , encIncludeHeader :: !Bool++ -- | What kind of quoting should be applied to text fields.+ , encQuoting :: !Quoting++ -- | How to encode missing fields.+ , encMissingFieldPolicy :: MissingFieldPolicy+ } deriving (Eq, Show)++-- | Encoding options for CSV files.+defaultEncodeOptions :: EncodeOptions+defaultEncodeOptions = EncodeOptions+ { encDelimiter = comma+ , encUseCrLf = True+ , encIncludeHeader = True+ , encQuoting = QuoteMinimal+ , encMissingFieldPolicy = defaultMissingFieldPolicy+ }++-- | Like 'encode', but lets you customize how the CSV data is+-- encoded.+encodeWith :: ToRecord a => EncodeOptions -> [a] -> L.ByteString+encodeWith opts+ | validDelim (encDelimiter opts) =+ toLazyByteString+ . unlines (recordSep (encUseCrLf opts))+ . map (encodeRecord (encQuoting opts) (encDelimiter opts)+ . toRecord)+ | otherwise = encodeOptionsError+{-# INLINE encodeWith #-}++-- | Check if the delimiter is valid.+validDelim :: Word8 -> Bool+validDelim delim = delim /= cr && delim /= newline && delim /= doubleQuote++-- | Raises an exception indicating that the provided delimiter isn't+-- valid. See 'validDelim'.+--+-- Keep this message consistent with the documentation of+-- 'EncodeOptions'.+encodeOptionsError :: a+encodeOptionsError = error $ "Data.Csv: " +++ "The 'encDelimiter' must /not/ be the quote character (i.e. " +++ "\") or one of the record separator characters (i.e. \\n or " +++ "\\r)"++-- | Encode a single record, without the trailing record separator+-- (i.e. newline).+encodeRecord :: Quoting -> Word8 -> Record -> Builder+encodeRecord qtng delim rec' =+ case V.uncons rec' of+ Nothing -> mempty+ Just (x, xs) -> escape qtng delim x <>+ V.foldl' (\acc b -> acc <> d <> escape qtng delim b) mempty xs+ where+ d = word8 delim+{-# INLINE encodeRecord #-}++-- | Encode a single named record, without the trailing record+-- separator (i.e. newline), using the given field order.+encodeNamedRecord :: Header -> Quoting -> Word8 -> MissingFieldPolicy -> NamedRecord -> Builder+encodeNamedRecord hdr qtng delim missingFieldPolicy =+ encodeRecord qtng delim . namedRecordToRecord missingFieldPolicy hdr++escape :: Quoting -> Word8 -> B.ByteString -> Builder+escape !qtng !delim !s+ | qtng == QuoteAll = buildQuoted+ | qtng == QuoteMinimal && needsQuoting = buildQuoted+ | otherwise = byteString s+ where+ needsQuoting = B.any (\b -> b == doubleQuote || b == delim || b == newline || b == cr) s++ dquote :: P.BoundedPrim Word8+ dquote =+ P.liftFixedToBounded $ const (doubleQuote, doubleQuote) P.>$< (P.word8 P.>*< P.word8)++ escaper :: P.BoundedPrim Word8+ escaper = P.condB (== doubleQuote)+ dquote+ (P.liftFixedToBounded P.word8)++ buildQuoted =+ word8 doubleQuote <>+ P.primMapByteStringBounded escaper s <>+ word8 doubleQuote++-- | Like 'encodeByName', but lets you customize how the CSV data is+-- encoded.+encodeByNameWith :: ToNamedRecord a => EncodeOptions -> Header -> [a]+ -> L.ByteString+encodeByNameWith opts hdr v+ | validDelim (encDelimiter opts) =+ toLazyByteString (rows (encIncludeHeader opts))+ | otherwise = encodeOptionsError+ where+ 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) (encMissingFieldPolicy 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) (encMissingFieldPolicy opts)+ . toNamedRecord)+ $ v+{-# INLINE encodeDefaultOrderedByNameWith #-}++namedRecordToRecord :: MissingFieldPolicy -> Header -> NamedRecord -> Record+namedRecordToRecord missingFieldPolicy hdr nr = V.map find hdr+ where+ find n = fromMaybe (fallbackError n) $ asum+ [ HM.lookup n nr+ , HM.lookup n $ mfpDefaultByColumn missingFieldPolicy+ , mfpOtherwise missingFieldPolicy+ ]++ fallbackError n = moduleError "namedRecordToRecord" $+ "header contains name " ++ show (B8.unpack n) +++ " which is not present in the named record"++moduleError :: String -> String -> a+moduleError func msg = error $ "Data.Csv.Encoding." ++ func ++ ": " ++ msg+{-# NOINLINE moduleError #-}++recordSep :: Bool -> Builder+recordSep False = word8 10 -- new line (\n)+recordSep True = string8 "\r\n"++unlines :: Builder -> [Builder] -> Builder+unlines _ [] = mempty+unlines sep (b:bs) = b <> sep <> unlines sep bs++decodeWithP' :: AL.Parser a -> L.ByteString -> Either String a+decodeWithP' p s =+ case AL.parse p s of+ AL.Done _ v -> Right v+ AL.Fail left _ msg -> Left errMsg+ where+ errMsg = "parse error (" ++ msg ++ ") at " +++ (if BL8.length left > 100+ then take 100 (BL8.unpack left) ++ " (truncated)"+ else show (BL8.unpack left))+{-# INLINE decodeWithP' #-}++-- These alternative implementation of the 'csv' and 'csvWithHeader'+-- parsers from the 'Parser' module performs the+-- 'FromRecord'/'FromNamedRecord' conversions on-the-fly, thereby+-- avoiding the need to hold a big 'CSV' value in memory. The 'CSV'+-- type has a quite large memory overhead due to high constant+-- overheads of 'B.ByteString' and 'V.Vector'.++-- TODO: Check that the error messages don't duplicate prefixes, as in+-- "parse error: conversion error: ...".++-- | Parse a CSV file that does not include a header.+csv :: (Record -> Conversion.Parser a) -> DecodeOptions+ -> AL.Parser (V.Vector a)+csv _parseRecord !opts = do+ vals <- records+ return $! V.fromList vals+ where+ records = do+ !r <- record (decDelimiter opts)+ if blankLine r+ then (endOfInput $> []) <|> (endOfLine *> records)+ else case runParser (_parseRecord r) of+ Left msg -> fail $ "conversion error: " ++ msg+ Right val -> do+ !vals <- (endOfInput $> []) <|> (endOfLine *> records)+ return (val : vals)+{-# INLINE csv #-}++-- | Parse a CSV file that includes a header.+csvWithHeader :: (NamedRecord -> Conversion.Parser a) -> DecodeOptions+ -> AL.Parser (Header, V.Vector a)+csvWithHeader _parseNamedRecord !opts = do+ !hdr <- header (decDelimiter opts)+ vals <- records hdr+ let !v = V.fromList vals+ return (hdr, v)+ where+ records hdr = do+ !r <- record (decDelimiter opts)+ if blankLine r+ then (endOfInput $> []) <|> (endOfLine *> records hdr)+ else case runParser (convert hdr r) of+ Left msg -> fail $ "conversion error: " ++ msg+ Right val -> do+ !vals <- (endOfInput $> []) <|> (endOfLine *> records hdr)+ return (val : vals)++ convert hdr = _parseNamedRecord . Types.toNamedRecord hdr
+ src/Data/Csv/Incremental.hs view
@@ -0,0 +1,459 @@+{-# LANGUAGE BangPatterns, CPP, DeriveFunctor, ScopedTypeVariables #-}+{-# LANGUAGE RoleAnnotations, KindSignatures #-}++-- | This module allows for incremental decoding and encoding of CSV+-- data. This is useful if you e.g. want to interleave I\/O with+-- 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+ HeaderParser(..)+ , decodeHeader+ , decodeHeaderWith++ -- $typeconversion+ , Parser(..)++ -- ** Index-based record conversion+ -- $indexbased+ , HasHeader(..)+ , decode+ , decodeWith+ , decodeWithP++ -- ** Name-based record conversion+ -- $namebased+ , decodeByName+ , decodeByNameWith+ , decodeByNameWithP++ -- * Encoding+ -- ** Index-based record conversion+ -- $indexbased+ , encode+ , encodeWith+ , encodeRecord+ , Builder++ -- ** Name-based record conversion+ -- $namebased+ , encodeByName+ , encodeDefaultOrderedByName+ , encodeByNameWith+ , encodeDefaultOrderedByNameWith+ , encodeNamedRecord+ , NamedBuilder+ ) where++import Data.Kind (Type)+import Control.Applicative ((<|>))+import qualified Data.Attoparsec.ByteString as A+import Data.Attoparsec.ByteString.Char8 (endOfInput)+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as Builder+import qualified Data.ByteString.Lazy as L+import Data.Semigroup as Semi (Semigroup, (<>))+import qualified Data.Vector as V+import Data.Word (Word8)++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(..), MissingFieldPolicy(..), recordSep)+import Data.Csv.Parser+import Data.Csv.Types+import Data.Csv.Util (endOfLine)++-- $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++-- | Parse a CSV header in an incremental fashion. When done, the+-- 'HeaderParser' returns any unconsumed input in the second field of+-- the 'DoneH' constructor.+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 parsed and converted zero or more records. Any+ -- records that failed type conversion are returned as @'Left'+ -- errMsg@ and the rest as @'Right' val@. Feed a 'B.ByteString'+ -- to the continuation to continue parsing. Use an 'B.empty'+ -- string to indicate that no more input data is available. If+ -- fed an 'B.empty' string, the continuation is guaranteed to+ -- return either 'Fail' or 'Done'.+ | Many [Either String a] (B.ByteString -> Parser a)++ -- | The parser parsed and converted some records. Any records+ -- that failed type conversion are returned as @'Left' errMsg@+ -- 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 d (Many rs _) = showParen (d > appPrec) showStr+ where+ showStr = showString "Many " . showsPrec (appPrec+1) rs .+ showString " <function>"+ showsPrec d (Done rs) = showParen (d > appPrec) showStr+ where+ showStr = showString "Done " . showsPrec (appPrec+1) rs++-- | Have we read all available input?+data More = Incomplete | Complete+ deriving (Eq, Show)++-- | Efficiently deserialize CSV in an incremental fashion. Equivalent+-- to @'decodeWith' 'defaultDecodeOptions'@.+decode :: FromRecord a+ => HasHeader -- ^ 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+ -> HasHeader -- ^ Data contains header that should be+ -- skipped+ -> Parser a+decodeWith !opts hasHeader = decodeWithP parseRecord opts hasHeader++-- | Like 'decodeWith', but lets you pass an explicit parser value instead of+-- using a typeclass+--+-- @since 0.5.2.0+decodeWithP :: (Record -> Conversion.Parser a)+ -> DecodeOptions -- ^ Decoding options+ -> HasHeader -- ^ Data contains header that should be+ -- skipped+ -> Parser a+decodeWithP p !opts hasHeader = case hasHeader of+ HasHeader -> go (decodeHeaderWith opts)+ NoHeader -> Many [] $ \ s -> decodeWithP' p opts s+ where go (FailH rest msg) = Fail rest msg+ go (PartialH k) = Many [] $ \ s' -> go (k s')+ go (DoneH _ rest) = decodeWithP' p opts rest++------------------------------------------------------------------------++-- | Efficiently deserialize CSV in an incremental fashion. The data+-- is assumed to be preceded 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 = decodeByNameWithP parseNamedRecord opts++-- | Like 'decodeByNameWith', but lets you pass an explicit parser value instead+-- of using a typeclass+--+-- @since 0.5.2.0+decodeByNameWithP :: (NamedRecord -> Conversion.Parser a)+ -> DecodeOptions -- ^ Decoding options+ -> HeaderParser (Parser a)+decodeByNameWithP p !opts = go (decodeHeaderWith opts)+ where+ go (FailH rest msg) = FailH rest msg+ go (PartialH k) = PartialH $ \ s -> go (k s)+ go (DoneH hdr rest) =+ DoneH hdr (decodeWithP' (p . toNamedRecord hdr) opts rest)++------------------------------------------------------------------------++-- TODO: 'decodeWithP' should probably not take an initial+-- 'B.ByteString' input.++-- | Like 'decode', but lets you customize how the CSV data is parsed.+decodeWithP' :: (Record -> Conversion.Parser a) -> DecodeOptions -> B.ByteString+ -> Parser a+decodeWithP' p !opts = go Incomplete [] . parser+ where+ go !_ !acc (A.Fail rest _ msg)+ | null acc = Fail rest err+ | otherwise = Many (reverse acc) (\ s -> Fail (rest `B.append` s) err)+ where err = "parse error (" ++ msg ++ ")"+ go Incomplete acc (A.Partial k) = Many (reverse acc) cont+ where cont s = go m [] (k s)+ where m | B.null s = Complete+ | otherwise = Incomplete+ 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 -> Many (reverse acc') (cont [])+ | otherwise = go m acc' (parser rest)+ where cont acc'' s+ | B.null s = Done (reverse acc'')+ | otherwise = go Incomplete acc'' (parser s)+ acc' | blankLine r = acc+ | otherwise = let !r' = convert r in r' : acc++ parser = A.parse (record (decDelimiter opts) <* (endOfLine <|> endOfInput))+ convert = runParser . p+{-# INLINE decodeWithP' #-}++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.+type role Builder nominal+newtype Builder (a :: Type) = Builder {+ runBuilder :: Quoting -> Word8 -> Bool -> Builder.Builder+ }++-- | @since 0.5.0.0+instance Semi.Semigroup (Builder a) where+ Builder f <> Builder g =+ Builder $ \ qtng delim useCrlf ->+ f qtng delim useCrlf <> g qtng delim useCrlf++instance Monoid (Builder a) where+ mempty = Builder (\ _ _ _ -> mempty)+ mappend = (Semi.<>)++------------------------------------------------------------------------+-- ** 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.headerOrder' 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 $+ encHdr <>+ runNamedBuilder b hdr (encQuoting opts) (encDelimiter opts)+ (encMissingFieldPolicy opts) (encUseCrLf opts)+ where+ encHdr+ | encIncludeHeader opts =+ Encoding.encodeRecord (encQuoting opts) (encDelimiter opts) hdr+ <> recordSep (encUseCrLf opts)+ | otherwise = mempty++-- | 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 $+ encHdr <>+ runNamedBuilder b hdr (encQuoting opts)+ (encDelimiter opts) (encMissingFieldPolicy opts) (encUseCrLf opts)+ where+ hdr = Conversion.headerOrder (undefined :: a)++ encHdr+ | encIncludeHeader opts =+ Encoding.encodeRecord (encQuoting opts) (encDelimiter opts) hdr+ <> recordSep (encUseCrLf opts)+ | otherwise = mempty++-- | Encode a single named record.+encodeNamedRecord :: ToNamedRecord a => a -> NamedBuilder a+encodeNamedRecord nr = NamedBuilder $ \ hdr qtng delim missingFieldPolicy useCrLf ->+ Encoding.encodeNamedRecord hdr qtng delim missingFieldPolicy+ (Conversion.toNamedRecord nr) <> recordSep useCrLf++-- | A builder for building the CSV data incrementally. Just like the+-- @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.+type role NamedBuilder nominal+newtype NamedBuilder (a :: Type) = NamedBuilder {+ runNamedBuilder :: Header -> Quoting -> Word8 -> MissingFieldPolicy -> Bool -> Builder.Builder+ }++-- | @since 0.5.0.0+instance Semigroup (NamedBuilder a) where+ NamedBuilder f <> NamedBuilder g =+ NamedBuilder $ \ hdr qtng delim missing useCrlf ->+ f hdr qtng delim missing useCrlf <> g hdr qtng delim missing useCrlf++instance Monoid (NamedBuilder a) where+ mempty = NamedBuilder (\ _ _ _ _ -> mempty)+ mappend = (Semi.<>)++------------------------------------------------------------------------++moduleError :: String -> String -> a+moduleError func msg = error $ "Data.Csv.Incremental." ++ func ++ ": " ++ msg+{-# NOINLINE moduleError #-}
+ src/Data/Csv/Parser.hs view
@@ -0,0 +1,189 @@+{-# LANGUAGE BangPatterns, CPP #-}++-- | A CSV parser. The parser defined here is RFC 4180 compliant, with+-- the following extensions:+--+-- * Empty lines are ignored.+--+-- * Non-escaped fields may contain any characters except+-- double-quotes, commas, carriage returns, and newlines.+--+-- * Escaped fields may contain any characters (but double-quotes+-- need to be escaped).+--+-- The functions in this module can be used to implement e.g. a+-- resumable parser that is fed input incrementally.+module Data.Csv.Parser+ ( DecodeOptions(..)+ , defaultDecodeOptions+ , csv+ , csvWithHeader+ , header+ , record+ , name+ , field+ ) where++import Data.ByteString.Builder (byteString, toLazyByteString, charUtf8)+import Control.Applicative (optional)+import Data.Attoparsec.ByteString.Char8 (char, endOfInput)+import qualified Data.Attoparsec.ByteString as A+import qualified Data.Attoparsec.Lazy as AL+import qualified Data.Attoparsec.Zepto as Z+import qualified Data.ByteString as S+import qualified Data.ByteString.Unsafe as S+import qualified Data.Vector as V+import Data.Word (Word8)++import Data.Csv.Types+import Data.Csv.Util ((<$!>), blankLine, endOfLine, liftM2', cr, comma, newline, doubleQuote, toStrict)++-- | Options that controls how data is decoded. These options can be+-- used to e.g. decode tab-separated data instead of comma-separated+-- data.+--+-- To avoid having your program stop compiling when new fields are+-- added to 'DecodeOptions', create option records by overriding+-- values in 'defaultDecodeOptions'. Example:+--+-- > myOptions = defaultDecodeOptions {+-- > decDelimiter = fromIntegral (ord '\t')+-- > }+data DecodeOptions = DecodeOptions+ { -- | Field delimiter.+ decDelimiter :: {-# UNPACK #-} !Word8+ } deriving (Eq, Show)++-- | Decoding options for parsing CSV files.+defaultDecodeOptions :: DecodeOptions+defaultDecodeOptions = DecodeOptions+ { decDelimiter = comma+ }++-- | Parse a CSV file that does not include a header.+csv :: DecodeOptions -> AL.Parser Csv+csv !opts = do+ vals <- sepByEndOfLine1' (record (decDelimiter opts))+ _ <- optional endOfLine+ endOfInput+ let nonEmpty = removeBlankLines vals+ return $! V.fromList nonEmpty+{-# INLINE csv #-}++-- | Specialized version of 'sepBy1'' which is faster due to not+-- accepting an arbitrary separator.+sepByDelim1' :: AL.Parser a+ -> Word8 -- ^ Field delimiter+ -> AL.Parser [a]+sepByDelim1' p !delim = liftM2' (:) p loop+ where+ loop = do+ mb <- A.peekWord8+ case mb of+ Just b | b == delim -> liftM2' (:) (A.anyWord8 *> p) loop+ _ -> pure []+{-# INLINE sepByDelim1' #-}++-- | Specialized version of 'sepBy1'' which is faster due to not+-- accepting an arbitrary separator.+sepByEndOfLine1' :: AL.Parser a+ -> AL.Parser [a]+sepByEndOfLine1' p = liftM2' (:) p loop+ where+ loop = do+ mb <- A.peekWord8+ case mb of+ Just b | b == cr ->+ liftM2' (:) (A.anyWord8 *> A.word8 newline *> p) loop+ | b == newline ->+ liftM2' (:) (A.anyWord8 *> p) loop+ _ -> pure []+{-# INLINE sepByEndOfLine1' #-}++-- | Parse a CSV file that includes a header.+csvWithHeader :: DecodeOptions -> AL.Parser (Header, V.Vector NamedRecord)+csvWithHeader !opts = do+ !hdr <- header (decDelimiter opts)+ vals <- map (toNamedRecord hdr) . removeBlankLines <$>+ sepByEndOfLine1' (record (decDelimiter opts))+ _ <- optional endOfLine+ endOfInput+ let !v = V.fromList vals+ return (hdr, v)++-- | Parse a header, including the terminating line separator.+header :: Word8 -- ^ Field delimiter+ -> AL.Parser Header+header !delim = V.fromList <$!> name delim `sepByDelim1'` delim <* endOfLine++-- | Parse a header name. Header names have the same format as regular+-- 'field's.+name :: Word8 -> AL.Parser Name+name !delim = field delim++removeBlankLines :: [Record] -> [Record]+removeBlankLines = filter (not . blankLine)++-- | Parse a record, not including the terminating line separator. The+-- terminating line separate is not included as the last record in a+-- CSV file is allowed to not have a terminating line separator. You+-- most likely want to use the 'endOfLine' parser in combination with+-- this parser.+record :: Word8 -- ^ Field delimiter+ -> AL.Parser Record+record !delim = V.fromList <$!> field delim `sepByDelim1'` delim+{-# INLINE record #-}++-- | Parse a field. The field may be in either the escaped or+-- non-escaped format. The return value is unescaped.+field :: Word8 -> AL.Parser Field+field !delim = do+ mb <- A.peekWord8+ -- We purposely don't use <|> as we want to commit to the first+ -- choice if we see a double quote.+ case mb of+ Just b | b == doubleQuote -> escapedField+ _ -> unescapedField delim+{-# INLINE field #-}++escapedField :: AL.Parser S.ByteString+escapedField = do+ _ <- dquote+ -- The scan state is 'True' if the previous character was a double quote.+ s' <- A.scan False $ \s c -> if c == doubleQuote+ then Just (not s)+ else if s then Nothing+ else Just False+ -- We need to drop a trailing double quote left by scan.+ if S.null s'+ then fail "trailing double quote"+ else let s = S.init s'+ in if doubleQuote `S.elem` s+ then case Z.parse unescape s of+ Right r -> return r+ Left err -> fail err+ else return s++unescapedField :: Word8 -> AL.Parser S.ByteString+unescapedField !delim = A.takeWhile (\ c -> c /= doubleQuote &&+ c /= newline &&+ c /= delim &&+ c /= cr)++dquote :: AL.Parser Char+dquote = char '"'++unescape :: Z.Parser S.ByteString+unescape = (toStrict . toLazyByteString) <$!> go mempty where+ go acc = do+ h <- Z.takeWhile (/= doubleQuote)+ let rest = do+ start <- Z.take 2+ if S.unsafeHead start == doubleQuote &&+ S.unsafeIndex start 1 == doubleQuote+ then go (acc `mappend` byteString h `mappend` charUtf8 '"')+ else fail "invalid CSV escape sequence"+ done <- Z.atEnd+ if done+ then return (acc `mappend` byteString h)+ else rest
+ src/Data/Csv/Streaming.hs view
@@ -0,0 +1,198 @@+{-# 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+ (+ -- * Usage example+ -- $example++ -- * Stream representation+ -- $stream-representation+ Records(..)++ -- * Decoding records+ -- $typeconversion++ -- ** Index-based record conversion+ -- $indexbased+ , HasHeader(..)+ , decode+ , decodeWith+ , decodeWithP++ -- ** Name-based record conversion+ -- $namebased+ , decodeByName+ , decodeByNameWith+ , decodeByNameWithP+ ) where++import Control.DeepSeq (NFData(rnf))+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 Prelude hiding (foldr)++import Data.Csv.Conversion+import qualified Data.Csv.Conversion as Conversion+import Data.Csv.Incremental hiding (decode, decodeByName, decodeByNameWith,+ decodeByNameWithP, decodeWith, decodeWithP)+import qualified Data.Csv.Incremental as I+import Data.Csv.Parser+import Data.Csv.Types++-- $example+--+-- A short usage example:+--+-- > for_ (decode NoHeader "John,27\r\nJane,28\r\n") $ \ (name, age :: Int) ->+-- > putStrLn $ name ++ " is " ++ show age ++ " years old"+--+-- N.B. The 'Foldable' instance, which is used above, skips records+-- that failed to convert. If you don't want this behavior, work+-- directly with the 'Cons' and 'Nil' constructors.++-- $stream-representation+--+-- A stream of records is represented as a (lazy) list that may+-- contain errors.++-- $typeconversion+--+-- Just like in the case of non-streaming decoding, there are two ways+-- to convert CSV records to and from and user-defined data types:+-- index-based conversion and name-based conversion.++-- $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.++-- | 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)++-- | Skips records that failed to convert.+instance Foldable Records where+ foldr = foldrRecords+ foldl' = foldlRecords'++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 (Cons (Left _) rs) = go z rs+ go z _ = z+{-# INLINE foldrRecords #-}++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 (Cons (Left _) rs) = go z rs+ go z _ = z+{-# INLINE foldlRecords' #-}++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++instance NFData a => NFData (Records a) where+ rnf (Cons r rs) = rnf r `seq` rnf rs+ rnf (Nil errMsg rest) = rnf errMsg `seq` rnf rest++-- | Efficiently deserialize CSV records in a streaming fashion.+-- Equivalent to @'decodeWith' 'defaultDecodeOptions'@.+decode :: FromRecord a+ => HasHeader -- ^ 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+ -> HasHeader -- ^ Data contains header that should be+ -- skipped+ -> BL.ByteString -- ^ CSV data+ -> Records a+decodeWith = decodeWithP parseRecord++-- | Like 'decodeWith', but lets you specify a parser function.+--+-- @since 0.5.4.0+decodeWithP :: (Record -> Conversion.Parser a)+ -> DecodeOptions -- ^ Decoding options+ -> HasHeader -- ^ Data contains header that should be+ -- skipped+ -> BL.ByteString -- ^ CSV data+ -> Records a+decodeWithP _parseRecord !opts hasHeader s0 =+ go (BL.toChunks s0) (I.decodeWithP _parseRecord opts hasHeader)+ where+ go ss (Done xs) = foldr Cons (Nil Nothing (BL.fromChunks ss)) xs+ go ss (Fail rest err) = Nil (Just err) (BL.fromChunks (rest:ss))+ go [] (Many xs k) = foldr Cons (go [] (k B.empty)) xs+ go (s:ss) (Many xs k) = foldr Cons (go ss (k s)) xs++-- | Efficiently deserialize CSV in a streaming fashion. The data is+-- assumed to be preceded 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 = decodeByNameWithP parseNamedRecord++-- | Like 'decodeByNameWith', but lets you specify a parser function.+--+-- @since 0.5.4.0+decodeByNameWithP :: (NamedRecord -> Conversion.Parser a)+ -- ^ Custom parser function+ -> DecodeOptions -- ^ Decoding options+ -> BL.ByteString -- ^ CSV data+ -> Either String (Header, Records a)+decodeByNameWithP _parseNamedRecord !opts s0 =+ go (BL.toChunks s0) (I.decodeByNameWithP _parseNamedRecord opts)+ where+ go ss (DoneH hdr p) = Right (hdr, go2 ss p)+ go ss (FailH rest err) = Left $ err ++ " at " +++ 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 [] (Many xs k) = foldr Cons (go2 [] (k B.empty)) xs+ go2 (s:ss) (Many xs k) = foldr Cons (go2 ss (k s)) xs
+ src/Data/Csv/Types.hs view
@@ -0,0 +1,50 @@+module Data.Csv.Types+ (+ -- * Core CSV types+ Csv+ , Record+ , Header+ , Name+ , NamedRecord+ , Field+ , toNamedRecord++ -- * Header handling+ , HasHeader(..)+ ) where++import qualified Data.ByteString as S+import qualified Data.HashMap.Strict as HM+import Data.Vector (Vector)+import qualified Data.Vector as V++-- | CSV data represented as a Haskell vector of vector of+-- bytestrings.+type Csv = Vector Record++-- | A record corresponds to a single line in a CSV file.+type Record = Vector Field++-- | The header corresponds to the first line a CSV file. Not all CSV+-- files have a header.+type Header = Vector Name++-- | A header has one or more names, describing the data in the column+-- following the name.+type Name = S.ByteString++-- | A record corresponds to a single line in a CSV file, indexed by+-- the column name rather than the column index.+type NamedRecord = HM.HashMap S.ByteString S.ByteString++-- | A single field within a record.+type Field = S.ByteString++-- | Convert a 'Record' to a 'NamedRecord' by attaching column names.+-- The 'Header' and 'Record' must be of the same length.+toNamedRecord :: Header -> Record -> NamedRecord+toNamedRecord hdr v = HM.fromList . V.toList $ V.zip hdr v++-- | Is the CSV data preceded by a header?+data HasHeader = HasHeader -- ^ The CSV data is preceded by a header+ | NoHeader -- ^ The CSV data is not preceded by a header
+ src/Data/Csv/Util.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE BangPatterns, CPP, OverloadedStrings #-}++module Data.Csv.Util+ ( (<$!>)+ , blankLine+ , liftM2'+ , endOfLine+ , doubleQuote+ , newline+ , cr+ , comma+ , toStrict+ ) where++import Control.Applicative ((<|>))+import Data.Functor ( ($>) )+import Data.Word (Word8)+import Data.Attoparsec.ByteString.Char8 (string)+import qualified Data.Attoparsec.ByteString as A+import qualified Data.ByteString as B+import qualified Data.Vector as V+import Data.Attoparsec.ByteString (Parser)+import Data.ByteString.Lazy (toStrict)++-- | 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 <$!>++-- | Is this an empty record (i.e. a blank line)?+blankLine :: V.Vector B.ByteString -> Bool+blankLine v = V.length v == 1 && B.null (V.head v)++-- | A version of 'liftM2' that is strict in the result of its first+-- action.+liftM2' :: (Monad m) => (a -> b -> c) -> m a -> m b -> m c+liftM2' f a b = do+ !x <- a+ f x <$> b+{-# INLINE liftM2' #-}+++-- | Match either a single newline character @\'\\n\'@, or a carriage+-- return followed by a newline character @\"\\r\\n\"@, or a single+-- carriage return @\'\\r\'@.+endOfLine :: Parser ()+endOfLine = (A.word8 newline $> ()) <|> (string "\r\n" $> ()) <|> (A.word8 cr $> ())+{-# INLINE endOfLine #-}++doubleQuote, newline, cr, comma :: Word8+doubleQuote = 34+newline = 10+cr = 13+comma = 44
tests/UnitTests.hs view
@@ -1,15 +1,12 @@-{-# LANGUAGE CPP, DeriveGeneric, OverloadedStrings, ScopedTypeVariables #-}+{-# LANGUAGE CPP, DataKinds, DeriveGeneric, OverloadedStrings, ScopedTypeVariables #-} -#if __GLASGOW_HASKELL__ >= 801 {-# OPTIONS_GHC -Wno-orphans -Wno-unused-top-binds #-}-#else-{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-binds #-}-#endif module Main ( main ) where +import Control.Applicative (Const) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BL8@@ -20,6 +17,7 @@ import qualified Data.Text.Lazy as LT import qualified Data.Vector as V import qualified Data.Foldable as F+import Data.List (isPrefixOf) import Data.Word import Numeric.Natural import GHC.Generics (Generic)@@ -33,10 +31,6 @@ import Data.Csv hiding (record) import qualified Data.Csv.Streaming as S -#if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>), (<*>))-#endif- ------------------------------------------------------------------------ -- Parse tests @@ -55,6 +49,14 @@ " input: " ++ show (BL8.unpack input) ++ "\n" ++ "parse error: " ++ err +decodeFailsWith :: BL.ByteString -> String -> Assertion+decodeFailsWith input expected = case decode NoHeader input of+ Right r -> assertFailure $ "input: " ++ show (BL8.unpack input) ++ "\n" +++ "retuned: " ++ show (r :: (V.Vector (V.Vector B.ByteString))) ++ "\n" +++ "whereas should have failed with " <> expected+ Left err -> assertBool ("got " <> err <> "\ninstead of " <> expected)+ $ ("parse error ("++expected++")") `isPrefixOf` err+ encodesAs :: [[B.ByteString]] -> BL.ByteString -> Assertion encodesAs input expected = encode (map V.fromList input) @?= expected@@ -165,6 +167,11 @@ [ testGroup "decode" $ map streamingDecodeTest decodeTests , testGroup "decodeWith" $ map streamingDecodeWithTest decodeWithTests ]+ , testGroup "failing"+ [ testCase "escapedMalformed0" $+ "baz,\"" `decodeFailsWith` "Failed reading: trailing double quote"+ ]+ ] where rfc4180Input = BL8.pack $@@ -185,6 +192,10 @@ [["a", "b", "c"], ["d", "e", "f"]]) , ("leadingSpace", " a, b, c\n", [[" a", " b", " c"]]) , ("rfc4180", rfc4180Input, rfc4180Output)+ , ("escapedDoubleQuotes"+ , "\"x,y\",z\nbaz,\"bar\nfoo,\""+ , [["x,y", "z"], ["baz", "bar\nfoo,"]]+ ) ] decodeWithTests = [ ("tab-delim", defDec { decDelimiter = 9 }, "1\t2", [["1", "2"]])@@ -303,6 +314,8 @@ (roundTrip :: BL.ByteString -> Bool) , testProperty "Text" (roundTrip :: T.Text -> Bool) , testProperty "lazy Text" (roundTrip :: LT.Text -> Bool)+ -- Using DataKinds here to prove that our Const instance is polykinded.+ , testProperty "Const Char" (roundTrip :: Const Char "" -> Bool) ] , testGroup "boundary" [ testProperty "Int" (boundary (undefined :: Int))@@ -370,9 +383,34 @@ cr = 13 dquote = 34 +customMissing :: Assertion+customMissing = encodeByNameWith encOpts hdr nrs @?= ex+ where+ encOpts = defaultEncodeOptions+ { encMissingFieldPolicy = defaultMissingFieldPolicy+ { mfpDefaultByColumn = HM.fromList+ [ ("abc", "abc default")+ , ("def", "def default")+ , ("jkl", "ghi default")+ ]+ , mfpOtherwise = Just "fallback"+ }+ }+ hdr = V.fromList ["abc", "def", "ghi"]+ nrs :: [NamedRecord]+ nrs =+ [ HM.fromList [("abc", "123")]+ , HM.fromList [("def", "456")]+ , HM.fromList [("abc", "234"), ("def", "567")]+ , HM.fromList [("abc", "234"), ("def", "567"), ("ghi", "890")]+ , HM.fromList []+ ]+ ex = "abc,def,ghi\r\n123,def default,fallback\r\nabc default,456,fallback\r\n234,567,fallback\r\n234,567,890\r\nabc default,def default,fallback\r\n"+ customOptionsTests :: [TF.Test] customOptionsTests = [ testProperty "customDelim" customDelim+ , testCase "customMissing" customMissing ] ------------------------------------------------------------------------