diff --git a/csv-conduit.cabal b/csv-conduit.cabal --- a/csv-conduit.cabal +++ b/csv-conduit.cabal @@ -1,16 +1,15 @@ Name: csv-conduit -Version: 0.2.1.1 -Synopsis: A flexible, fast, conduit-based CSV parser library for Haskell. +Version: 0.3 +Synopsis: A flexible, fast, conduit-based CSV parser library for Haskell. Homepage: http://github.com/ozataman/csv-conduit License: BSD3 License-file: LICENSE -Author: Ozgun Ataman +Author: Ozgun Ataman Maintainer: Ozgun Ataman Category: Data, Conduit Build-type: Simple -Cabal-version: >=1.6 +Cabal-version: >= 1.9.2 Description: - CSV files are the de-facto standard in many situations involving data transfer, particularly when dealing with enterprise application or disparate database systems. @@ -39,8 +38,8 @@ process, it has been greatly simplified thanks to the modular nature of the conduits library. - . - + . + Following the port to conduits, the library has also gained the ability to parameterize on the stream type and work both with ByteString and Text. @@ -52,35 +51,68 @@ . - + extra-source-files: README.markdown - test/csv-enumerator-test.cabal test/test.csv test/Test.hs + test/Bench.hs -Library - hs-source-dirs: src - Exposed-modules: +library + exposed-modules: Data.CSV.Conduit Data.CSV.Conduit.Parser.ByteString Data.CSV.Conduit.Parser.Text - Other-modules: + other-modules: Data.CSV.Conduit.Types + ghc-options: -Wall + hs-source-dirs: src build-depends: attoparsec >= 0.10 , attoparsec-conduit - , conduit == 0.4.* , base >= 4 && < 5 + , bytestring + , conduit == 0.5.* , containers >= 0.3 + , monad-control + , text + ghc-options: -funbox-strict-fields + +test-suite test + type: exitcode-stdio-1.0 + main-is: Test.hs + ghc-options: -Wall + hs-source-dirs: test + build-depends: + base >= 4 && < 5 + , bytestring + , containers >= 0.3 + , csv-conduit , directory + , HUnit >= 1.2 + , test-framework + , test-framework-hunit + , text + +flag bench + default: False + manual: True + +executable bench + main-is: Bench.hs + if flag(bench) + buildable: True + else + buildable: False + ghc-options: -Wall + hs-source-dirs: test + build-depends: + base >= 4 && < 5 , bytestring + , containers >= 0.3 + , csv-conduit + , directory , text - , transformers >= 0.2 - , safe - , unix-compat >= 0.2.1.1 - , monad-control - extensions: - ScopedTypeVariables - ghc-options: -funbox-strict-fields + ghc-options: -rtsopts + ghc-prof-options: -rtsopts -caf-all -auto-all diff --git a/src/Data/CSV/Conduit.hs b/src/Data/CSV/Conduit.hs --- a/src/Data/CSV/Conduit.hs +++ b/src/Data/CSV/Conduit.hs @@ -3,7 +3,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PackageImports #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeSynonymInstances #-} @@ -13,7 +12,10 @@ -- * Key Operations CSV (..) , writeHeaders + + -- * Convenience Functions , readCSVFile + , writeCSVFile , transformCSV , mapCSVFile @@ -28,31 +30,21 @@ ) where ------------------------------------------------------------------------------- -import Control.Applicative hiding (many) -import Control.Exception (SomeException, bracket) -import Control.Monad (foldM, liftM, mplus, mzero, when) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Trans.Control -import Data.Attoparsec as P hiding (take) -import qualified Data.Attoparsec.Char8 as C8 +import Data.Attoparsec.Types (Parser) import qualified Data.ByteString as B import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B8 import Data.ByteString.Internal (c2w) -import Data.Conduit as C +import Data.Conduit import Data.Conduit.Attoparsec -import Data.Conduit.Binary (sinkFile, sourceFile) +import Data.Conduit.Binary (sinkFile, sinkIOHandle, sourceFile) import qualified Data.Conduit.List as C -import Data.Conduit.Text import qualified Data.Map as M import Data.String import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T -import Data.Word (Word8) -import Safe (headMay) -import System.Directory -import System.PosixCompat.Files (fileSize, getFileStatus) +import System.IO ------------------------------------------------------------------------------- import qualified Data.CSV.Conduit.Parser.ByteString as BSP import qualified Data.CSV.Conduit.Parser.Text as TP @@ -110,13 +102,13 @@ ----------------------------------------------------------------------------- -- | Turn a stream of 's' into a stream of CSV row type. An example -- would be parsing a ByteString stream as rows of 'MapRow' 'Text'. - intoCSV :: MonadResource m => CSVSettings -> Conduit s m r + intoCSV :: MonadResource m => CSVSettings -> GLInfConduit s m r ----------------------------------------------------------------------------- -- | Turn a stream of CSV row type back into a stream of 's'. An -- example would be rendering a stream of 'Row' 'ByteString' rows as -- 'Text'. - fromCSV :: MonadResource m => CSVSettings -> Conduit r m s + fromCSV :: MonadResource m => CSVSettings -> GInfConduit r m s @@ -128,9 +120,9 @@ rowToStr s !r = let sep = B.pack [c2w (csvOutputColSep s)] - wrapField !f = case (csvOutputQuoteChar s) of + wrapField !f = case csvOutputQuoteChar s of Just !x -> x `B8.cons` escape x f `B8.snoc` x - otherwise -> f + _ -> f escape c str = B8.intercalate (B8.pack [c,c]) $ B8.split c str in B.intercalate sep . map wrapField $ r @@ -143,10 +135,10 @@ instance CSV Text (Row Text) where rowToStr s !r = let - sep = T.pack [(csvOutputColSep s)] - wrapField !f = case (csvOutputQuoteChar s) of + sep = T.pack [csvOutputColSep s] + wrapField !f = case csvOutputQuoteChar s of Just !x -> x `T.cons` escape x f `T.snoc` x - otherwise -> f + _ -> f escape c str = T.intercalate (T.pack [c,c]) $ T.split (== c) str in T.intercalate sep . map wrapField $ r @@ -158,33 +150,33 @@ -- | 'Row' instance using 'Text' based on 'ByteString' stream instance CSV ByteString (Row Text) where rowToStr s r = T.encodeUtf8 $ rowToStr s r - intoCSV set = intoCSV set =$= C.map (map T.decodeUtf8) - fromCSV set = fromCSV set =$= C.map T.encodeUtf8 + intoCSV set = intoCSV set >+> C.map (map T.decodeUtf8) + fromCSV set = fromCSV set >+> C.map T.encodeUtf8 ------------------------------------------------------------------------------- -fromCSVRow set = conduitState init push close - where - init = () - push st r = return $ StateProducing st [rowToStr set r, "\n"] - close _ = return [] +fromCSVRow :: (Monad m, IsString s, CSV s r) + => CSVSettings -> GInfConduit r m s +fromCSVRow set = do + erow <- awaitE + case erow of + Left ures -> return ures + Right row -> mapM_ yield [rowToStr set row, "\n"] >> fromCSVRow set ------------------------------------------------------------------------------- -intoCSVRow p = parser =$= puller +intoCSVRow :: (MonadThrow m, AttoparsecInput i) + => Parser i (Maybe o) -> GLInfConduit i m o +intoCSVRow p = conduitParser p >+> puller where - parser = sequenceSink () seqSink - seqSink _ = do - p <- sinkParser p - return $ Emit () [p] puller = do - inc <- await - case inc of - Nothing -> return () - Just i -> - case i of - Just i' -> yield i' >> puller + emrow <- awaitE + case emrow of + Left ures -> return ures + Right (_, mrow) -> + case mrow of + Just row -> yield row >> puller Nothing -> puller @@ -199,44 +191,53 @@ ------------------------------------------------------------------------------- -intoCSVMap set = intoCSV set =$= converter +intoCSVMap :: (Ord a, MonadResource m, CSV s [a]) + => CSVSettings -> GLInfConduit s m (MapRow a) +intoCSVMap set = intoCSV set >+> (headers >>= converter) where - converter = conduitState Nothing push close - where - push Nothing row = - case row of - [] -> return $ StateProducing Nothing [] - xs -> return $ StateProducing (Just xs) [] - push st@(Just hs) row = return $ StateProducing st [toMapCSV hs row] - toMapCSV !headers !fs = M.fromList $ zip headers fs - close _ = return [] + headers = do + mrow <- await + case mrow of + Nothing -> return [] + Just [] -> headers + Just hs -> return hs + converter hs = do + erow <- awaitE + case erow of + Left ures -> return ures + Right row -> yield (toMapCSV hs row) >> converter hs + toMapCSV !hs !fs = M.fromList $ zip hs fs ------------------------------------------------------------------------------- +fromCSVMap :: (Monad m, IsString s, CSV s [a]) + => CSVSettings -> GInfConduit (M.Map k a) m s fromCSVMap set = do - r <- C.await - case r of - Nothing -> return () - Just r' -> push r' >> fromCSVMap set - + erow <- awaitE + case erow of + Left ures -> return ures + Right row -> push row >> fromCSVMap set where - push r = mapM_ C.yield [rowToStr set (M.elems r), "\n"] + push r = mapM_ yield [rowToStr set (M.elems r), "\n"] ------------------------------------------------------------------------------- -- | Write headers AND the row into the output stream, once. Just -- chain this using the 'Monad' instance in your pipeline: -- --- > ... =$= writeHeaders settings >> fromCSV settings( $$ sinkFile "..." +-- > ... =$= writeHeaders settings >> fromCSV settings $$ sinkFile "..." writeHeaders :: (MonadResource m, CSV s (Row r), IsString s) => CSVSettings - -> Conduit (MapRow r) m s + -> GConduit (MapRow r) m s writeHeaders set = do - r <- C.await - case r of + mrow <- await + case mrow of Nothing -> return () - Just r' -> mapM_ yield [rowToStr set (M.keys r'), "\n", rowToStr set (M.elems r'), "\n"] + Just row -> mapM_ yield [ rowToStr set (M.keys row) + , "\n" + , rowToStr set (M.elems row) + , "\n" ] --------------------------- @@ -250,15 +251,36 @@ -- An easy way to run this function would be 'runResourceT' after -- feeding it all the arguments. readCSVFile - :: (MonadResource m, CSV ByteString a) + :: (CSV ByteString a) + -- ^ A CSV type that can be obtained from ByteString stream => CSVSettings + -- ^ Settings to use in deciphering stream -> FilePath -- ^ Input file - -> m [a] -readCSVFile set fp = sourceFile fp $= intoCSV set $$ C.consume + -> IO [a] +readCSVFile set fp = runResourceT $ sourceFile fp $= intoCSV set $$ C.consume + ------------------------------------------------------------------------------- +-- | Write CSV data into file. +writeCSVFile + :: (CSV ByteString a) + => CSVSettings + -- ^ CSV Settings + -> FilePath + -- ^ Target file + -> IOMode + -- ^ Write vs. append mode + -> [a] + -- ^ List of rows + -> IO () +writeCSVFile set fo fmode rows = runResourceT $ do + C.sourceList rows $= fromCSV set $$ + sinkIOHandle (openFile fo fmode) + + +------------------------------------------------------------------------------- -- | Map over the rows of a CSV file. Provided for convenience for -- historical reasons. -- @@ -309,20 +331,3 @@ fromCSV set $$ sink - - ----------------- - -- Simple Test -- - ----------------- - - - -test :: IO () -test = runResourceT $ - sourceFile "test/BigFile.csv" $= - decode utf8 $= - (intoCSV defCSVSettings - :: forall m. MonadResource m => Conduit Text m (MapRow Text)) $= - C.map (id :: MapRow Text -> MapRow Text) $= - (writeHeaders defCSVSettings >> fromCSV defCSVSettings) $= - encode utf8 $$ - sinkFile "test/BigFileOut.csv" diff --git a/src/Data/CSV/Conduit/Parser/ByteString.hs b/src/Data/CSV/Conduit/Parser/ByteString.hs --- a/src/Data/CSV/Conduit/Parser/ByteString.hs +++ b/src/Data/CSV/Conduit/Parser/ByteString.hs @@ -14,15 +14,11 @@ ------------------------------------------------------------------------------- import Control.Applicative -import Control.Monad (mzero, mplus, foldM, when, liftM) -import Control.Monad.IO.Class (liftIO, MonadIO) +import Control.Monad (mzero) import Data.Attoparsec as P hiding (take) import qualified Data.Attoparsec.Char8 as C8 -import qualified Data.ByteString as B import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B8 -import Data.ByteString.Internal (c2w) -import qualified Data.Map as M import Data.Word (Word8) ------------------------------------------------------------------------------- import Data.CSV.Conduit.Types @@ -46,11 +42,11 @@ csv s = do r <- row s end <- atEnd - case end of - True -> case r of + if end + then case r of Just x -> return [x] Nothing -> return [] - False -> do + else do rest <- csv s return $ case r of Just x -> x : rest @@ -69,7 +65,7 @@ csvrow :: CSVSettings -> Parser (Maybe (Row ByteString)) csvrow c = - let rowbody = (quotedField' <|> (field c)) `sepBy` C8.char (csvSep c) + let rowbody = (quotedField' <|> field c) `sepBy` C8.char (csvSep c) properrow = rowbody <* (C8.endOfLine <|> P.endOfInput) quotedField' = case csvQuoteChar c of Nothing -> mzero @@ -81,6 +77,7 @@ field :: CSVSettings -> Parser ByteString field s = P.takeWhile (isFieldChar s) +isFieldChar :: CSVSettings -> Word8 -> Bool isFieldChar s = notInClass xs' where xs = csvSep s : "\n\r" xs' = case csvQuoteChar s of @@ -92,9 +89,9 @@ let quoted = string dbl *> return c dbl = B8.pack [c,c] in do - C8.char c + _ <- C8.char c f <- many (C8.notChar c <|> quoted) - C8.char c + _ <- C8.char c return $ B8.pack f diff --git a/src/Data/CSV/Conduit/Parser/Text.hs b/src/Data/CSV/Conduit/Parser/Text.hs --- a/src/Data/CSV/Conduit/Parser/Text.hs +++ b/src/Data/CSV/Conduit/Parser/Text.hs @@ -14,14 +14,11 @@ ------------------------------------------------------------------------------- import Control.Applicative -import Control.Monad (foldM, liftM, mplus, mzero, when) -import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad (mzero) import Data.Attoparsec.Text as P hiding (take) import qualified Data.Attoparsec.Text as T -import qualified Data.Map as M import Data.Text (Text) import qualified Data.Text as T -import Data.Word (Word8) ------------------------------------------------------------------------------- import Data.CSV.Conduit.Types ------------------------------------------------------------------------------- @@ -45,11 +42,11 @@ csv s = do r <- row s end <- atEnd - case end of - True -> case r of + if end + then case r of Just x -> return [x] Nothing -> return [] - False -> do + else do rest <- csv s return $ case r of Just x -> x : rest @@ -68,7 +65,7 @@ csvrow :: CSVSettings -> Parser (Maybe (Row Text)) csvrow c = - let rowbody = (quotedField' <|> (field c)) `sepBy` T.char (csvSep c) + let rowbody = (quotedField' <|> field c) `sepBy` T.char (csvSep c) properrow = rowbody <* (T.endOfLine <|> P.endOfInput) quotedField' = case csvQuoteChar c of Nothing -> mzero @@ -80,6 +77,7 @@ field :: CSVSettings -> Parser Text field s = P.takeWhile (isFieldChar s) +isFieldChar :: CSVSettings -> Char -> Bool isFieldChar s = notInClass xs' where xs = csvSep s : "\n\r" xs' = case csvQuoteChar s of @@ -90,9 +88,9 @@ quotedField c = do let quoted = string dbl *> return c dbl = T.pack [c,c] - T.char c + _ <- T.char c f <- many (T.notChar c <|> quoted) - T.char c + _ <- T.char c return $ T.pack f diff --git a/src/Data/CSV/Conduit/Types.hs b/src/Data/CSV/Conduit/Types.hs --- a/src/Data/CSV/Conduit/Types.hs +++ b/src/Data/CSV/Conduit/Types.hs @@ -1,12 +1,9 @@ -{-# LANGUAGE OverloadedStrings, BangPatterns #-} -{-# LANGUAGE PackageImports #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} module Data.CSV.Conduit.Types where ------------------------------------------------------------------------------- -import qualified Data.ByteString as B -import Data.Text (Text) import qualified Data.Map as M ------------------------------------------------------------------------------- diff --git a/test/Bench.hs b/test/Bench.hs new file mode 100644 --- /dev/null +++ b/test/Bench.hs @@ -0,0 +1,21 @@ + +module Main where + +import qualified Data.ByteString.Char8 as B +import Data.Map ((!)) +import Data.Text +import System.Directory +import System.Environment +import Data.CSV.Conduit + + +main = do + inPath:_ <- getArgs + runResourceT $ mapCSVFile defCSVSettings idF inPath outPath + removeFile outPath + where + outPath = "test/testOut.csv" + + +idF :: Row Text -> [Row Text] +idF = return . id diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,57 +1,59 @@ +{-# LANGUAGE OverloadedStrings #-} module Main where import qualified Data.ByteString.Char8 as B import Data.Map ((!)) +import Data.Text import System.Directory - -import Test.Framework (defaultMain, testGroup) +import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.HUnit -import Test.Framework.Providers.QuickCheck2 (testProperty) - -import Test.QuickCheck -import Test.HUnit - +import Test.HUnit ((@=?)) -import Data.CSV.Enumerator +import Data.CSV.Conduit +main :: IO () main = defaultMain tests -tests = [ testGroup "Basic Ops" baseTests ] - +tests :: [Test] +tests = [testGroup "Basic Ops" baseTests] -baseTests = [ - testCase "mapping with id works" test_identityMap +baseTests :: [Test] +baseTests = + [ testCase "mapping with id works" test_identityMap , testCase "simple parsing works" test_simpleParse ] - +test_identityMap :: IO () test_identityMap = do - Right r <- mapCSVFile "test.csv" csvSettings f "testOut.csv" - 3 @=? r - f1 <- readFile "test.csv" - f2 <- readFile "testOut.csv" - f1 @=? f2 - removeFile "testOut.csv" - where - f :: MapRow -> [MapRow] + _ <- runResourceT $ mapCSVFile csvSettings f testFile outFile + f1 <- readFile testFile + f2 <- readFile outFile + f1 @=? f2 + removeFile outFile + where + outFile = "test/testOut.csv" + f :: Row Text -> [Row Text] f = return - +test_simpleParse :: IO () test_simpleParse = do - Right (d :: [MapRow]) <- readCSVFile csvSettings "test.csv" + (d :: [MapRow B.ByteString]) <- runResourceT + $ readCSVFile csvSettings testFile mapM_ assertRow d where assertRow r = v3 @=? (v1 + v2) where v1 = readBS $ r ! "Col2" - v2 = readBS $ r ! "Col3" - v3 = readBS $ r ! "Sum" - + v2 = readBS $ r ! "Col3" + v3 = readBS $ r ! "Sum" -csvSettings = - defCSVSettings { csvQuoteChar = Just '`' - , csvOutputQuoteChar = Just '`' } +csvSettings :: CSVSettings +csvSettings = defCSVSettings { csvQuoteChar = Just '`' + , csvOutputQuoteChar = Just '`' } +testFile :: FilePath +testFile = "test/test.csv" +readBS :: B.ByteString -> Int readBS = read . B.unpack diff --git a/test/csv-enumerator-test.cabal b/test/csv-enumerator-test.cabal deleted file mode 100644 --- a/test/csv-enumerator-test.cabal +++ /dev/null @@ -1,69 +0,0 @@ -Name: csv-enumerator-test -Version: 0.8.2 -Synopsis: A flexible, fast, enumerator-based CSV parser library for Haskell. -Homepage: http://github.com/ozataman/csv-enumerator -License: BSD3 -License-file: LICENSE -Author: Ozgun Ataman -Maintainer: Ozgun Ataman -Category: Data -Build-type: Simple -Cabal-version: >=1.2 - -extra-source-files: - README.markdown - -Executable test - main-is: Test.hs - hs-source-dirs: ./ ../src - Other-modules: - Data.CSV.Enumerator.Types - Data.CSV.Enumerator - build-depends: - attoparsec >= 0.8 && < 0.10 - , attoparsec-enumerator >= 0.2.0.3 - , base >= 4 && < 5 - , containers >= 0.3 - , directory - , bytestring - , enumerator >= 0.4.5 && < 0.5 - , transformers >= 0.2 - , safe - , unix-compat >= 0.2.1.1 - , test-framework - , test-framework-quickcheck2 - , test-framework-hunit - , QuickCheck >= 2 - , HUnit >= 1.2 - extensions: - ScopedTypeVariables - OverloadedStrings - - -Executable bench - main-is: Bench.hs - hs-source-dirs: ./ ../src - Other-modules: - Data.CSV.Enumerator.Types - Data.CSV.Enumerator - build-depends: - attoparsec >= 0.8 && < 0.10 - , attoparsec-enumerator >= 0.2.0.3 - , base >= 4 && < 5 - , containers >= 0.3 - , directory - , bytestring - , enumerator >= 0.4.5 && < 0.5 - , transformers >= 0.2 - , safe - , unix-compat >= 0.2.1.1 - , test-framework - , test-framework-quickcheck2 - , test-framework-hunit - , QuickCheck >= 2 - , HUnit >= 1.2 - extensions: - ScopedTypeVariables - OverloadedStrings - ghc-options: -rtsopts - ghc-prof-options: -rtsopts -caf-all -auto-all