cassava-streams (empty) → 0.1.0.0
raw patch · 12 files changed
+712/−0 lines, 12 filesdep +QuickCheckdep +basedep +bytestringsetup-changed
Dependencies added: QuickCheck, base, bytestring, cassava, cassava-streams, io-streams, tasty, tasty-quickcheck, vector
Files
- CHANGELOG +3/−0
- LICENSE +30/−0
- README.md +6/−0
- Setup.hs +2/−0
- bin/tutorial.hs +29/−0
- cassava-streams.cabal +96/−0
- src/System/IO/Streams/Csv.hs +48/−0
- src/System/IO/Streams/Csv/Decode.hs +161/−0
- src/System/IO/Streams/Csv/Encode.hs +91/−0
- src/System/IO/Streams/Csv/Tutorial.hs +138/−0
- test/simple.csv +3/−0
- test/test.hs +105/−0
+ CHANGELOG view
@@ -0,0 +1,3 @@+2014-04-30 Peter Jones <pjones@devalot.com>++ * cassava-streams initial release (version 0.1.0.0).
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014 Peter Jones <pjones@devalot.com>++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 Peter Jones 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.
+ README.md view
@@ -0,0 +1,6 @@+# cassava-streams++[io-streams][] interface for the [cassava][] CSV library.++[io-streams]: http://hackage.haskell.org/package/io-streams+[cassava]: https://hackage.haskell.org/package/cassava
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bin/tutorial.hs view
@@ -0,0 +1,29 @@+{-++This file is part of the Haskell package cassava-streams. It is+subject to the license terms in the LICENSE file found in the+top-level directory of this distribution and at+git://pmade.com/cassava-streams/LICENSE. No part of cassava-streams+package, including this file, may be copied, modified, propagated, or+distributed except according to the terms contained in the LICENSE+file.++-}++--------------------------------------------------------------------------------+module Main (main) where++--------------------------------------------------------------------------------+import System.Environment+import System.IO+import System.IO.Streams.Csv.Tutorial++--------------------------------------------------------------------------------+main :: IO ()+main = do+ args <- getArgs++ case args of+ ["todo"] -> onlyTodo stdin stdout+ ["done", x] -> markDone x stdin stdout+ _ -> fail "give one of todo or done"
+ cassava-streams.cabal view
@@ -0,0 +1,96 @@+--------------------------------------------------------------------------------+name: cassava-streams+version: 0.1.0.0+synopsis: io-streams interface for the cassava CSV library.+license: BSD3+license-file: LICENSE+author: Peter Jones <pjones@devalot.com>+maintainer: Peter Jones <pjones@devalot.com>+copyright: Copyright (c) 2014 Peter Jones+category: Data, Text, CSV, IO-Streams+build-type: Simple+cabal-version: >=1.10+tested-with: GHC==7.8.2+homepage: https://github.com/pjones/cassava-streams+bug-reports: https://github.com/pjones/cassava-streams/issues+description:+ The cassava-streams library glues togeter the cassava CSV library+ and the io-streams streaming library.+ .+ See the "System.IO.Streams.Csv.Tutorial" module for a simple tutorial.++--------------------------------------------------------------------------------+extra-source-files:+ README.md+ CHANGELOG+ test/simple.csv++--------------------------------------------------------------------------------+source-repository head+ type: git+ location: https://github.com/pjones/cassava-streams.git++--------------------------------------------------------------------------------+flag maintainer+ description: Enable settings for the package maintainer.+ default: False++--------------------------------------------------------------------------------+flag tutorial+ description: Build the tutorial binary (useful for profiling).+ default: False++--------------------------------------------------------------------------------+library+ exposed-modules:+ System.IO.Streams.Csv+ System.IO.Streams.Csv.Tutorial+ other-modules:+ System.IO.Streams.Csv.Encode+ System.IO.Streams.Csv.Decode++ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -O2 -Wall -fwarn-incomplete-uni-patterns+ ghc-prof-options: -prof -auto-all++ if flag(maintainer)+ ghc-options: -Werror++ build-depends: base >= 4.6 && < 5.0+ , bytestring >= 0.10 && < 1.0+ , cassava >= 0.4 && < 0.5+ , io-streams >= 1.1.0 && < 2.0+ , vector >= 0.10 && < 1.0++--------------------------------------------------------------------------------+executable tutorial+ default-language: Haskell2010+ hs-source-dirs: bin+ main-is: tutorial.hs+ ghc-options: -O2 -Wall -Werror -rtsopts+ ghc-prof-options: -fprof-auto-top -fprof-cafs++ if !flag(tutorial)+ buildable: False+ else+ build-depends: base+ , cassava-streams+ , io-streams++--------------------------------------------------------------------------------+test-suite test+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: test+ main-is: test.hs+ ghc-options: -O2 -Wall -Werror+ build-depends: base+ , QuickCheck >= 2.7 && < 3.0+ , bytestring+ , cassava+ , cassava-streams+ , io-streams+ , tasty >= 0.8 && < 1.0+ , tasty-quickcheck >= 0.8 && < 1.0+ , vector
+ src/System/IO/Streams/Csv.hs view
@@ -0,0 +1,48 @@+{-++This file is part of the Haskell package cassava-streams. It is+subject to the license terms in the LICENSE file found in the+top-level directory of this distribution and at+git://pmade.com/cassava-streams/LICENSE. No part of cassava-streams+package, including this file, may be copied, modified, propagated, or+distributed except according to the terms contained in the LICENSE+file.++-}++--------------------------------------------------------------------------------+-- | This module exports functions which can be used to read instances+-- of the cassava classes @FromRecord@ and @FromNamedRecord@ from an+-- io-streams @InputStream ByteString@.+--+-- It also exports functions which can write instances of @ToRecord@+-- and @ToNamedRecord@ to an io-streams @OutputStream ByteString@.+--+-- See the "System.IO.Streams.Csv.Tutorial" module for a simple tutorial.+module System.IO.Streams.Csv+ ( -- * Decoding CSV+ -- | These functions convert an io-streams @InputStream+ -- ByteString@ stream into one that decodes CSV records and+ -- produces these decoded records.+ --+ -- Each of the decoding functions produce an @InputStream@+ -- which yields an @Either@ value. @Left String@ represents+ -- a record which failed type conversion. @Right a@ is a+ -- successfully decoded record.+ --+ -- See the tutorial in "System.IO.Streams.Csv.Tutorial" for+ -- details on how to use the 'onlyValidRecords' function to+ -- transform the decoding streams so that they only produce+ -- valid records and throw exceptions for bad records.+ module System.IO.Streams.Csv.Decode++ -- * Encoding CSV+ -- | These functions convert an io-streams @OutputStream+ -- ByteString@ stream into one that encodes records into CSV+ -- format before sending them downstream.+ , module System.IO.Streams.Csv.Encode+ ) where++--------------------------------------------------------------------------------+import System.IO.Streams.Csv.Decode+import System.IO.Streams.Csv.Encode
+ src/System/IO/Streams/Csv/Decode.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE DeriveDataTypeable #-}++{-++This file is part of the Haskell package cassava-streams. It is+subject to the license terms in the LICENSE file found in the+top-level directory of this distribution and at+git://pmade.com/cassava-streams/LICENSE. No part of cassava-streams+package, including this file, may be copied, modified, propagated, or+distributed except according to the terms contained in the LICENSE+file.++-}++--------------------------------------------------------------------------------+module System.IO.Streams.Csv.Decode+ ( StreamDecodingError (..)+ , decodeStream+ , decodeStreamWith+ , decodeStreamByName+ , decodeStreamByNameWith+ , onlyValidRecords+ ) where++--------------------------------------------------------------------------------+import Control.Exception+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Csv hiding (Parser, decodeWith, decodeByNameWith)+import Data.Csv.Incremental+import Data.IORef+import Data.Typeable+import System.IO.Streams (InputStream, makeInputStream)+import qualified System.IO.Streams as Streams++--------------------------------------------------------------------------------+-- | Exception thrown when stream decoding cannot continue due to an+-- error.+data StreamDecodingError = StreamDecodingError String+ deriving (Typeable, Show)++instance Exception StreamDecodingError++--------------------------------------------------------------------------------+-- | Create an @InputStream@ which decodes CSV records from the given+-- upstream data source.+--+-- Equivalent to @decodeStreamWith defaultDecodeOptions@.+decodeStream :: (FromRecord a)+ => HasHeader+ -- ^ Whether to skip a header or not.+ -> InputStream ByteString+ -- ^ Upstream.+ -> IO (InputStream (Either String a))+ -- ^ An @InputStream@ which produces records.+decodeStream = decodeStreamWith defaultDecodeOptions++--------------------------------------------------------------------------------+-- | Create an @InputStream@ which decodes CSV records from the given+-- upstream data source.+decodeStreamWith :: (FromRecord a)+ => DecodeOptions+ -- ^ CSV decoding options.+ -> HasHeader+ -- ^ Whether to skip a header or not.+ -> InputStream ByteString+ -- ^ Upstream.+ -> IO (InputStream (Either String a))+ -- ^ An @InputStream@ which produces records.+decodeStreamWith ops hdr input = do+ queue <- newIORef []+ parser <- newIORef $ Just (decodeWith ops hdr)+ makeInputStream (dispatch queue parser input)++--------------------------------------------------------------------------------+-- | Create an @InputStream@ which decodes CSV records from the given+-- upstream data source. Data should be preceded by a header.+--+-- Equivalent to @decodeStreamByNameWith defaultDecodeOptions@.+decodeStreamByName :: (FromNamedRecord a)+ => InputStream ByteString+ -- ^ Upstream.+ -> IO (InputStream (Either String a))+ -- ^ An @InputStream@ which produces records.+decodeStreamByName = decodeStreamByNameWith defaultDecodeOptions++--------------------------------------------------------------------------------+-- | Create an @InputStream@ which decodes CSV records from the given+-- upstream data source. Data should be preceded by a header.+decodeStreamByNameWith :: (FromNamedRecord a)+ => DecodeOptions+ -- ^ CSV decoding options.+ -> InputStream ByteString+ -- ^ Upstream.+ -> IO (InputStream (Either String a))+ -- ^ An @InputStream@ which produces records.+decodeStreamByNameWith ops input = go (decodeByNameWith ops) where+ -- Dispatch on the HeaderParser type.+ go (FailH _ e) = bomb e+ go (PartialH f) = Streams.read input >>= go . maybe (f BS.empty) f+ go (DoneH _ p) = do+ queue <- newIORef []+ parser <- newIORef (Just p)+ makeInputStream (dispatch queue parser input)++--------------------------------------------------------------------------------+-- | Creates a new @InputStream@ which only sends valid CSV records+-- downstream. The first invalid record will throw an exception.+onlyValidRecords :: InputStream (Either String a)+ -- ^ Upstream.+ -> IO (InputStream a)+ -- ^ An @InputStream@ which only produces valid+ -- records.+onlyValidRecords input = makeInputStream $ do+ upstream <- Streams.read input++ case upstream of+ Nothing -> return Nothing+ Just (Left err) -> bomb err+ Just (Right x) -> return (Just x)++--------------------------------------------------------------------------------+-- | Internal function which feeds data to the CSV parser.+dispatch :: IORef [Either String a]+ -- ^ List of queued CSV records.+ -> IORef (Maybe (Parser a))+ -- ^ Current CSV parser state.+ -> InputStream ByteString+ -- ^ Upstream.+ -> IO (Maybe (Either String a))+ -- ^ Data feed downstream.+dispatch queueRef parserRef input = do+ queue <- readIORef queueRef++ case queue of+ [] -> do+ parser <- readIORef parserRef+ case parser of+ Nothing -> return Nothing+ Just (Fail _ e) -> bomb e+ Just (Many xs f) -> more f >> feed xs+ Just (Done xs ) -> writeIORef parserRef Nothing >> feed xs++ (x:xs) -> do+ writeIORef queueRef xs+ return (Just x)++ where+ -- Send more data to the CSV parser. If there is no more data+ -- from upstream then send an empty @ByteString@.+ more f = Streams.read input >>=+ writeIORef parserRef . Just . maybe (f BS.empty) f++ -- Feed records downstream.+ feed xs = writeIORef queueRef xs >>+ dispatch queueRef parserRef input++--------------------------------------------------------------------------------+-- | Throw an exception.+bomb :: String -> IO a+bomb = throwIO . StreamDecodingError
+ src/System/IO/Streams/Csv/Encode.hs view
@@ -0,0 +1,91 @@+{-++This file is part of the Haskell package cassava-streams. It is+subject to the license terms in the LICENSE file found in the+top-level directory of this distribution and at+git://pmade.com/cassava-streams/LICENSE. No part of cassava-streams+package, including this file, may be copied, modified, propagated, or+distributed except according to the terms contained in the LICENSE+file.++-}++--------------------------------------------------------------------------------+module System.IO.Streams.Csv.Encode+ ( encodeStream+ , encodeStreamWith+ , encodeStreamByName+ , encodeStreamByNameWith+ ) where++--------------------------------------------------------------------------------+import Control.Monad (when)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as BL+import Data.Csv+import Data.IORef+import System.IO.Streams (OutputStream, makeOutputStream)+import qualified System.IO.Streams as Streams++--------------------------------------------------------------------------------+-- | Create a new @OutputStream@ that can be fed @ToRecord@ values+-- which are converted to CSV. The records are encoded into+-- @ByteString@s and passed on to the given downstream @OutputStream@.+--+-- Equivalent to @encodeStreamWith defaultEncodeOptions@.+encodeStream :: ToRecord a+ => OutputStream ByteString -- ^ Downstream.+ -> IO (OutputStream a) -- ^ New @OutputStream@.+encodeStream = encodeStreamWith defaultEncodeOptions++--------------------------------------------------------------------------------+-- | Create a new @OutputStream@ that can be fed @ToRecord@ values+-- which are converted to CSV. The records are encoded into+-- @ByteString@s and passed on to the given downstream @OutputStream@.+encodeStreamWith :: ToRecord a+ => EncodeOptions -- ^ Encoding options.+ -> OutputStream ByteString -- ^ Downstream.+ -> IO (OutputStream a) -- ^ New @OutputStream@.+encodeStreamWith opts output = do+ ref <- newIORef opts+ makeOutputStream (dispatch encodeWith ref output)++--------------------------------------------------------------------------------+-- | Create a new @OutputStream@ which can be fed @ToNamedRecord@+-- values that will be converted into CSV. The records are encoded+-- into @ByteString@s and passed on to the given downstream+-- @OutputStream@.+--+-- Equivalent to @encodeStreamByNameWith defaultEncodeOptions@.+encodeStreamByName :: ToNamedRecord a+ => Header -- ^ CSV Header.+ -> OutputStream ByteString -- ^ Downstream.+ -> IO (OutputStream a) -- ^ New @OutputStream@.+encodeStreamByName = encodeStreamByNameWith defaultEncodeOptions++--------------------------------------------------------------------------------+-- | Create a new @OutputStream@ which can be fed @ToNamedRecord@+-- values that will be converted into CSV. The records are encoded+-- into @ByteString@s and passed on to the given downstream+-- @OutputStream@.+encodeStreamByNameWith :: ToNamedRecord a+ => EncodeOptions -- ^ Encoding options.+ -> Header -- ^ CSV Header.+ -> OutputStream ByteString -- ^ Downstream.+ -> IO (OutputStream a) -- ^ New @OutputStream@.+encodeStreamByNameWith opts hdr output = do+ ref <- newIORef opts+ makeOutputStream $ dispatch (\opts' -> encodeByNameWith opts' hdr) ref output++--------------------------------------------------------------------------------+-- | Encode records, ensuring that the header is written no more than once.+dispatch :: (EncodeOptions -> [a] -> BL.ByteString) -- ^ Encoding function.+ -> IORef EncodeOptions -- ^ Encoding options.+ -> OutputStream ByteString -- ^ Downstream.+ -> Maybe a -- ^ Record to write.+ -> IO ()+dispatch _ _ output Nothing = Streams.write Nothing output+dispatch enc ref output (Just x) = do+ opts <- readIORef ref+ when (encIncludeHeader opts) $ writeIORef ref (opts {encIncludeHeader = False})+ Streams.writeLazyByteString (enc opts [x]) output
+ src/System/IO/Streams/Csv/Tutorial.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE OverloadedStrings #-}++{-++This file is part of the Haskell package cassava-streams. It is+subject to the license terms in the LICENSE file found in the+top-level directory of this distribution and at+git://pmade.com/cassava-streams/LICENSE. No part of cassava-streams+package, including this file, may be copied, modified, propagated, or+distributed except according to the terms contained in the LICENSE+file.++-}++--------------------------------------------------------------------------------+-- | A simple tutorial on using the cassava-streams library to glue+-- together cassava and io-streams.+--+-- Note: if you're reading this on Hackage or in Haddock then you+-- should switch to source view with the \"Source\" link at the top of+-- this page or open this file in your favorite text editor.+module System.IO.Streams.Csv.Tutorial+ ( -- * Types representing to-do items and their state+ Item (..)+ , TState (..)++ -- * Functions which use cassava-streams functions+ , onlyTodo+ , markDone+ ) where++--------------------------------------------------------------------------------+import Control.Applicative+import Control.Monad+import Data.Csv+import qualified Data.Vector as V+import System.IO+import qualified System.IO.Streams as Streams+import System.IO.Streams.Csv++--------------------------------------------------------------------------------+-- | A to-do item.+data Item = Item+ { title :: String+ , state :: TState+ } deriving (Show, Eq)++instance FromNamedRecord Item where+ parseNamedRecord m = Item <$> m .: "Title"+ <*> m .: "State"++instance ToNamedRecord Item where+ toNamedRecord (Item t s) =+ namedRecord [ "Title" .= t+ , "State" .= s+ ]++--------------------------------------------------------------------------------+-- | Possible states for a to-do item.+data TState = Todo -- ^ Item needs to be completed.+ | Done -- ^ Item has been finished.+ deriving (Show, Eq)++instance FromField TState where+ parseField "TODO" = return Todo+ parseField "DONE" = return Done+ parseField _ = mzero++instance ToField TState where+ toField Todo = "TODO"+ toField Done = "DONE"++--------------------------------------------------------------------------------+-- | The @onlyTodo@ function reads to-do 'Item's from the given input+-- handle (in CSV format) and writes them back to the output handle+-- (also in CSV format), but only if the items are in the @Todo@+-- state. In another words, the CSV data is filtered so that the+-- output handle only receives to-do 'Item's which haven't been+-- completed.+--+-- The io-streams @handleToInputStream@ function is used to create an+-- @InputStream ByteString@ stream from the given input handle.+--+-- That stream is then given to the cassava-streams function+-- 'decodeStreamByName' which converts the @InputStream ByteString@+-- stream into an @InputStream Item@ stream.+--+-- Notice that the cassava-streams function 'onlyValidRecords' is used+-- to transform the decoding stream into one that only produces valid+-- records. Any records which fail type conversion (via+-- @FromNamedRecord@ or @FromRecord@) will not escape from+-- 'onlyValidRecords' but instead will throw an exception.+--+-- Finally the io-streams @filter@ function is used to filter the+-- input stream so that it only produces to-do items which haven't+-- been completed.+onlyTodo :: Handle -- ^ Input handle where CSV data can be read.+ -> Handle -- ^ Output handle where CSV data can be written.+ -> IO ()+onlyTodo inH outH = do+ -- A stream which produces items which are not 'Done'.+ input <- Streams.handleToInputStream inH >>=+ decodeStreamByName >>= onlyValidRecords >>=+ Streams.filter (\item -> state item /= Done)++ -- A stream to write items into. They will be converted to CSV.+ output <- Streams.handleToOutputStream outH >>=+ encodeStreamByName (V.fromList ["State", "Title"])++ -- Connect the input and output streams.+ Streams.connect input output++--------------------------------------------------------------------------------+-- | The @markDone@ function will read to-do items from the given+-- input handle and mark any matching items as @Done@. All to-do+-- items are written to the given output handle.+markDone :: String -- ^ Items with this title are marked as @Done@.+ -> Handle -- ^ Input handle where CSV data can be read.+ -> Handle -- ^ Output handle where CSV data can be written.+ -> IO ()+markDone titleOfItem inH outH = do+ -- Change matching items to the 'Done' state.+ let markDone' item = if title item == titleOfItem+ then item {state = Done}+ else item++ -- A stream which produces items and converts matching items to the+ -- 'Done' state.+ input <- Streams.handleToInputStream inH >>=+ decodeStreamByName >>= onlyValidRecords >>=+ Streams.map markDone'++ -- A stream to write items into. They will be converted to CSV.+ output <- Streams.handleToOutputStream outH >>=+ encodeStreamByName (V.fromList ["State", "Title"])++ -- Connect the input and output streams.+ Streams.connect input output
+ test/simple.csv view
@@ -0,0 +1,3 @@+State,Title +TODO,Make a bigger file +TODO,Release this package
+ test/test.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings #-}++{-++This file is part of the Haskell package cassava-streams. It is+subject to the license terms in the LICENSE file found in the+top-level directory of this distribution and at+git://pmade.com/cassava-streams/LICENSE. No part of cassava-streams+package, including this file, may be copied, modified, propagated, or+distributed except according to the terms contained in the LICENSE+file.++-}++--------------------------------------------------------------------------------+module Main (main) where++--------------------------------------------------------------------------------+import Control.Monad+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import Data.Csv hiding (Record, NamedRecord, record)+import qualified Data.Vector as V+import System.IO.Streams (InputStream, OutputStream)+import qualified System.IO.Streams as Streams+import qualified System.IO.Streams.Csv as CSV+import Test.QuickCheck.Monadic (monadicIO, run, assert)+import Test.Tasty+import Test.Tasty.QuickCheck as QC++--------------------------------------------------------------------------------+-- | Fake record to encode and decode. This works well because+-- Cassava and QuickCheck already have the necessary instances for+-- triples.+type Record = (Int, String, String)++--------------------------------------------------------------------------------+-- | But, Cassava doesn't have ToNamedRecord, FromNamedRecord+-- instances for triples so we have to work around there here.+newtype NamedRecord = NamedRecord {record :: Record}++instance ToNamedRecord NamedRecord where+ toNamedRecord (NamedRecord (a, b, c)) =+ namedRecord ["a" .= a, "b" .= b, "c" .= c]++instance FromNamedRecord NamedRecord where+ parseNamedRecord m = do+ a <- m .: "a"+ b <- m .: "b"+ c <- m .: "c"+ return $ NamedRecord (a, b, c)+++--------------------------------------------------------------------------------+header :: Header+header = V.fromList ["a", "b", "c"]++--------------------------------------------------------------------------------+-- | Given a list of records generated by QuickCheck, encode those+-- records into a CSV ByteString then decode them back into records.+roundTrip :: (InputStream ByteString -> IO (InputStream a)) -- ^ Decoder.+ -> (OutputStream ByteString -> IO (OutputStream a)) -- ^ Encoder.+ -> [a] -- ^ Records.+ -> IO [a]+roundTrip is os recs = do+ -- Encode records to a ByteString.+ sourceList <- Streams.fromList recs+ (collector, encoded) <- Streams.listOutputStream+ encoder <- os collector+ Streams.connect sourceList encoder++ -- Decode from ByteString.+ decoder <- fmap BS.concat encoded >>= Streams.fromByteString >>= is+ (decodeStream, decoded) <- Streams.listOutputStream+ Streams.connect decoder decodeStream+ decoded++--------------------------------------------------------------------------------+prop_namedRoundTrip :: [Record] -> Property+prop_namedRoundTrip recsIn = not (null recsIn) ==> monadicIO $ do+ recsOut <- run $ roundTrip is os (map NamedRecord recsIn)+ assert $ recsIn == map record recsOut+ where+ is = CSV.decodeStreamByName >=> CSV.onlyValidRecords+ os = CSV.encodeStreamByName header++--------------------------------------------------------------------------------+prop_indexedRoundTrip :: [Record] -> Property+prop_indexedRoundTrip recsIn = not (null recsIn) ==> monadicIO $ do+ recsOut <- run $ roundTrip is os recsIn+ assert $ recsIn == recsOut+ where+ is = CSV.decodeStream NoHeader >=> CSV.onlyValidRecords+ os = CSV.encodeStream++--------------------------------------------------------------------------------+tests :: TestTree+tests = testGroup "Tests"+ [ QC.testProperty "namedRoundTrip" $ prop_namedRoundTrip+ , QC.testProperty "indexedRoundTrip" $ prop_indexedRoundTrip+ ]++--------------------------------------------------------------------------------+main :: IO ()+main = defaultMain tests