diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,3 @@ +2014-04-30 Peter Jones + + * cassava-streams initial release (version 0.1.0.0). diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014 Peter Jones + +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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/bin/tutorial.hs b/bin/tutorial.hs new file mode 100644 --- /dev/null +++ b/bin/tutorial.hs @@ -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" diff --git a/cassava-streams.cabal b/cassava-streams.cabal new file mode 100644 --- /dev/null +++ b/cassava-streams.cabal @@ -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 +maintainer: Peter Jones +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 diff --git a/src/System/IO/Streams/Csv.hs b/src/System/IO/Streams/Csv.hs new file mode 100644 --- /dev/null +++ b/src/System/IO/Streams/Csv.hs @@ -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 diff --git a/src/System/IO/Streams/Csv/Decode.hs b/src/System/IO/Streams/Csv/Decode.hs new file mode 100644 --- /dev/null +++ b/src/System/IO/Streams/Csv/Decode.hs @@ -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 diff --git a/src/System/IO/Streams/Csv/Encode.hs b/src/System/IO/Streams/Csv/Encode.hs new file mode 100644 --- /dev/null +++ b/src/System/IO/Streams/Csv/Encode.hs @@ -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 diff --git a/src/System/IO/Streams/Csv/Tutorial.hs b/src/System/IO/Streams/Csv/Tutorial.hs new file mode 100644 --- /dev/null +++ b/src/System/IO/Streams/Csv/Tutorial.hs @@ -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 diff --git a/test/simple.csv b/test/simple.csv new file mode 100644 --- /dev/null +++ b/test/simple.csv @@ -0,0 +1,3 @@ +State,Title +TODO,Make a bigger file +TODO,Release this package diff --git a/test/test.hs b/test/test.hs new file mode 100644 --- /dev/null +++ b/test/test.hs @@ -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