csv-conduit-0.5.1/0000755000000000000000000000000012123173720012137 5ustar0000000000000000csv-conduit-0.5.1/csv-conduit.cabal0000644000000000000000000000561012123173720015363 0ustar0000000000000000Name: csv-conduit Version: 0.5.1 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 Maintainer: Ozgun Ataman Category: Data, Conduit, CSV, Text Build-type: Simple Cabal-version: >= 1.9.2 Tested-with: GHC == 7.6.1 Description: CSV files are the de-facto standard in many situations involving data transfer, particularly when dealing with enterprise application or disparate database systems. . While there are a number of CSV libraries in Haskell, at the time of this project's start in 2010, there wasn't one that provided all of the following: . * Full flexibility in quote characters, separators, input/output . * Constant space operation . * Robust parsing, correctness and error resiliency . * Convenient interface that supports a variety of use cases . * Fast operation . This library is an attempt to close these gaps. Please note that this library started its life based on the enumerator package and has recently been ported to work with conduits instead. In the 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. . For more documentation and examples, check out the README at: . . extra-source-files: README.markdown test/test.csv test/Test.hs test/Bench.hs library exposed-modules: Data.CSV.Conduit Data.CSV.Conduit.Parser.ByteString Data.CSV.Conduit.Parser.Text other-modules: Data.CSV.Conduit.Types ghc-options: -Wall hs-source-dirs: src build-depends: attoparsec >= 0.10 , attoparsec-conduit >= 0.5.0.2 , base >= 4 && < 5 , bytestring , conduit >= 1.0 && < 2.0 , containers >= 0.3 , monad-control , text , data-default ghc-options: -funbox-strict-fields ghc-prof-options: -fprof-auto 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 ghc-options: -rtsopts ghc-prof-options: -rtsopts -caf-all -auto-all csv-conduit-0.5.1/LICENSE0000644000000000000000000000276112123173720013152 0ustar0000000000000000Copyright (c)2010, Ozgun Ataman 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 Ozgun Ataman 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. csv-conduit-0.5.1/README.markdown0000644000000000000000000000677612123173720014660 0ustar0000000000000000# README ## CSV Files and Haskell CSV files are the de-facto standard in many cases of data transfer, particularly when dealing with enterprise application or disparate database systems. While there are a number of csv libraries in Haskell, at the time of this project's start, there wasn't one that provided all of the following: * Full flexibility in quote characters, separators, input/output * Constant space operation * Robust parsing and error resiliency * Battle-tested reliability in real-world datasets * Fast operation * Convenient interface that supports a variety of use cases Over time, people created other plausible CSV packages like cassava. The major benefit from this library remains to be: * Direct participation in the conduit ecosystem, which is now quite large, and all the benefits that come with it. * Flexibility in CSV format definition. * Resiliency to errors in the input data. ## This package csv-conduit is a conduit-based CSV parsing library that is easy to use, flexible and fast. It leverages the conduit infrastructure to provide constant-space operation, which is quite critical in many real world use cases. For example, you can use http-conduit to download a CSV file from the internet and plug its Source into intoCSV to stream-convert the download into the Row data type and do something with it as the data streams, that is without having to download the entire file to disk first. ## Author & Contributors - Ozgun Ataman (@ozataman) - Daniel Bergey (@bergey) - BJTerry (@BJTerry) - Mike Craig (@mkscrg) - Daniel Corson (@dancor) - Dmitry Dzhus (@dzhus) - Niklas Hambüchen (@nh2) ### Introduction * The CSVeable typeclass implements the key operations. * CSVeable is parameterized on both a stream type and a target CSV row type. * There are 2 basic row types and they implement *exactly* the same operations, so you can chose the right one for the job at hand: - type MapRow t = Map t t - type Row t = [t] * You basically use the Conduits defined in this library to do the parsing from a CSV stream and rendering back into a CSV stream. * Use the full flexibility and modularity of conduits for sources and sinks. ### Speed While fast operation is of concern, I have so far cared more about correct operation and a flexible API. Please let me know if you notice any performance regressions or optimization opportunities. ### Usage Examples #### Example #1: Basics Using Convenience API {-# LANGUAGE OverloadedStrings #-} import Data.Conduit import Data.Conduit.Binary import Data.Conduit.List as CL import Data.CSV.Conduit import Data.Text (Text) -- Just reverse te columns myProcessor :: Monad m => Conduit (Row Text) m (Row Text) myProcessor = CL.map reverse test :: IO () test = runResourceT $ transformCSV defCSVSettings (sourceFile "input.csv") myProcessor (sinkFile "output.csv") #### Example #2: Basics Using Conduit API {-# LANGUAGE OverloadedStrings #-} import Data.Conduit import Data.Conduit.Binary import Data.CSV.Conduit import Data.Text (Text) myProcessor :: Conduit (Row Text) m (Row Text) myProcessor = undefined -- Let's simply stream from a file, parse the CSV, reserialize it -- and push back into another file. test :: IO () test = runResourceT $ sourceFile "test/BigFile.csv" $= intoCSV defCSVSettings $= myProcessor $= fromCSV defCSVSettings $$ sinkFile "test/BigFileOut.csv" csv-conduit-0.5.1/Setup.hs0000644000000000000000000000005612123173720013574 0ustar0000000000000000import Distribution.Simple main = defaultMain csv-conduit-0.5.1/src/0000755000000000000000000000000012123173720012726 5ustar0000000000000000csv-conduit-0.5.1/src/Data/0000755000000000000000000000000012123173720013577 5ustar0000000000000000csv-conduit-0.5.1/src/Data/CSV/0000755000000000000000000000000012123173720014232 5ustar0000000000000000csv-conduit-0.5.1/src/Data/CSV/Conduit.hs0000644000000000000000000002456212123173720016204 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeSynonymInstances #-} module Data.CSV.Conduit ( -- * Key Operations CSV (..) , writeHeaders -- * Convenience Functions , readCSVFile , writeCSVFile , transformCSV , mapCSVFile -- * Important Types , CSVSettings (..) , defCSVSettings , MapRow , Row -- * Re-exported For Convenience , runResourceT ) where ------------------------------------------------------------------------------- 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 import Data.Conduit.Attoparsec import Data.Conduit.Binary (sinkFile, sinkIOHandle, sourceFile) import qualified Data.Conduit.List as C 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 System.IO ------------------------------------------------------------------------------- import qualified Data.CSV.Conduit.Parser.ByteString as BSP import qualified Data.CSV.Conduit.Parser.Text as TP import Data.CSV.Conduit.Types ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- -- | Represents types 'r' that are CSV-like and can be converted -- to/from an underlying stream of type 's'. -- -- -- Example #1: Basics Using Convenience API -- -- >import Data.Conduit -- >import Data.Conduit.Binary -- >import Data.Conduit.List as CL -- >import Data.CSV.Conduit -- > -- >myProcessor :: Conduit (Row Text) m (Row Text) -- >myProcessor = CL.map reverse -- > -- >test = runResourceT $ -- > transformCSV defCSVSettings -- > (sourceFile "input.csv") -- > myProcessor -- > (sinkFile "output.csv") -- -- -- Example #2: Basics Using Conduit API -- -- >import Data.Conduit -- >import Data.Conduit.Binary -- >import Data.CSV.Conduit -- > -- >myProcessor :: Conduit (MapRow Text) m (MapRow Text) -- >myProcessor = undefined -- > -- >test = runResourceT $ -- > sourceFile "test/BigFile.csv" $= -- > intoCSV defCSVSettings $= -- > myProcessor $= -- > (writeHeaders defCSVSettings >> fromCSV defCSVSettings) $$ -- > sinkFile "test/BigFileOut.csv" class CSV s r where ----------------------------------------------------------------------------- -- | Convert a CSV row into strict ByteString equivalent. rowToStr :: CSVSettings -> r -> s ----------------------------------------------------------------------------- -- | 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 :: (MonadThrow m) => CSVSettings -> Conduit 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 :: Monad m => CSVSettings -> Conduit r m s ------------------------------------------------------------------------------ -- | 'Row' instance using 'ByteString' instance CSV ByteString (Row ByteString) where rowToStr s !r = let sep = B.pack [c2w (csvSep s)] wrapField !f = case csvQuoteChar s of Just !x -> (x `B8.cons` escape x f) `B8.snoc` x _ -> f escape c str = B8.intercalate (B8.pack [c,c]) $ B8.split c str in B.intercalate sep . map wrapField $ r intoCSV set = intoCSVRow (BSP.row set) fromCSV set = fromCSVRow set ------------------------------------------------------------------------------ -- | 'Row' instance using 'Text' instance CSV Text (Row Text) where rowToStr s !r = let sep = T.pack [csvSep s] wrapField !f = case csvQuoteChar s of Just !x -> x `T.cons` escape x f `T.snoc` x _ -> f escape c str = T.intercalate (T.pack [c,c]) $ T.split (== c) str in T.intercalate sep . map wrapField $ r intoCSV set = intoCSVRow (TP.row set) fromCSV set = fromCSVRow set ------------------------------------------------------------------------------- -- | '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 ------------------------------------------------------------------------------- -- | 'Row' instance using 'String' based on 'ByteString' stream. -- Please note this uses the ByteString operations underneath and has -- lots of unnecessary overhead. Included for convenience. instance CSV ByteString (Row String) where rowToStr s r = rowToStr s $ map B8.pack r intoCSV set = intoCSV set =$= C.map (map B8.unpack) fromCSV set = C.map (map B8.pack) =$= 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 p = parse =$= puller where parse = {-# SCC "conduitParser_p" #-} conduitParser p puller = {-# SCC "puller" #-} awaitForever $ \ (_, mrow) -> maybe (return ()) yield mrow ------------------------------------------------------------------------------- -- | Generic 'MapRow' instance; any stream type with a 'Row' instance -- automatically gets a 'MapRow' instance. instance (CSV s (Row s'), Ord s', IsString s) => CSV s (MapRow s') where rowToStr s r = rowToStr s . M.elems $ r intoCSV set = intoCSVMap set fromCSV set = fromCSVMap set ------------------------------------------------------------------------------- intoCSVMap :: (Ord a, MonadThrow m, CSV s [a]) => CSVSettings -> Conduit s m (MapRow a) intoCSVMap set = intoCSV set =$= (headers >>= converter) where headers = do mrow <- await case mrow of Nothing -> return [] Just [] -> headers Just hs -> return hs converter hs = awaitForever $ yield . toMapCSV hs toMapCSV !hs !fs = M.fromList $ zip hs fs ------------------------------------------------------------------------------- fromCSVMap :: (Monad m, IsString s, CSV s [a]) => CSVSettings -> Conduit (M.Map k a) m s fromCSVMap set = awaitForever push where 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 :: (Monad m, CSV s (Row r), IsString s) => CSVSettings -> Conduit (MapRow r) m s writeHeaders set = do mrow <- await case mrow of Nothing -> return () Just row -> mapM_ yield [ rowToStr set (M.keys row) , "\n" , rowToStr set (M.elems row) , "\n" ] --------------------------- -- Convenience Functions -- --------------------------- ------------------------------------------------------------------------------- -- | Read the entire contents of a CSV file into memory. readCSVFile :: (CSV ByteString a) => CSVSettings -- ^ Settings to use in deciphering stream -> FilePath -- ^ Input file -> 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. -- -- An easy way to run this function would be 'runResourceT' after -- feeding it all the arguments. mapCSVFile :: (MonadResource m, MonadThrow m, CSV ByteString a, CSV ByteString b) => CSVSettings -- ^ Settings to use both for both input and output -> (a -> [b]) -- ^ A mapping function -> FilePath -- ^ Input file -> FilePath -- ^ Output file -> m () mapCSVFile set f fi fo = transformCSV set (sourceFile fi) (C.concatMap f) (sinkFile fo) ------------------------------------------------------------------------------- -- | General purpose CSV transformer. Apply a list-like processing -- function from 'Data.Conduit.List' to the rows of a CSV stream. You -- need to provide a stream data source, a transformer and a stream -- data sink. -- -- An easy way to run this function would be 'runResourceT' after -- feeding it all the arguments. -- -- Example - map a function over the rows of a CSV file: -- -- > transformCSV set (sourceFile inFile) (C.map f) (sinkFile outFile) transformCSV :: (MonadThrow m, CSV s a, CSV s' b) => CSVSettings -- ^ Settings to be used for both input and output -> Source m s -- ^ A raw stream data source. Ex: 'sourceFile inFile' -> Conduit a m b -- ^ A transforming conduit -> Sink s' m () -- ^ A raw stream data sink. Ex: 'sinkFile outFile' -> m () transformCSV set source c sink = source $= intoCSV set $= c $= fromCSV set $$ sink csv-conduit-0.5.1/src/Data/CSV/Conduit/0000755000000000000000000000000012123173720015637 5ustar0000000000000000csv-conduit-0.5.1/src/Data/CSV/Conduit/Types.hs0000644000000000000000000000303012123173720017273 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} module Data.CSV.Conduit.Types where ------------------------------------------------------------------------------- import Data.Default import qualified Data.Map as M ------------------------------------------------------------------------------- ------------------------------------------------------------------------------- -- | Settings for a CSV file. This library is intended to be flexible -- and offer a way to process the majority of text data files out -- there. data CSVSettings = CSVSettings { -- | Separator character to be used in between fields csvSep :: !Char -- | Quote character that may sometimes be present around fields. -- If 'Nothing' is given, the library will never expect quotation -- even if it is present. , csvQuoteChar :: !(Maybe Char) } deriving (Read, Show, Eq) ------------------------------------------------------------------------------- -- | Default settings for a CSV file. -- -- > csvSep = ',' -- > csvQuoteChar = Just '"' -- defCSVSettings :: CSVSettings defCSVSettings = CSVSettings { csvSep = ',' , csvQuoteChar = Just '"' } instance Default CSVSettings where def = defCSVSettings ------------------------------------------------------------------------------- -- | A 'Row' is just a list of fields type Row a = [a] ------------------------------------------------------------------------------- -- | A 'MapRow' is a dictionary based on 'Data.Map' type MapRow a = M.Map a a csv-conduit-0.5.1/src/Data/CSV/Conduit/Parser/0000755000000000000000000000000012123173720017073 5ustar0000000000000000csv-conduit-0.5.1/src/Data/CSV/Conduit/Parser/ByteString.hs0000644000000000000000000000535412123173720021530 0ustar0000000000000000{-| This module exports the underlying Attoparsec row parser. This is helpful if you want to do some ad-hoc CSV string parsing. -} module Data.CSV.Conduit.Parser.ByteString ( parseCSV , parseRow , row , csv ) where ------------------------------------------------------------------------------- import Control.Applicative import Control.Monad (mzero) import Data.Attoparsec as P hiding (take) import qualified Data.Attoparsec.Char8 as C8 import Data.ByteString.Char8 (ByteString) import qualified Data.ByteString.Char8 as B8 import Data.Word (Word8) ------------------------------------------------------------------------------- import Data.CSV.Conduit.Types ------------------------------------------------------------------------------ -- | Try to parse given string as CSV parseCSV :: CSVSettings -> ByteString -> Either String [Row ByteString] parseCSV s = parseOnly $ csv s ------------------------------------------------------------------------------ -- | Try to parse given string as 'Row ByteString' parseRow :: CSVSettings -> ByteString -> Either String (Maybe (Row ByteString)) parseRow s = parseOnly $ row s ------------------------------------------------------------------------------ -- | Parse CSV csv :: CSVSettings -> Parser [Row ByteString] csv s = do r <- row s end <- atEnd if end then case r of Just x -> return [x] Nothing -> return [] else do rest <- csv s return $ case r of Just x -> x : rest Nothing -> rest ------------------------------------------------------------------------------ -- | Parse a CSV row row :: CSVSettings -> Parser (Maybe (Row ByteString)) row csvs = csvrow csvs <|> badrow badrow :: Parser (Maybe (Row ByteString)) badrow = P.takeWhile (not . C8.isEndOfLine) *> (C8.endOfLine <|> C8.endOfInput) *> return Nothing csvrow :: CSVSettings -> Parser (Maybe (Row ByteString)) csvrow c = let rowbody = (quotedField' <|> field c) `sepBy` C8.char (csvSep c) properrow = rowbody <* (C8.endOfLine <|> P.endOfInput) quotedField' = case csvQuoteChar c of Nothing -> mzero Just q' -> try (quotedField q') in do res <- properrow return $ Just res 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 Nothing -> xs Just x -> x : xs quotedField :: Char -> Parser ByteString quotedField c = let quoted = string dbl *> return c dbl = B8.pack [c,c] in do _ <- C8.char c f <- many (C8.notChar c <|> quoted) _ <- C8.char c return $ B8.pack f csv-conduit-0.5.1/src/Data/CSV/Conduit/Parser/Text.hs0000644000000000000000000000530612123173720020357 0ustar0000000000000000{-| This module exports the underlying Attoparsec row parser. This is helpful if you want to do some ad-hoc CSV string parsing. -} module Data.CSV.Conduit.Parser.Text ( parseCSV , parseRow , row , csv ) where ------------------------------------------------------------------------------- import Control.Applicative import Control.Monad (mzero) import Data.Attoparsec.Text as P hiding (take) import qualified Data.Attoparsec.Text as T import Data.Text (Text) import qualified Data.Text as T ------------------------------------------------------------------------------- import Data.CSV.Conduit.Types ------------------------------------------------------------------------------- ------------------------------------------------------------------------------ -- | Try to parse given string as CSV parseCSV :: CSVSettings -> Text -> Either String [Row Text] parseCSV s = parseOnly $ csv s ------------------------------------------------------------------------------ -- | Try to parse given string as 'Row Text' parseRow :: CSVSettings -> Text -> Either String (Maybe (Row Text)) parseRow s = parseOnly $ row s ------------------------------------------------------------------------------ -- | Parse CSV csv :: CSVSettings -> Parser [Row Text] csv s = do r <- row s end <- atEnd if end then case r of Just x -> return [x] Nothing -> return [] else do rest <- csv s return $ case r of Just x -> x : rest Nothing -> rest ------------------------------------------------------------------------------ -- | Parse a CSV row row :: CSVSettings -> Parser (Maybe (Row Text)) row csvs = csvrow csvs <|> badrow badrow :: Parser (Maybe (Row Text)) badrow = P.takeWhile (not . T.isEndOfLine) *> (T.endOfLine <|> T.endOfInput) *> return Nothing csvrow :: CSVSettings -> Parser (Maybe (Row Text)) csvrow c = let rowbody = (quotedField' <|> field c) `sepBy` T.char (csvSep c) properrow = rowbody <* (T.endOfLine <|> P.endOfInput) quotedField' = case csvQuoteChar c of Nothing -> mzero Just q' -> try (quotedField q') in do res <- properrow return $ Just res 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 Nothing -> xs Just x -> x : xs quotedField :: Char -> Parser Text quotedField c = do let quoted = string dbl *> return c dbl = T.pack [c,c] _ <- T.char c f <- many (T.notChar c <|> quoted) _ <- T.char c return $ T.pack f csv-conduit-0.5.1/test/0000755000000000000000000000000012123173720013116 5ustar0000000000000000csv-conduit-0.5.1/test/Bench.hs0000644000000000000000000000060712123173720014474 0ustar0000000000000000 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 csv-conduit-0.5.1/test/test.csv0000644000000000000000000000020412123173720014606 0ustar0000000000000000`Col1`,`Col2`,`Col3`,`Sum` `A`,`2`,`3`,`5` `B`,`3`,`4`,`7` `Field using the quote char ``this is the in-quoted value```,`4`,`5`,`9` csv-conduit-0.5.1/test/Test.hs0000644000000000000000000000301312123173720014366 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Main where import qualified Data.ByteString.Char8 as B import Data.Map ((!)) import Data.Text import System.Directory import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.HUnit import Test.HUnit ((@=?)) import Data.CSV.Conduit main :: IO () main = defaultMain tests tests :: [Test] tests = [testGroup "Basic Ops" baseTests] baseTests :: [Test] baseTests = [ testCase "mapping with id works" test_identityMap , testCase "simple parsing works" test_simpleParse ] test_identityMap :: IO () test_identityMap = do _ <- runResourceT $ mapCSVFile csvSettings f testFile2 outFile f1 <- readFile testFile2 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 (d :: [MapRow B.ByteString]) <- readCSVFile csvSettings testFile1 mapM_ assertRow d where assertRow r = v3 @=? (v1 + v2) where v1 = readBS $ r ! "Col2" v2 = readBS $ r ! "Col3" v3 = readBS $ r ! "Sum" csvSettings :: CSVSettings csvSettings = defCSVSettings { csvQuoteChar = Just '`'} testFile1, testFile2 :: FilePath testFile1 = "test/test.csv" testFile2 = "test/test.csv" readBS :: B.ByteString -> Int readBS = read . B.unpack