csv-conduit 0.5.1 → 0.6.2
raw patch · 7 files changed
+1336/−27 lines, 7 filesdep +arraydep +blaze-builderdep +ghc-prim
Dependencies added: array, blaze-builder, ghc-prim, mmorph, mtl, primitive, transformers, unordered-containers, vector
Files
- LICENSE +2/−1
- csv-conduit.cabal +27/−4
- src/Data/CSV/Conduit.hs +122/−19
- src/Data/CSV/Conduit/Conversion.hs +895/−0
- src/Data/CSV/Conduit/Conversion/Internal.hs +284/−0
- src/Data/CSV/Conduit/Types.hs +3/−1
- test/Test.hs +3/−2
LICENSE view
@@ -1,4 +1,5 @@-Copyright (c)2010, Ozgun Ataman+Copyright (c)2013, Ozgun Ataman+Copyright (c)2012, Johan Tibell All rights reserved.
csv-conduit.cabal view
@@ -1,5 +1,5 @@ Name: csv-conduit-Version: 0.5.1+Version: 0.6.2 Synopsis: A flexible, fast, conduit-based CSV parser library for Haskell. Homepage: http://github.com/ozataman/csv-conduit License: BSD3@@ -63,11 +63,13 @@ library exposed-modules: Data.CSV.Conduit+ Data.CSV.Conduit.Types+ Data.CSV.Conduit.Conversion Data.CSV.Conduit.Parser.ByteString Data.CSV.Conduit.Parser.Text other-modules:- Data.CSV.Conduit.Types- ghc-options: -Wall+ Data.CSV.Conduit.Conversion.Internal+ ghc-options: -Wall -funbox-strict-fields hs-source-dirs: src build-depends: attoparsec >= 0.10@@ -79,9 +81,21 @@ , monad-control , text , data-default- ghc-options: -funbox-strict-fields+ , vector+ , array + , blaze-builder+ , unordered-containers+ , transformers+ , mtl+ , mmorph+ , primitive ghc-prof-options: -fprof-auto + if impl(ghc >= 7.2.1)+ cpp-options: -DGENERICS+ build-depends: ghc-prim >= 0.2 && < 0.4++ test-suite test type: exitcode-stdio-1.0 main-is: Test.hs@@ -93,10 +107,14 @@ , containers >= 0.3 , csv-conduit , directory+ , vector , HUnit >= 1.2 , test-framework , test-framework-hunit , text+ , transformers+ , mtl+ , primitive flag bench default: False@@ -115,7 +133,12 @@ , bytestring , containers >= 0.3 , csv-conduit+ , vector , directory , text+ , transformers+ , mtl+ , primitive+ ghc-options: -rtsopts ghc-prof-options: -rtsopts -caf-all -auto-all
src/Data/CSV/Conduit.hs view
@@ -5,21 +5,21 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-} module Data.CSV.Conduit ( - -- * Key Operations- CSV (..)- , writeHeaders-- -- * Convenience Functions+ -- * Main Interface+ decodeCSV , readCSVFile , writeCSVFile , transformCSV , mapCSVFile+ , writeHeaders - -- * Important Types+ -- Types+ , CSV (..) , CSVSettings (..) , defCSVSettings , MapRow@@ -30,6 +30,12 @@ ) where -------------------------------------------------------------------------------+import Control.Exception++import Control.Monad.Morph+import Control.Monad.Primitive+import Control.Monad.ST+import Control.Monad.Trans import Data.Attoparsec.Types (Parser) import qualified Data.ByteString as B import Data.ByteString.Char8 (ByteString)@@ -45,8 +51,15 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T+import qualified Data.Vector as V+import qualified Data.Vector.Generic as GV+import qualified Data.Vector.Generic.Mutable as GMV import System.IO -------------------------------------------------------------------------------+import Data.CSV.Conduit.Conversion (FromNamedRecord (..),+ Named (..),+ ToNamedRecord (..),+ runParser) import qualified Data.CSV.Conduit.Parser.ByteString as BSP import qualified Data.CSV.Conduit.Parser.Text as TP import Data.CSV.Conduit.Types@@ -55,9 +68,20 @@ ------------------------------------------------------------------------------- -- | Represents types 'r' that are CSV-like and can be converted--- to/from an underlying stream of type 's'.+-- to/from an underlying stream of type 's'. There is nothing scary+-- about the type: --+-- @s@ represents stream types that can be converted to\/from CSV rows.+-- Examples are 'ByteString', 'Text' and 'String'. --+-- @r@ represents the target CSV row representations that this library+-- can work with. Examples are the 'Row' types, the 'Record' type and+-- the 'MapRow' family of types. We can also convert directly to+-- complex Haskell types using the 'Data.CSV.Conduit.Conversion'+-- module that was borrowed from the cassava package, which was itself+-- inspired by the aeson package.+--+-- -- Example #1: Basics Using Convenience API -- -- >import Data.Conduit@@ -162,16 +186,23 @@ fromCSV set = C.map (map B8.pack) =$= fromCSV set +-- | Support for parsing rows in the 'Vector' form.+instance (CSV s (Row s)) => CSV s (V.Vector s) where+ rowToStr s r = rowToStr s . V.toList $ r+ intoCSV set = intoCSV set =$= C.map (V.fromList)+ fromCSV set = C.map (V.toList) =$= fromCSV set ++ ------------------------------------------------------------------------------- fromCSVRow :: (Monad m, IsString s, CSV s r) => CSVSettings -> Conduit r m s fromCSVRow set = awaitForever $ \row -> mapM_ yield [rowToStr set row, "\n"] + --------------------------------------------------------------------------------intoCSVRow :: (MonadThrow m, AttoparsecInput i)- => Parser i (Maybe o) -> Conduit i m o+intoCSVRow :: (MonadThrow m, AttoparsecInput i) => Parser i (Maybe o) -> Conduit i m o intoCSVRow p = parse =$= puller where parse = {-# SCC "conduitParser_p" #-} conduitParser p@@ -203,6 +234,21 @@ toMapCSV !hs !fs = M.fromList $ zip hs fs +-- | Conversion of stream directly to/from a custom complex haskell+-- type.+instance (FromNamedRecord a, ToNamedRecord a, CSV s (MapRow ByteString)) =>+ CSV s (Named a) where+ rowToStr s a = rowToStr s . toNamedRecord . getNamed $ a+ intoCSV set = intoCSV set =$= C.mapMaybe go+ where+ go x = either (const Nothing) (Just . Named) $+ runParser (parseNamedRecord x)++ fromCSV set = C.map go =$= fromCSV set+ where+ go = toNamedRecord . getNamed++ ------------------------------------------------------------------------------- fromCSVMap :: (Monad m, IsString s, CSV s [a]) => CSVSettings -> Conduit (M.Map k a) m s@@ -212,9 +258,12 @@ ---------------------------------------------------------------------------------- | Write headers AND the row into the output stream, once. Just--- chain this using the 'Monad' instance in your pipeline:+-- | Write headers AND the row into the output stream, once. If you+-- don't call this while using 'MapRow' family of row types, then your+-- resulting output will NOT have any headers in it. --+-- Usage: Just chain this using the 'Monad' instance in your pipeline:+-- -- > ... =$= writeHeaders settings >> fromCSV settings $$ sinkFile "..." writeHeaders :: (Monad m, CSV s (Row r), IsString s)@@ -237,18 +286,41 @@ ------------------------------------------------------------------------------- -- | Read the entire contents of a CSV file into memory.-readCSVFile- :: (CSV ByteString a)+-- readCSVFile+-- :: (GV.Vector v a, CSV ByteString a)+-- => CSVSettings+-- -- ^ Settings to use in deciphering stream+-- -> FilePath+-- -- ^ Input file+-- -> IO (v a)+readCSVFile :: (MonadIO m, CSV ByteString a) => CSVSettings -> FilePath -> m (V.Vector a)+readCSVFile set fp = liftIO . runResourceT $ sourceFile fp $= intoCSV set $$ hoist lift (sinkVector 10)++++-------------------------------------------------------------------------------+-- | A simple way to decode a CSV string. Don't be alarmed by the+-- polymorphic nature of the signature. 's' is the type for the string+-- and 'v' is a kind of 'Vector' here.+--+-- For example for 'ByteString':+--+-- >>> s <- LB.readFile "my.csv"+-- >>> decodeCSV 'def' s :: Vector (Vector ByteString)+--+-- will just work.+decodeCSV+ :: (GV.Vector v a, CSV s a) => CSVSettings- -- ^ Settings to use in deciphering stream- -> FilePath- -- ^ Input file- -> IO [a]-readCSVFile set fp = runResourceT $ sourceFile fp $= intoCSV set $$ C.consume+ -> s+ -> Either SomeException (v a)+decodeCSV set bs = runST $ runExceptionT $ C.sourceList [bs] $= intoCSV set $$ hoist lift (sinkVector 10) + ---------------------------------------------------------------------------------- | Write CSV data into file.+-- | Write CSV data into file. As we use a 'ByteString' sink, you'll+-- need to get your data into a 'ByteString' stream type. writeCSVFile :: (CSV ByteString a) => CSVSettings@@ -315,4 +387,35 @@ c $= fromCSV set $$ sink+++++ ------------------+ -- Vector Utils --+ ------------------++++-------------------------------------------------------------------------------+-- | An efficient sink that incrementally grows a vector from the input stream+sinkVector :: (PrimMonad m, GV.Vector v a) => Int -> ConduitM a o m (v a)+sinkVector by = do+ v <- lift $ GMV.new by+ go 0 v+ where+ -- i is the index of the next element to be written by go+ -- also exactly the number of elements in v so far+ go i v = do+ res <- await+ case res of+ Nothing -> do+ v' <- lift $ GV.freeze $ GMV.slice 0 i v+ return $! v'+ Just x -> do+ v' <- case GMV.length v == i of+ True -> lift $ GMV.grow v by+ False -> return v+ lift $ GMV.write v' i x+ go (i+1) v'
+ src/Data/CSV/Conduit/Conversion.hs view
@@ -0,0 +1,895 @@+{-# LANGUAGE BangPatterns, CPP, FlexibleInstances, OverloadedStrings,+ Rank2Types #-}+#ifdef GENERICS+{-# LANGUAGE DefaultSignatures, TypeOperators, KindSignatures, FlexibleContexts,+ MultiParamTypeClasses, UndecidableInstances, ScopedTypeVariables #-}+#endif++-----------------------------------------------------------------------------+-- |+-- Module : Data.CSV.Conduit.Conversion+-- Copyright : Ozgun Ataman, Johan Tibell+-- License : BSD3+--+-- Maintainer : Ozgun Ataman <ozataman@gmail.com>+-- Stability : experimental+--+-- This module has been shamelessly taken from Johan Tibell's nicely+-- put together cassava package, which itself borrows the approach+-- from Bryan O'Sullivan's widely used aeson package.+--+-- We make the necessary adjustments and some simplifications here to+-- bolt this parsing interface onto our underlying "CSV" typeclass.+----------------------------------------------------------------------------++module Data.CSV.Conduit.Conversion+ (+ -- * Type conversion+ Only(..)+ , Named (..)+ , Record+ , NamedRecord+ , FromRecord(..)+ , FromNamedRecord(..)+ , ToNamedRecord(..)+ , FromField(..)+ , ToRecord(..)+ , ToField(..)++ -- * Parser+ , Parser+ , runParser++ -- * Accessors+ , index+ , (.!)+ , unsafeIndex+ , lookup+ , (.:)+ , namedField+ , (.=)+ , record+ , namedRecord+ ) where++import Control.Applicative (Alternative, Applicative, (<*>), (<$>), (<|>),+ empty, pure)+import Control.Monad (MonadPlus, mplus, mzero)+import Data.Attoparsec.Char8 (double, parseOnly)+import qualified Data.Attoparsec.Char8 as A8+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as B8+import qualified Data.ByteString.Lazy as L++import Data.Int (Int8, Int16, Int32, Int64)+import qualified Data.Map as M+import Data.Monoid (Monoid, mappend, mempty)+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 (traverse)+import Data.Vector (Vector, (!))+import qualified Data.Vector as V+import qualified Data.Vector.Unboxed as U+import Data.Word (Word, Word8, Word16, Word32, Word64)+import GHC.Float (double2Float)+import Prelude hiding (lookup, takeWhile)++#ifdef GENERICS+import GHC.Generics+import qualified Data.IntMap as IM+#endif++import Data.CSV.Conduit.Conversion.Internal+++------------------------------------------------------------------------+-- 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++++-- | A shorthand for the ByteString case of 'MapRow'+type NamedRecord = M.Map B8.ByteString B8.ByteString+++-- | A wrapper around custom haskell types that can directly be+-- converted/parsed from an incoming CSV stream.+--+-- We define this wrapper to stop GHC from complaining+-- about overlapping instances. Just use 'getNamed' to get your+-- object out of the wrapper.+newtype Named a = Named { getNamed :: a } deriving (Eq,Show,Read,Ord)++-- | A record corresponds to a single line in a CSV file.+type Record = Vector B8.ByteString++-- | A single field within a record.+type Field = B8.ByteString+++------------------------------------------------------------------------+-- 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+-- > | length v == 2 = Person <$>+-- > v .! 0 <*>+-- > v .! 1+-- > | otherwise = mzero+class FromRecord a where+ parseRecord :: Record -> Parser a+ +#ifdef GENERICS+ default parseRecord :: (Generic a, GFromRecord (Rep a)) => Record -> Parser a+ parseRecord r = to <$> gparseRecord r+#endif++-- | Haskell lacks a single-element tuple type, so if you CSV data+-- with just one column you can use the 'Only' type to represent a+-- 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++#ifdef GENERICS+ default toRecord :: (Generic a, GToRecord (Rep a) Field) => a -> Record+ toRecord = V.fromList . gtoRecord . from+#endif++instance FromField a => FromRecord (Only a) where+ parseRecord v+ | n == 1 = Only <$> 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]++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 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++#ifdef GENERICS+ default parseNamedRecord :: (Generic a, GFromNamedRecord (Rep a)) => NamedRecord -> Parser a+ parseNamedRecord r = to <$> gparseNamedRecord r+#endif++-- | A type that can be converted to a single CSV record.+--+-- An example type and instance:+--+-- > 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++#ifdef GENERICS+ default toNamedRecord :: (Generic a, GToRecord (Rep a) (B.ByteString, B.ByteString)) => a -> NamedRecord+ toNamedRecord = namedRecord . gtoRecord . from+#endif++instance FromField a => FromNamedRecord (M.Map B.ByteString a) where+ parseNamedRecord m = traverse parseField m++instance ToField a => ToNamedRecord (M.Map B.ByteString a) where+ toNamedRecord = M.map toField++-- 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++-- | '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 #-}++-- | 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 same syntax as 'rational'.+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'.+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 double s of+ Left err -> typeError "Double" s (Just err)+ Right n -> pure n+{-# INLINE parseDouble #-}++-- | Accepts a signed decimal number.+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.+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.+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.+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.+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.+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.+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.+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.+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.+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.+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 #-}++-- | 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 (A8.signed A8.decimal) 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 A8.decimal s of+ Left err -> typeError typ s (Just err)+ Right n -> pure n+{-# INLINE parseUnsigned #-}++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 $ M.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 = M.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 (>>=) #-}+ 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 unParser 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' _ = unParser b kf ks+ in unParser 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', 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 #-}++#ifdef GENERICS++class GFromRecord f where+ gparseRecord :: Record -> Parser (f p)++instance GFromRecordSum f Record => GFromRecord (M1 i n f) where+ gparseRecord v = + case (IM.lookup n gparseRecordSum) of+ Nothing -> lengthMismatch n v + Just p -> M1 <$> p v+ where+ n = V.length v++class GFromNamedRecord f where+ gparseNamedRecord :: NamedRecord -> Parser (f p)++instance GFromRecordSum f NamedRecord => GFromNamedRecord (M1 i n f) where+ gparseNamedRecord v = + foldr (\f p -> p <|> M1 <$> f v) empty (IM.elems gparseRecordSum)++class GFromRecordSum f r where+ gparseRecordSum :: IM.IntMap (r -> Parser (f p))++instance (GFromRecordSum a r, GFromRecordSum b r) => GFromRecordSum (a :+: b) r where+ gparseRecordSum = + IM.unionWith (\a b r -> a r <|> b r) + (fmap (L1 <$>) <$> gparseRecordSum)+ (fmap (R1 <$>) <$> gparseRecordSum)++instance GFromRecordProd f r => GFromRecordSum (M1 i n f) r where+ gparseRecordSum = IM.singleton n (fmap (M1 <$>) f)+ where+ (n, f) = gparseRecordProd 0++class GFromRecordProd f r where+ gparseRecordProd :: Int -> (Int, r -> Parser (f p))++instance GFromRecordProd U1 r where+ gparseRecordProd n = (n, const (pure U1))++instance (GFromRecordProd a r, GFromRecordProd b r) => GFromRecordProd (a :*: b) r where+ gparseRecordProd n0 = (n2, f)+ where+ f r = (:*:) <$> fa r <*> fb r+ (n1, fa) = gparseRecordProd n0+ (n2, fb) = gparseRecordProd n1++instance GFromRecordProd f Record => GFromRecordProd (M1 i n f) Record where+ gparseRecordProd n = fmap (M1 <$>) <$> gparseRecordProd n++instance FromField a => GFromRecordProd (K1 i a) Record where+ gparseRecordProd n = (n + 1, \v -> K1 <$> parseField (V.unsafeIndex v n))++data Proxy s (f :: * -> *) a = Proxy++instance (FromField a, Selector s) => GFromRecordProd (M1 S s (K1 i a)) NamedRecord where+ gparseRecordProd n = (n + 1, \v -> (M1 . K1) <$> v .: name)+ where+ name = T.encodeUtf8 (T.pack (selName (Proxy :: Proxy s f a)))+++class GToRecord a f where+ gtoRecord :: a p -> [f]++instance GToRecord U1 f where+ gtoRecord U1 = []++instance (GToRecord a f, GToRecord b f) => GToRecord (a :*: b) f where+ gtoRecord (a :*: b) = gtoRecord a ++ gtoRecord b++instance (GToRecord a f, GToRecord b f) => GToRecord (a :+: b) f where+ gtoRecord (L1 a) = gtoRecord a+ gtoRecord (R1 b) = gtoRecord b++instance GToRecord a f => GToRecord (M1 D c a) f where+ gtoRecord (M1 a) = gtoRecord a++instance GToRecord a f => GToRecord (M1 C c a) f where+ gtoRecord (M1 a) = gtoRecord a++instance GToRecord a Field => GToRecord (M1 S c a) Field where+ gtoRecord (M1 a) = gtoRecord a++instance ToField a => GToRecord (K1 i a) Field where+ gtoRecord (K1 a) = [toField a]++instance (ToField a, Selector s) => GToRecord (M1 S s (K1 i a)) (B.ByteString, B.ByteString) where+ gtoRecord m@(M1 (K1 a)) = [T.encodeUtf8 (T.pack (selName m)) .= toField a]++#endif
+ src/Data/CSV/Conduit/Conversion/Internal.hs view
@@ -0,0 +1,284 @@+module Data.CSV.Conduit.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.Word++import Data.CSV.Conduit.Monoid ((<>))++------------------------------------------------------------------------+-- 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)
src/Data/CSV/Conduit/Types.hs view
@@ -47,5 +47,7 @@ type Row a = [a] ---------------------------------------------------------------------------------- | A 'MapRow' is a dictionary based on 'Data.Map'+-- | A 'MapRow' is a dictionary based on 'Data.Map' where column names+-- are keys and row's individual cell values are the values of the+-- 'Map'. type MapRow a = M.Map a a
test/Test.hs view
@@ -6,6 +6,7 @@ import qualified Data.ByteString.Char8 as B import Data.Map ((!)) import Data.Text+import qualified Data.Vector as V import System.Directory import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.HUnit@@ -44,8 +45,8 @@ test_simpleParse :: IO () test_simpleParse = do- (d :: [MapRow B.ByteString]) <- readCSVFile csvSettings testFile1- mapM_ assertRow d+ (d :: V.Vector (MapRow B.ByteString)) <- readCSVFile csvSettings testFile1+ V.mapM_ assertRow d where assertRow r = v3 @=? (v1 + v2) where v1 = readBS $ r ! "Col2"