cassava (empty) → 0.1.0.0
raw patch · 11 files changed
+1856/−0 lines, 11 filesdep +HUnitdep +QuickCheckdep +arraysetup-changed
Dependencies added: HUnit, QuickCheck, array, attoparsec, base, blaze-builder, bytestring, cassava, containers, criterion, test-framework, test-framework-hunit, test-framework-quickcheck2, text, unordered-containers, vector
Files
- Data/Csv.hs +127/−0
- Data/Csv/Conversion.hs +684/−0
- Data/Csv/Conversion/Internal.hs +283/−0
- Data/Csv/Encoding.hs +182/−0
- Data/Csv/Parser.hs +158/−0
- Data/Csv/Types.hs +36/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- benchmarks/Benchmarks.hs +83/−0
- cassava.cabal +75/−0
- tests/UnitTests.hs +196/−0
+ Data/Csv.hs view
@@ -0,0 +1,127 @@+-- | This module implements encoding and decoding of CSV data. The+-- implementation 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).+module Data.Csv+ (+ -- * Usage example+ -- $example++ -- * Encoding and decoding+ -- $encoding+ decode+ , decodeByName+ , encode+ , encodeByName++ -- ** Encoding and decoding options+ -- $options+ , DecodeOptions(..)+ , defaultDecodeOptions+ , decodeWith+ , decodeByNameWith+ , EncodeOptions(..)+ , defaultEncodeOptions+ , encodeWith+ , encodeByNameWith++ -- * Core CSV types+ , Csv+ , Record+ , Field+ , Header+ , Name+ , NamedRecord++ -- * Type conversion+ -- $typeconversion++ -- ** Index-based record conversion+ -- $indexbased+ , FromRecord(..)+ , Parser+ , (.!)+ , ToRecord(..)+ , record+ , Only(..)++ -- ** Name-based record conversion+ -- $namebased+ , FromNamedRecord(..)+ , (.:)+ , ToNamedRecord(..)+ , namedRecord+ , (.=)++ -- ** Field conversion+ , FromField(..)+ , ToField(..)+ ) where++import Data.Csv.Conversion+import Data.Csv.Encoding+import Data.Csv.Types++-- $example+--+-- A short encoding usage example:+--+-- @ >>> 'encode' $ fromList [(\"John\" :: Text, 27), (\"Jane\", 28)]+-- Chunk \"John,27\\r\\nJane,28\\r\\n\" Empty+-- @+--+-- Since string literals are overloaded we have to supply a type+-- signature as the compiler couldn't deduce which string type (i.e.+-- 'String' or 'Text') we want to use. In most cases type inference+-- will infer the type from the context and you can omit type+-- signatures.+--+-- A short decoding usage example:+--+-- @ >>> 'decode' \"John,27\\r\\nJane,28\\r\\n\" :: Either String (Vector (Text, Int))+-- Right (fromList [(\"John\",27),(\"Jane\",28)])+-- @++-- $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.
+ Data/Csv/Conversion.hs view
@@ -0,0 +1,684 @@+{-# LANGUAGE FlexibleInstances, OverloadedStrings, Rank2Types #-}+module Data.Csv.Conversion+ (+ -- * Type conversion+ Only(..)+ , FromRecord(..)+ , FromNamedRecord(..)+ , ToNamedRecord(..)+ , FromField(..)+ , ToRecord(..)+ , ToField(..)++ -- * Parser+ , Result(..)+ , Parser+ , parse++ -- * Accessors+ , (.!)+ , (.:)+ , (.=)+ , record+ , namedRecord+ ) where++import Control.Applicative+import Control.Monad+import Data.Attoparsec.Char8 (double, number, parseOnly)+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as L+import qualified Data.HashMap.Lazy as HM+import Data.Int+import qualified Data.Map as M+import Data.Monoid+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 Data.Traversable+import Data.Vector (Vector, (!))+import qualified Data.Vector as V+import Data.Word+import GHC.Float (double2Float)+import Prelude hiding (takeWhile)++import Data.Csv.Conversion.Internal+import Data.Csv.Types++------------------------------------------------------------------------+-- Type conversion++------------------------------------------------------------------------+-- Index-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:+--+-- > John,56+-- > Jane,55+--+-- here's an example type and instance:+--+-- @data Person = Person { name :: Text, age :: Int }+--+-- instance FromRecord Person where+-- parseRecord v+-- | 'V.length' v == 2 = Person '<$>'+-- v '.!' 0 '<*>'+-- v '.!' 1+-- | otherwise = mzero+-- @+class FromRecord a where+ parseRecord :: Record -> Parser a++-- | Haskell lacks a single-element tuple type, so if you CSV data+-- with just one column you can use the 'Only' type to represent a+-- single-column result.+newtype Only a = Only {+ fromOnly :: a+ } deriving (Eq, Ord, Read, Show)++-- | 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+ toRecord :: a -> Record++instance FromField a => FromRecord (Only a) where+ parseRecord v+ | n == 1 = Only <$> parseField (V.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 = (,) <$> parseField (V.unsafeIndex v 0)+ <*> parseField (V.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 = (,,) <$> parseField (V.unsafeIndex v 0)+ <*> parseField (V.unsafeIndex v 1)+ <*> parseField (V.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 = (,,,) <$> parseField (V.unsafeIndex v 0)+ <*> parseField (V.unsafeIndex v 1)+ <*> parseField (V.unsafeIndex v 2)+ <*> parseField (V.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 = (,,,,) <$> parseField (V.unsafeIndex v 0)+ <*> parseField (V.unsafeIndex v 1)+ <*> parseField (V.unsafeIndex v 2)+ <*> parseField (V.unsafeIndex v 3)+ <*> parseField (V.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 = (,,,,,) <$> parseField (V.unsafeIndex v 0)+ <*> parseField (V.unsafeIndex v 1)+ <*> parseField (V.unsafeIndex v 2)+ <*> parseField (V.unsafeIndex v 3)+ <*> parseField (V.unsafeIndex v 4)+ <*> parseField (V.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 = (,,,,,,) <$> parseField (V.unsafeIndex v 0)+ <*> parseField (V.unsafeIndex v 1)+ <*> parseField (V.unsafeIndex v 2)+ <*> parseField (V.unsafeIndex v 3)+ <*> parseField (V.unsafeIndex v 4)+ <*> parseField (V.unsafeIndex v 5)+ <*> parseField (V.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]++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++------------------------------------------------------------------------+-- 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 FromRecord 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++-- | 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+-- toNamedRecord (Person name age) = 'namedRecord' [+-- \"name\" '.=' name, \"age\" '.=' age]+-- @+class ToNamedRecord a where+ toNamedRecord :: a -> NamedRecord++instance FromField a => FromNamedRecord (M.Map B.ByteString a) where+ parseNamedRecord m = M.fromList <$>+ (traverse parseSnd $ HM.toList m)+ where parseSnd (name, s) = (,) <$> pure name <*> parseField s++instance ToField a => ToNamedRecord (M.Map B.ByteString a) where+ toNamedRecord = HM.fromList . map (\ (k, v) -> (k, toField v)) . M.toList++instance FromField a => FromNamedRecord (HM.HashMap B.ByteString a) where+ parseNamedRecord m = traverse (\ s -> parseField s) m++instance ToField a => ToNamedRecord (HM.HashMap B.ByteString a) where+ toNamedRecord = HM.map toField++------------------------------------------------------------------------+-- 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++instance FromField Char where+ parseField s+ | T.compareLength t 1 == EQ = pure (T.head t)+ | otherwise = typeError "Char" s Nothing+ where t = T.decodeUtf8 s+ {-# INLINE parseField #-}++instance ToField Char where+ toField = toField . T.encodeUtf8 . T.singleton+ {-# INLINE toField #-}++instance FromField Double where+ parseField = parseDouble+ {-# INLINE parseField #-}++instance ToField Double where+ toField = realFloat+ {-# INLINE toField #-}++instance FromField Float where+ parseField s = double2Float <$> parseDouble s+ {-# INLINE parseField #-}++instance ToField Float where+ toField = realFloat+ {-# INLINE toField #-}++parseDouble :: B.ByteString -> Parser Double+parseDouble s = case parseOnly double s of+ Left err -> typeError "Double" s (Just err)+ Right n -> pure n+{-# INLINE parseDouble #-}++instance FromField Int where+ parseField = parseIntegral "Int"+ {-# INLINE parseField #-}++instance ToField Int where+ toField = decimal+ {-# INLINE toField #-}++instance FromField Integer where+ parseField = parseIntegral "Integer"+ {-# INLINE parseField #-}++instance ToField Integer where+ toField = decimal+ {-# INLINE toField #-}++instance FromField Int8 where+ parseField = parseIntegral "Int8"+ {-# INLINE parseField #-}++instance ToField Int8 where+ toField = decimal+ {-# INLINE toField #-}++instance FromField Int16 where+ parseField = parseIntegral "Int16"+ {-# INLINE parseField #-}++instance ToField Int16 where+ toField = decimal+ {-# INLINE toField #-}++instance FromField Int32 where+ parseField = parseIntegral "Int32"+ {-# INLINE parseField #-}++instance ToField Int32 where+ toField = decimal+ {-# INLINE toField #-}++instance FromField Int64 where+ parseField = parseIntegral "Int64"+ {-# INLINE parseField #-}++instance ToField Int64 where+ toField = decimal+ {-# INLINE toField #-}++instance FromField Word where+ parseField = parseIntegral "Word"+ {-# INLINE parseField #-}++instance ToField Word where+ toField = decimal+ {-# INLINE toField #-}++instance FromField Word8 where+ parseField = parseIntegral "Word8"+ {-# INLINE parseField #-}++instance ToField Word8 where+ toField = decimal+ {-# INLINE toField #-}++instance FromField Word16 where+ parseField = parseIntegral "Word16"+ {-# INLINE parseField #-}++instance ToField Word16 where+ toField = decimal+ {-# INLINE toField #-}++instance FromField Word32 where+ parseField = parseIntegral "Word32"+ {-# INLINE parseField #-}++instance ToField Word32 where+ toField = decimal+ {-# INLINE toField #-}++instance FromField Word64 where+ parseField = parseIntegral "Word64"+ {-# INLINE parseField #-}++instance ToField Word64 where+ toField = decimal+ {-# INLINE toField #-}++-- TODO: Optimize+escape :: B.ByteString -> B.ByteString+escape s+ | B.find (\ b -> b == dquote || b == comma || b == nl || b == cr ||+ b == sp) s == Nothing = s+ | otherwise =+ B.concat ["\"",+ B.concatMap+ (\ b -> if b == dquote then "\"\"" else B.singleton b) s,+ "\""]+ where+ dquote = 34+ comma = 44+ nl = 10+ cr = 13+ sp = 32++instance FromField B.ByteString where+ parseField = pure+ {-# INLINE parseField #-}++instance ToField B.ByteString where+ toField = escape+ {-# INLINE toField #-}++instance FromField L.ByteString where+ parseField s = pure (L.fromChunks [s])+ {-# INLINE parseField #-}++instance ToField L.ByteString where+ toField = toField . B.concat . L.toChunks+ {-# INLINE toField #-}++-- | Assumes UTF-8 encoding.+instance FromField T.Text where+ parseField = pure . T.decodeUtf8+ {-# INLINE parseField #-}++-- | Uses UTF-8 encoding.+instance ToField T.Text where+ toField = toField . T.encodeUtf8+ {-# INLINE toField #-}++-- | Assumes UTF-8 encoding.+instance FromField LT.Text where+ parseField s = pure (LT.fromChunks [T.decodeUtf8 s])+ {-# INLINE parseField #-}++-- | Uses UTF-8 encoding.+instance ToField LT.Text where+ toField = toField . B.concat . L.toChunks . LT.encodeUtf8+ {-# INLINE toField #-}++-- | Assumes UTF-8 encoding.+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 #-}++parseIntegral :: Integral a => String -> B.ByteString -> Parser a+parseIntegral typ s = case parseOnly number s of+ Left err -> typeError typ s (Just err)+ Right n -> pure (floor n)+{-# INLINE parseIntegral #-}++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.+(.!) :: FromField a => Record -> Int -> Parser a+v .! idx = parseField (v ! idx)+{-# INLINE (.!) #-}++-- | 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.+(.:) :: FromField a => NamedRecord -> B.ByteString -> Parser a+m .: name = maybe (fail err) parseField $ HM.lookup name m+ where err = "no field named " ++ show (B8.unpack name)+{-# INLINE (.:) #-}++-- | Construct a pair from a name and a value. For use with+-- 'namedRecord'.+(.=) :: ToField a => B.ByteString -> a -> (B.ByteString, B.ByteString)+name .= val = (name, toField val)+{-# 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++------------------------------------------------------------------------+-- Parser for converting records to data types++-- | The result of running a 'Parser'.+data Result a = Error String+ | Success a+ deriving (Eq, Show)++instance Functor Result where+ fmap f (Success a) = Success (f a)+ fmap _ (Error err) = Error err+ {-# INLINE fmap #-}++instance Monad Result where+ return = Success+ {-# INLINE return #-}+ Success a >>= k = k a+ Error err >>= _ = Error err+ {-# INLINE (>>=) #-}++instance Applicative Result where+ pure = return+ {-# INLINE pure #-}+ (<*>) = ap+ {-# INLINE (<*>) #-}++instance MonadPlus Result where+ mzero = fail "mzero"+ {-# INLINE mzero #-}+ mplus a@(Success _) _ = a+ mplus _ b = b+ {-# INLINE mplus #-}++instance Alternative Result where+ empty = mzero+ {-# INLINE empty #-}+ (<|>) = mplus+ {-# INLINE (<|>) #-}++instance Monoid (Result a) where+ mempty = fail "mempty"+ {-# INLINE mempty #-}+ mappend = mplus+ {-# INLINE mappend #-}++-- | 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 {+ runParser :: forall f r.+ Failure f r+ -> Success a f r+ -> f r+ }++instance Monad Parser where+ m >>= g = Parser $ \kf ks -> let ks' a = runParser (g a) kf ks+ in runParser m kf ks'+ {-# INLINE (>>=) #-}+ return a = Parser $ \_kf ks -> ks a+ {-# INLINE return #-}+ 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 runParser m kf ks'+ {-# INLINE fmap #-}++instance Applicative Parser where+ pure = return+ {-# 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' _ = runParser b kf ks+ in runParser a kf' ks+ {-# INLINE mplus #-}++instance Monoid (Parser a) where+ mempty = fail "mempty"+ {-# INLINE mempty #-}+ mappend = mplus+ {-# INLINE mappend #-}++apP :: Parser (a -> b) -> Parser a -> Parser b+apP d e = do+ b <- d+ a <- e+ return (b a)+{-# INLINE apP #-}++-- | Run a 'Parser'.+parse :: Parser a -> Result a+parse p = runParser p Error Success+{-# INLINE parse #-}
+ Data/Csv/Conversion/Internal.hs view
@@ -0,0 +1,283 @@+module Data.Csv.Conversion.Internal+ ( decimal+ , realFloat+ ) where++import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char8+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.Word++------------------------------------------------------------------------+-- Integers++decimal :: Integral a => a -> B.ByteString+decimal = toByteString . formatDecimal+{-# INLINE decimal #-}++-- TODO: Add an optimized version for Integer.++formatDecimal :: Integral a => a -> Builder+{-# SPECIALIZE formatDecimal :: Int8 -> Builder #-}+{-# RULES "formatDecimal/Int" formatDecimal = formatBoundedSigned+ :: Int -> 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 #-}+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 = fromWord8 45++zero :: Word8+zero = 48++digit :: Integral a => a -> Builder+digit n = fromWord8 $! i2w (fromIntegral n)+{-# INLINE digit #-}++i2w :: Int -> Word8+i2w i = zero + fromIntegral i+{-# INLINE i2w #-}++------------------------------------------------------------------------+-- Floating point numbers++realFloat :: RealFloat a => a -> B.ByteString+{-# SPECIALIZE realFloat :: Float -> B.ByteString #-}+{-# SPECIALIZE realFloat :: Double -> B.ByteString #-}+realFloat = toByteString . 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 = fromString "NaN"+ | isInfinite x = if x < 0+ then fromString "-Infinity"+ else fromString "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] -> fromString "0.0e0"+ [d] -> fromWord8 d <> fromString ".0e" <> show_e'+ (d:ds') -> fromWord8 d <> fromChar '.' <> fromWord8s ds' <>+ fromChar 'e' <> show_e'+ [] -> error "formatRealFloat/doFmt/Exponent: []"+ Fixed+ | e <= 0 -> fromString "0." <>+ fromByteString (B.replicate (-e) zero) <>+ fromWord8s ds+ | otherwise ->+ let+ f 0 s rs = mk0 (reverse s) <> fromChar '.' <> 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 { [] -> fromWord8 zero ; _ -> fromWord8s 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)
+ Data/Csv/Encoding.hs view
@@ -0,0 +1,182 @@+{-# LANGUAGE BangPatterns, OverloadedStrings #-}++-- 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+ decode+ , decodeByName+ , encode+ , encodeByName++ -- ** Encoding and decoding options+ , DecodeOptions(..)+ , defaultDecodeOptions+ , decodeWith+ , decodeByNameWith+ , EncodeOptions(..)+ , defaultEncodeOptions+ , encodeWith+ , encodeByNameWith+ ) where++import Blaze.ByteString.Builder+import Blaze.ByteString.Builder.Char8+import Control.Applicative+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.Monoid+import Data.Traversable+import Data.Vector (Vector)+import qualified Data.Vector as V+import Data.Word (Word8)+import Prelude hiding (unlines)++import Data.Csv.Conversion+import Data.Csv.Parser+import Data.Csv.Types++-- 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 => L.ByteString -> 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+ -> Either String (Header, Vector a)+decodeByName = decodeByNameWith defaultDecodeOptions+{-# INLINE decodeByName #-}++-- | Efficiently serialize CVS records as a lazy 'L.ByteString'.+encode :: ToRecord a => V.Vector a -> L.ByteString+encode = encodeWith defaultEncodeOptions++-- | Efficiently serialize CVS records as a lazy 'L.ByteString'. The+-- header is written before any records and dictates the field order.+encodeByName :: ToNamedRecord a => Header -> V.Vector a -> L.ByteString+encodeByName = encodeByNameWith defaultEncodeOptions++------------------------------------------------------------------------+-- ** Encoding and decoding options++-- | Like 'decode', but lets you customize how the CSV data is parsed.+decodeWith :: FromRecord a => DecodeOptions -> L.ByteString+ -> Either String (Vector a)+decodeWith !opts = decodeWithP (csv opts) (parse . traverse parseRecord)+{-# INLINE [1] decodeWith #-}++{-# RULES+ "idDecodeWith" decodeWith = idDecodeWith+ #-}++-- | Same as 'decodeWith', but more efficient as no type+-- conversion is performed.+idDecodeWith :: DecodeOptions -> L.ByteString+ -> Either String (Vector (Vector B.ByteString))+idDecodeWith !opts = decodeWithP (csv opts) pure++-- | Like 'decodeByName', but lets you customize how the CSV data is+-- parsed.+decodeByNameWith :: FromNamedRecord a => DecodeOptions -> L.ByteString+ -> Either String (Header, Vector a)+decodeByNameWith !opts =+ decodeWithP (csvWithHeader opts)+ (\ (hdr, vs) -> (,) <$> pure hdr <*> (parse $ traverse parseNamedRecord vs))++-- | 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.+data EncodeOptions = EncodeOptions+ { -- | Field delimiter.+ encDelimiter :: {-# UNPACK #-} !Word8+ }++-- | Encoding options for CSV files.+defaultEncodeOptions :: EncodeOptions+defaultEncodeOptions = EncodeOptions+ { encDelimiter = 44 -- comma+ }++-- | Like 'encode', but lets you customize how the CSV data is+-- encoded.+encodeWith :: ToRecord a => EncodeOptions -> V.Vector a -> L.ByteString+encodeWith opts = toLazyByteString+ . unlines+ . map (encodeRecord (encDelimiter opts) . toRecord)+ . V.toList++encodeRecord :: Word8 -> Record -> Builder+encodeRecord delim = mconcat . intersperse (fromWord8 delim)+ . map fromByteString . V.toList+{-# INLINE encodeRecord #-}++-- | Like 'encodeByName', but lets you customize how the CSV data is+-- encoded.+encodeByNameWith :: ToNamedRecord a => EncodeOptions -> Header -> V.Vector a+ -> L.ByteString+encodeByNameWith opts hdr v =+ toLazyByteString ((encodeRecord (encDelimiter opts) hdr) <>+ fromByteString "\r\n" <> records)+ where+ records = unlines+ . map (encodeRecord (encDelimiter opts)+ . namedRecordToRecord hdr . toNamedRecord)+ . V.toList $ v+++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 #-}++unlines :: [Builder] -> Builder+unlines [] = mempty+unlines (b:bs) = b <> fromString "\r\n" <> unlines 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 -> (a -> Result b) -> L.ByteString -> Either String b+decodeWithP p to s =+ case AL.parse p s of+ AL.Done _ v -> case to v of+ Success a -> Right a+ Error msg -> Left $ "conversion error: " ++ msg+ AL.Fail left _ msg -> Left $ "parse error (" ++ msg ++ ") at " +++ show (BL8.unpack left)+{-# INLINE decodeWithP #-}
+ Data/Csv/Parser.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE BangPatterns #-}++-- | 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 Blaze.ByteString.Builder (fromByteString, toByteString)+import Blaze.ByteString.Builder.Char.Utf8 (fromChar)+import Control.Applicative+import Data.Attoparsec.Char8 hiding (Parser, Result, parse)+import qualified Data.Attoparsec 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.HashMap.Strict as HM+import Data.Monoid+import qualified Data.Vector as V+import Data.Word++import Data.Csv.Types++-- | Options that controls how data is decoded. These options can be+-- used to e.g. decode tab-separated data instead of comma-separated+-- data.+data DecodeOptions = DecodeOptions+ { -- | Field delimiter.+ decDelimiter :: {-# UNPACK #-} !Word8+ }++-- | 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 <- record (decDelimiter opts) `sepBy1` endOfLine+ _ <- optional endOfLine+ endOfInput+ let nonEmpty = removeBlankLines vals+ return (V.fromList nonEmpty)+{-# INLINE csv #-}++-- | Parse a CSV file that includes a header.+csvWithHeader :: DecodeOptions -> AL.Parser (Header, V.Vector NamedRecord)+csvWithHeader !opts = do+ hdr <- header (decDelimiter opts)+ vals <- map (toNamedRecord hdr) . removeBlankLines <$>+ (record (decDelimiter opts)) `sepBy1` endOfLine+ _ <- optional endOfLine+ endOfInput+ return (hdr, V.fromList vals)++toNamedRecord :: V.Vector S.ByteString -> Record -> NamedRecord+toNamedRecord hdr v = HM.fromList . V.toList $ V.zip hdr v++-- | Parse a header, including the terminating line separator.+header :: Word8 -- ^ Field delimiter+ -> AL.Parser Header+header delim = V.fromList <$> name `sepBy1` (A.word8 delim) <* endOfLine++-- | Parse a header name. Header names have the same format as regular+-- 'field's.+name :: AL.Parser Field -- TODO: Create Name type alias+name = field++removeBlankLines :: [Record] -> [Record]+removeBlankLines = filter (not . blankLine)+ where blankLine v = V.length v == 1 && (S.null (V.head v))++-- | 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 `sepBy1` (A.word8 delim)+{-# INLINE record #-}++-- | Parse a field. The field may be in either the escaped or+-- non-escaped format. The return value is unescaped.+field :: AL.Parser Field+field = 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++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 :: AL.Parser S.ByteString+unescapedField = A.takeWhile (\ c -> c /= doubleQuote &&+ c /= newline &&+ c /= commaB &&+ c /= cr)++dquote :: AL.Parser Char+dquote = char '"'++unescape :: Z.Parser S.ByteString+unescape = toByteString <$> 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` fromByteString h `mappend` fromChar '"')+ else fail "invalid CSV escape sequence"+ done <- Z.atEnd+ if done+ then return (acc `mappend` fromByteString h)+ else rest++doubleQuote, newline, commaB, cr :: Word8+doubleQuote = 34+newline = 10+commaB = 44+cr = 13
+ Data/Csv/Types.hs view
@@ -0,0 +1,36 @@+module Data.Csv.Types+ (+ -- * Core CSV types+ Csv+ , Record+ , Header+ , Name+ , NamedRecord+ , Field+ ) where++import qualified Data.ByteString as S+import qualified Data.HashMap.Strict as HM+import Data.Vector (Vector)++-- | 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
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, Johan Tibell++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Johan Tibell nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ benchmarks/Benchmarks.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE BangPatterns, FlexibleInstances, OverloadedStrings,+ TypeSynonymInstances #-}+module Main ( main ) where++import Control.Applicative+import Criterion.Main+import Data.ByteString (ByteString)+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.HashMap.Strict as HM+import Data.Text (Text)+import Data.Vector (Vector)++import Data.Csv++type President = (Int, Text, ByteString, ByteString, ByteString, Text, Text)++instance FromNamedRecord President where+ parseNamedRecord m = (,,,,,,) <$>+ m .: "Presidency" <*>+ m .: "President" <*>+ m .: "Wikipedia Entry" <*>+ m .: "Took office" <*>+ m .: "Left office" <*>+ m .: "Party" <*>+ m .: "Home State"++instance ToNamedRecord President where+ toNamedRecord (presidency, president, wikipediaEntry, tookOffice,+ leftOffice, party, homeState) = namedRecord+ [ "Presidency" .= presidency+ , "President" .= president+ , "Wikipedia Entry" .= wikipediaEntry+ , "Took office" .= tookOffice+ , "Left office" .= leftOffice+ , "Party" .= party+ , "Home State" .= homeState+ ]+++fromStrict s = BL.fromChunks [s]++type BSHashMap a = HM.HashMap B.ByteString a++main :: IO ()+main = do+ !csvData <- fromStrict `fmap` B.readFile "benchmarks/presidents.csv"+ !csvDataN <- fromStrict `fmap` B.readFile+ "benchmarks/presidents_with_header.csv"+ let (Right !presidents) = decodePresidents csvData+ (Right (!hdr, !presidentsN)) = decodePresidentsN csvDataN+ defaultMain [+ bgroup "positional"+ [ bgroup "decode"+ [ bench "presidents/without conversion" $ whnf idDecode csvData+ , bench "presidents/with conversion" $ whnf decodePresidents csvData+ ]+ , bgroup "encode"+ [ bench "presidents/with conversion" $ whnf encode presidents+ ]+ ]+ , bgroup "named"+ [ bgroup "decode"+ [ bench "presidents/without conversion" $ whnf idDecodeN csvDataN+ , bench "presidents/with conversion" $ whnf decodePresidentsN csvDataN+ ]+ , bgroup "encode"+ [ bench "presidents/with conversion" $ whnf (encodeByName hdr) presidentsN+ ]+ ]+ ]+ where+ decodePresidents :: BL.ByteString -> Either String (Vector President)+ decodePresidents = decode++ decodePresidentsN :: BL.ByteString -> Either String (Header, Vector President)+ decodePresidentsN = decodeByName++ idDecode :: BL.ByteString -> Either String (Vector (Vector B.ByteString))+ idDecode = decode++ idDecodeN :: BL.ByteString -> Either String (Header, Vector (BSHashMap B.ByteString))+ idDecodeN = decodeByName
+ cassava.cabal view
@@ -0,0 +1,75 @@+Name: cassava+Version: 0.1.0.0+Synopsis: A CSV parsing and encoding library+Description:+ A CSV parsing and encoding library optimized for ease of use and high+ performance.+Homepage: https://github.com/tibbe/sea+License: BSD3+License-file: LICENSE+Bug-reports: https://github.com/tibbe/cassava/issues+Copyright: (c) 2012 Johan Tibell+ (c) 2012 Bryan O'Sullivan+ (c) 2011 MailRank, Inc.+Author: Johan Tibell+Maintainer: johan.tibell@gmail.com+Category: Text, Web, CSV+Build-type: Simple+Cabal-version: >=1.8+++Library+ Exposed-modules: Data.Csv+ Data.Csv.Parser++ Other-modules: Data.Csv.Conversion+ Data.Csv.Conversion.Internal+ Data.Csv.Encoding+ Data.Csv.Types++ Build-depends: array,+ attoparsec >= 0.10.2,+ base < 5,+ blaze-builder,+ bytestring,+ containers,+ text,+ unordered-containers,+ vector++ ghc-options: -Wall -O2++Test-suite unit-tests+ Type: exitcode-stdio-1.0+ Main-is: UnitTests.hs+ Build-depends: attoparsec,+ base,+ bytestring,+ cassava,+ HUnit,+ QuickCheck >= 2.0,+ test-framework,+ test-framework-hunit,+ test-framework-quickcheck2,+ text,+ unordered-containers,+ vector++ hs-source-dirs: tests+ ghc-options: -Wall++Benchmark benchmarks+ Type: exitcode-stdio-1.0+ Main-is: Benchmarks.hs+ Build-depends: base,+ bytestring,+ cassava,+ criterion,+ text,+ unordered-containers,+ vector+ hs-source-dirs: benchmarks++source-repository head+ type: git+ location: https://github.com/tibbe/cassava.git
+ tests/UnitTests.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main+ ( main+ ) where++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BL8+import qualified Data.HashMap.Strict as HM+import Data.Int+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import Data.Vector ((!))+import qualified Data.Vector as V+import Data.Word+import Test.HUnit+import Test.Framework as TF+import Test.Framework.Providers.HUnit as TF+import Test.QuickCheck+import Test.Framework.Providers.QuickCheck2 as TF++import Data.Csv++------------------------------------------------------------------------+-- Parse tests++decodesAs :: BL.ByteString -> [[B.ByteString]] -> Assertion+decodesAs input expected = case decode input of+ Right r -> V.fromList (map V.fromList expected) @=? r+ Left err -> assertFailure $+ " input: " ++ show (BL8.unpack input) ++ "\n" +++ "parse error: " ++ err++encodesAs :: [[B.ByteString]] -> BL.ByteString -> Assertion+encodesAs input expected =+ encode (V.fromList (map V.fromList input)) @?= expected++namedEncodesAs :: [B.ByteString] -> [[(B.ByteString, B.ByteString)]]+ -> BL.ByteString -> Assertion+namedEncodesAs hdr input expected =+ encodeByName (V.fromList hdr)+ (V.fromList $ map HM.fromList input) @?= expected++namedDecodesAs :: BL.ByteString -> [B.ByteString]+ -> [[(B.ByteString, B.ByteString)]] -> Assertion+namedDecodesAs input ehdr expected = case decodeByName input of+ Right r -> (V.fromList ehdr, expected') @=? r+ Left err -> assertFailure $+ " input: " ++ show (BL8.unpack input) ++ "\n" +++ "parse error: " ++ err+ where+ expected' = V.fromList $ map HM.fromList expected++testRfc4180 :: Assertion+testRfc4180 = (BL8.pack $+ "#field1,field2,field3\n" +++ "\"aaa\",\"bb\n" +++ "b\",\"ccc\"\n" +++ "\"a,a\",\"b\"\"bb\",\"ccc\"\n" +++ "zzz,yyy,xxx\n")+ `decodesAs`+ [["#field1", "field2", "field3"],+ ["aaa", "bb\nb", "ccc"],+ ["a,a", "b\"bb", "ccc"],+ ["zzz", "yyy", "xxx"]]++positionalTests :: [TF.Test]+positionalTests =+ [ testGroup "encode" $ map encodeTest+ [ ("simple", [["abc"]], "abc\r\n")+ , ("quoted", [["\"abc\""]], "\"\"\"abc\"\"\"\r\n")+ , ("quote", [["a\"b"]], "\"a\"\"b\"\r\n")+ , ("quotedQuote", [["\"a\"b\""]], "\"\"\"a\"\"b\"\"\"\r\n")+ , ("leadingSpace", [[" abc"]], "\" abc\"\r\n")+ , ("comma", [["abc,def"]], "\"abc,def\"\r\n")+ , ("twoFields", [["abc","def"]], "abc,def\r\n")+ , ("twoRecords", [["abc"], ["def"]], "abc\r\ndef\r\n")+ , ("newline", [["abc\ndef"]], "\"abc\ndef\"\r\n")+ ]+ , testGroup "decode" $ map decodeTest+ [ ("simple", "a,b,c\n", [["a", "b", "c"]])+ , ("crlf", "a,b\r\nc,d\r\n", [["a", "b"], ["c", "d"]])+ , ("noEol", "a,b,c", [["a", "b", "c"]])+ , ("blankLine", "a,b,c\n\nd,e,f\n\n",+ [["a", "b", "c"], ["d", "e", "f"]])+ , ("leadingSpace", " a, b, c\n", [[" a", " b", " c"]])+ ] ++ [testCase "rfc4180" testRfc4180]+ ]+ where+ encodeTest (name, input, expected) =+ testCase name $ input `encodesAs` expected+ decodeTest (name, input, expected) =+ testCase name $ input `decodesAs` expected++nameBasedTests :: [TF.Test]+nameBasedTests =+ [ testGroup "encode" $ map encodeTest+ [ ("simple", ["field"], [[("field", "abc")]], "field\r\nabc\r\n")+ , ("twoFields", ["field1", "field2"],+ [[("field1", "abc"), ("field2", "def")]],+ "field1,field2\r\nabc,def\r\n")+ , ("twoRecords", ["field"], [[("field", "abc")], [("field", "def")]],+ "field\r\nabc\r\ndef\r\n")+ ]+ , testGroup "decode" $ map decodeTest+ [("simple", "field\r\nabc\r\n", ["field"], [[("field", "abc")]])+ , ("twoFields", "field1,field2\r\nabc,def\r\n", ["field1", "field2"],+ [[("field1", "abc"), ("field2", "def")]])+ , ("twoRecords", "field\r\nabc\r\ndef\r\n", ["field"],+ [[("field", "abc")], [("field", "def")]])+ ]+ ]+ where+ encodeTest (name, hdr, input, expected) =+ testCase name $ namedEncodesAs hdr input expected+ decodeTest (name, input, hdr, expected) =+ testCase name $ namedDecodesAs input hdr expected++------------------------------------------------------------------------+-- Conversion tests++instance Arbitrary B.ByteString where+ arbitrary = B.pack `fmap` arbitrary++instance Arbitrary BL.ByteString where+ arbitrary = BL.fromChunks `fmap` arbitrary++instance Arbitrary T.Text where+ arbitrary = T.pack `fmap` arbitrary++instance Arbitrary LT.Text where+ arbitrary = LT.fromChunks `fmap` arbitrary++-- A single column with an empty string is indistinguishable from an+-- empty line (which we will ignore.) We therefore encode at least two+-- columns.+roundTrip :: (Eq a, FromField a, ToField a) => a -> Bool+roundTrip x = case decode (encode (V.singleton (x, dummy))) of+ Right v | V.length v == 1 -> let (y, _ :: Char) = v ! 0 in x == y+ _ -> False+ where dummy = 'a'++boundary :: forall a. (Bounded a, Eq a, FromField a, ToField a) => a -> Bool+boundary _dummy = roundTrip (minBound :: a) && roundTrip (maxBound :: a)++-- TODO: Right now we only encode ASCII properly. Should we support+-- UTF-8? Arbitrary byte strings?++conversionTests :: [TF.Test]+conversionTests =+ [ testGroup "roundTrip"+ [ testProperty "Char" (roundTrip :: Char -> Bool)+ , testProperty "ByteString" (roundTrip :: B.ByteString -> Bool)+ , testProperty "Int" (roundTrip :: Int -> Bool)+ , testProperty "Integer" (roundTrip :: Integer -> Bool)+ , testProperty "Int8" (roundTrip :: Int8 -> Bool)+ , testProperty "Int16" (roundTrip :: Int16 -> Bool)+ , testProperty "Int32" (roundTrip :: Int32 -> Bool)+ , testProperty "Int64" (roundTrip :: Int64 -> Bool)+ , testProperty "Word" (roundTrip :: Word -> Bool)+ , testProperty "Word8" (roundTrip :: Word8 -> Bool)+ , testProperty "Word16" (roundTrip :: Word16 -> Bool)+ , testProperty "Word32" (roundTrip :: Word32 -> Bool)+ , testProperty "Word64" (roundTrip :: Word64 -> Bool)+ , testProperty "lazy ByteString"+ (roundTrip :: BL.ByteString -> Bool)+ , testProperty "Text" (roundTrip :: T.Text -> Bool)+ , testProperty "lazy Text" (roundTrip :: LT.Text -> Bool)+ ]+ , testGroup "boundary"+ [ testProperty "Int" (boundary (undefined :: Int))+ , testProperty "Int8" (boundary (undefined :: Int8))+ , testProperty "Int16" (boundary (undefined :: Int16))+ , testProperty "Int32" (boundary (undefined :: Int32))+ , testProperty "Int64" (boundary (undefined :: Int64))+ , testProperty "Word" (boundary (undefined :: Word))+ , testProperty "Word8" (boundary (undefined :: Word8))+ , testProperty "Word16" (boundary (undefined :: Word16))+ , testProperty "Word32" (boundary (undefined :: Word32))+ , testProperty "Word64" (boundary (undefined :: Word64))+ ]+ ]++------------------------------------------------------------------------+-- Test harness++allTests :: [TF.Test]+allTests = [ testGroup "positional" positionalTests+ , testGroup "named" nameBasedTests+ , testGroup "conversion" conversionTests+ ]++main :: IO ()+main = defaultMain allTests