streamly-cassava (empty) → 0.1.0.0
raw patch · 9 files changed
+737/−0 lines, 9 filesdep +QuickCheckdep +basedep +bytestringsetup-changed
Dependencies added: QuickCheck, base, bytestring, cassava, criterion, deepseq, exceptions, hspec, mtl, quickcheck-instances, streaming, streaming-bytestring, streaming-cassava, streaming-with, streamly, streamly-cassava, text, unordered-containers, vector, weigh
Files
- ChangeLog.md +3/−0
- LICENSE +30/−0
- README.md +29/−0
- Setup.hs +2/−0
- app/Main.hs +89/−0
- bench/Bench.hs +89/−0
- src/Streamly/Csv.hs +282/−0
- streamly-cassava.cabal +116/−0
- test/Spec.hs +97/−0
+ ChangeLog.md view
@@ -0,0 +1,3 @@+# Changelog for streamly-cassava++## Unreleased changes
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Author name here (c) 2019++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 Author name here 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,29 @@+# streamly-cassava++Stream CSV data in\/out using+[Cassava](http://hackage.haskell.org/package/cassava). Adapted from+[streaming-cassava](http://hackage.haskell.org/package/streaming-cassava).++For efficiency, operates on streams of strict ByteString chunks +(i.e. `IsStream t => t m ByteString`) rather than directly on streams of Word8. +The chunkStream function is useful for generating an input stream from a+handle.++Example usage:++```haskell+import Streamly+import qualified Streamly.Prelude as S+import Streamly.Csv (decode, encode, chunkStream)+import System.IO+import qualified Data.Csv as Csv+import qualified Data.ByteString as BS+import Data.Vector (Vector)++main = do+ h <- openFile "testfile.csv" ReadMode+ let chunks = chunkStream h (64*1024)+ recs = decode Csv.HasHeader chunks :: SerialT IO (Vector BS.ByteString)+ withFile "dest.csv" WriteMode $ \ho ->+ S.mapM_ (BS.hPut ho) $ encode Nothing recs+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DeriveGeneric, StandaloneDeriving, GeneralizedNewtypeDeriving+ , DeriveFunctor, MultiParamTypeClasses #-}+module Main where++import System.IO+import System.Environment (getArgs)+import qualified Streamly as S+import qualified Streamly.Prelude as S+import Control.DeepSeq+import GHC.Generics+import qualified Data.Csv as Csv+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Vector as V+import Control.Monad.Error.Class+import Control.Monad.Catch+import Control.Monad.IO.Class+import Streamly.Csv+import qualified Streaming as ST+import qualified Streaming.With as ST+import qualified Streaming.Prelude as ST+import qualified Streaming.Cassava as CsvST+import qualified Data.ByteString.Streaming as BSS++deriving instance Generic CsvParseException+instance NFData CsvParseException++main :: IO ()+main = do+ (mode:testfile:_) <- getArgs+ case mode of+ "streamly" ->+ copyAllStreamly testfile $ "out_"<>testfile+ "cassava" ->+ copyAllCassava testfile $ "out_"<>testfile+ "streaming" -> do+ recs <- readAllStreaming testfile+ print $ length (force recs)+ _ -> error "First argument should be 'streamly', 'streaming', or 'cassava'"+++readAllStreamly :: FilePath -> IO [V.Vector BS.ByteString]+readAllStreamly filename = do+ h <- openFile filename ReadMode+ let chunks = chunkStream h (64*1024)+ recs = decode Csv.HasHeader chunks+ S.toList recs+++readAllCassava :: FilePath -> IO (V.Vector (V.Vector BS.ByteString))+readAllCassava filename = do+ contents <- BSL.readFile filename+ either (error . show) return $+ Csv.decode Csv.HasHeader contents+++copyAllCassava :: FilePath -> FilePath -> IO ()+copyAllCassava fIn fOut = do+ contents <- BSL.readFile fIn+ recs <- either (error . show) return $+ Csv.decode Csv.HasHeader contents :: IO (V.Vector (V.Vector BS.ByteString))+ BSL.writeFile fOut $ Csv.encode $ V.toList recs+++copyAllStreamly :: FilePath -> FilePath -> IO ()+copyAllStreamly fIn fOut = do+ h <- openFile fIn ReadMode+ let chunks = chunkStream h (64*1024)+ recs = decode Csv.HasHeader chunks :: S.SerialT IO (V.Vector BS.ByteString)+ withFile fOut WriteMode $ \ho ->+ S.mapM_ (BS.hPut ho) $ encode Nothing recs+++newtype StupidMonad a = StupidMonad {runStupid :: IO a}+ deriving (Functor, Applicative, Monad, MonadIO, MonadMask+ , MonadCatch, MonadThrow)++instance MonadError CsvST.CsvParseException StupidMonad where+ throwError e = StupidMonad (throwM e)+ catchError (StupidMonad a) f = StupidMonad $ catch a (runStupid . f)++readAllStreaming :: FilePath -> IO [V.Vector BS.ByteString]+readAllStreaming filename = ST.withBinaryFileContents filename go+ where + go :: BSS.ByteString IO () -> IO [V.Vector BS.ByteString]+ go contents = + let recs :: ST.Stream (ST.Of (V.Vector BS.ByteString)) StupidMonad ()+ recs = CsvST.decode HasHeader (ST.hoist StupidMonad contents)+ in runStupid $ ST.toList_ recs
+ bench/Bench.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveFunctor+ , MultiParamTypeClasses #-}+++import System.IO+import qualified Streamly as S+import qualified Streamly.Prelude as S+import qualified Data.Csv as Csv+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import Control.Monad.Error.Class+import qualified Data.Vector as V+import System.Environment (getArgs)+import GHC.Generics+import Control.Monad.Catch+import Control.Monad.IO.Class+import qualified Streaming as ST+import qualified Streaming.With as ST+import qualified Streaming.Prelude as ST+import qualified Streaming.Cassava as CsvST+import qualified Data.ByteString.Streaming as BSS+import Criterion.Main+import Weigh+import Streamly.Csv+++readAllCassava :: FilePath -> IO (V.Vector (V.Vector BS.ByteString))+readAllCassava filename = do+ contents <- BSL.readFile filename+ either (error . show) return $+ Csv.decode Csv.HasHeader contents++copyAllCassava :: FilePath -> FilePath -> IO ()+copyAllCassava fIn fOut = do+ contents <- BSL.readFile fIn+ recs <- either (error . show) return $+ Csv.decode Csv.HasHeader contents :: IO (V.Vector (V.Vector BS.ByteString))+ BSL.writeFile fOut $ Csv.encode $ V.toList recs+++readAllStreamly :: FilePath -> IO [V.Vector BS.ByteString]+readAllStreamly filename = do+ h <- openFile filename ReadMode+ let chunks = chunkStream h (64*1024)+ recs = decode Csv.HasHeader chunks+ S.toList recs+++copyAllStreamly :: FilePath -> FilePath -> IO ()+copyAllStreamly fIn fOut = do+ h <- openFile fIn ReadMode+ let chunks = chunkStream h (64*1024)+ recs = decode Csv.HasHeader chunks :: S.SerialT IO (V.Vector BS.ByteString)+ withFile fOut WriteMode $ \ho ->+ S.mapM_ (BS.hPut ho) $ encode Nothing recs++newtype StupidMonad a = StupidMonad {runStupid :: IO a}+ deriving (Functor, Applicative, Monad, MonadIO, MonadMask+ , MonadCatch, MonadThrow)++instance MonadError CsvST.CsvParseException StupidMonad where+ throwError e = StupidMonad (throwM e)+ catchError (StupidMonad a) f = StupidMonad $ catch a (runStupid . f)++readAllStreaming :: FilePath -> IO [V.Vector BS.ByteString]+readAllStreaming filename = ST.withBinaryFileContents filename go+ where + go :: BSS.ByteString IO () -> IO [V.Vector BS.ByteString]+ go contents = + let recs :: ST.Stream (ST.Of (V.Vector BS.ByteString)) StupidMonad ()+ recs = CsvST.decode HasHeader (ST.hoist StupidMonad contents)+ in runStupid $ ST.toList_ recs++main = cpuBenchmark >> allocationBenchmark++cpuBenchmark = do+ let testfile = "testfile.csv"+ defaultMain [ bench "plainCassava" $ nfIO (readAllCassava testfile)+ , bench "streamlyCassava" $ nfIO (readAllStreamly testfile)+ , bench "streamingCassava" $ nfIO (readAllStreaming testfile)]+++allocationBenchmark = do+ let testfile = "testfile.csv"+ putStrLn "Running allocation benchmarks"+ mainWith $ do + io "plainCassava" (copyAllCassava testfile) $ "out_"<>testfile+ io "streamlyCassava" (copyAllStreamly testfile) $ "out_"<>testfile+ -- io "streamingCassava" readAllStreaming testfile
+ src/Streamly/Csv.hs view
@@ -0,0 +1,282 @@+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, OverloadedStrings,+ ScopedTypeVariables, LambdaCase #-}++{- |+ Module : Streamly.Csv+ Description : Cassava support for the streamly library+ Copyright : (c) Richard Warfield+ License : BSD 3-clause+ Maintainer : richard@litx.io++ Stream CSV data in\/out using+ [Cassava](http://hackage.haskell.org/package/cassava). Adapted from+ [streaming-cassava](http://hackage.haskell.org/package/streaming-cassava).++ For efficiency, operates on streams of strict ByteString chunks + @(i.e. IsStream t => t m ByteString)@ rather than directly on streams of Word8. + The 'chunkStream' function is useful for generating an input stream from a+ 'Handle'.++ Example usage:++ > import Streamly+ > import qualified Streamly.Prelude as S+ > import Streamly.Csv (decode, encode, chunkStream)+ > import System.IO+ > import qualified Data.Csv as Csv+ > import qualified Data.ByteString as BS+ > import Data.Vector (Vector)+ >+ > do+ > h <- openFile "testfile.csv" ReadMode+ > let chunks = chunkStream h (64*1024)+ > recs = decode Csv.HasHeader chunks :: SerialT IO (Vector BS.ByteString)+ > withFile "dest.csv" WriteMode $ \ho ->+ > S.mapM_ (BS.hPut ho) $ encode Nothing recs+ -}+module Streamly.Csv+ ( -- * Decoding+ decode+ , decodeWith+ , decodeWithErrors+ , CsvParseException (..)+ , chunkStream+ -- ** Named decoding+ , decodeByName+ , decodeByNameWith+ , decodeByNameWithErrors+ -- * Encoding+ , encode+ , encodeDefault+ , encodeWith+ -- ** Named encoding+ , encodeByName+ , encodeByNameDefault+ , encodeByNameWith+ -- * Re-exports+ , FromRecord (..)+ , FromNamedRecord (..)+ , ToRecord (..)+ , ToNamedRecord (..)+ , DefaultOrdered (..)+ , HasHeader (..)+ , Header+ , header+ , Name+ , DecodeOptions(..)+ , defaultDecodeOptions+ , EncodeOptions(..)+ , defaultEncodeOptions+ ) where++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import Streamly+import qualified Streamly.Prelude as S++import Data.Csv (DecodeOptions(..), DefaultOrdered(..),+ EncodeOptions(..), FromNamedRecord(..),+ FromRecord(..), Header, Name,+ ToNamedRecord(..), ToRecord(..),+ defaultDecodeOptions,+ defaultEncodeOptions, encIncludeHeader,+ header)+import Data.Csv.Incremental (HasHeader(..), HeaderParser(..),+ Parser(..))+import qualified Data.Csv.Incremental as CI++import System.IO (Handle)+import Control.Exception (Exception(..))+import Control.Monad.Catch (MonadThrow(..))+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.Word (Word8)+import Data.Bifunctor (first)+import Data.Maybe (fromMaybe)+import Data.String (IsString(..))+import Data.Typeable (Typeable)++--------------------------------------------------------------------------------++-- | Use 'defaultOptions' for decoding the provided CSV.+decode :: (IsStream t, MonadAsync m, FromRecord a)+ => HasHeader+ -> t m BS.ByteString+ -> t m a+decode = decodeWith defaultDecodeOptions++-- | Return back a stream of values from the provided CSV, stopping at+-- the first error.+--+-- If you wish to instead ignore errors, consider using+-- 'decodeWithErrors' with 'S.mapMaybe'+--+-- Any remaining input is discarded.+decodeWith :: (IsStream t, MonadAsync m, FromRecord a)+ => DecodeOptions -> HasHeader+ -> t m BS.ByteString+ -> t m a+decodeWith opts hdr chunks = getValues (decodeWithErrors opts hdr chunks)+ -- >>= either (throwError . fst) return++-- | Return back a stream with an attempt at type conversion, and+-- either the previous result or any overall parsing errors with the+-- remainder of the input.+decodeWithErrors :: (IsStream t, Monad m, FromRecord a, MonadThrow m)+ => DecodeOptions -> HasHeader+ -> t m BS.ByteString+ -> t m (Either CsvParseException a)+decodeWithErrors opts = runParser . CI.decodeWith opts++runParser :: forall t a m. (IsStream t, Monad m, MonadThrow m)+ => Parser a -> t m BS.ByteString -> t m (Either CsvParseException a)+runParser p chunked = S.concatMap fst $ S.scanlM' continue (S.nil, const p) $+ S.cons BS.empty chunked+ where+ continue :: (t m (Either CsvParseException a), BS.ByteString -> Parser a)+ -> BS.ByteString+ -> m (t m (Either CsvParseException a), BS.ByteString -> Parser a)+ continue (_, p) chunk =+ case p chunk of+ Fail bs err -> throwM (CsvParseException err)+ Many es get -> return (withEach es, get)+ Done es -> return (withEach es, p)++ withEach = S.fromList . map (first CsvParseException)++chunkStream :: (IsStream t, MonadAsync m) => Handle -> Int -> t m BS.ByteString+chunkStream h chunkSize = loop+ where+ loop = S.takeWhile (not . BS.null) $+ liftIO (BS.hGetSome h chunkSize) `S.consM` loop++--------------------------------------------------------------------------------++-- | Use 'defaultOptions' for decoding the provided CSV.+decodeByName :: (MonadAsync m, FromNamedRecord a)+ => SerialT m BS.ByteString -> SerialT m a+decodeByName = decodeByNameWith defaultDecodeOptions++-- | Return back a stream of values from the provided CSV, stopping at+-- the first error.+--+-- A header is required to determine the order of columns, but then+-- discarded.+--+-- If you wish to instead ignore errors, consider using+-- 'decodeByNameWithErrors' with 'S.mapMaybe'+--+-- Any remaining input is discarded.+decodeByNameWith :: (MonadAsync m, FromNamedRecord a)+ => DecodeOptions+ -> SerialT m BS.ByteString -> SerialT m a+decodeByNameWith opts bs = getValues (decodeByNameWithErrors opts bs)+ -- >>= either (throwError . fst) return++-- | Return back a stream with an attempt at type conversion, but+-- where the order of columns doesn't have to match the order of+-- fields of your actual type.+--+-- This requires\/assumes a header in the CSV stream, which is+-- discarded after parsing.+--+decodeByNameWithErrors :: forall m a. (Monad m, MonadThrow m, FromNamedRecord a) + => DecodeOptions+ -> SerialT m BS.ByteString+ -> SerialT m (Either CsvParseException a)+decodeByNameWithErrors opts chunked = do+ (p, rest) <- S.yieldM $ extractParser (const $ CI.decodeByNameWith opts) $ S.cons BS.empty chunked+ runParser p rest+ where+ extractParser :: (BS.ByteString -> HeaderParser (Parser a))+ -> SerialT m BS.ByteString+ -> m (Parser a, SerialT m BS.ByteString)+ extractParser p chunks = S.uncons chunks >>= \case+ Just (hed, rest) -> + case p hed of+ FailH bs err -> throwM (CsvParseException err)+ PartialH get -> extractParser get rest+ DoneH _ p -> return (p, rest)+ Nothing -> throwM $ CsvParseException "Unexpected end of input stream"++-- --------------------------------------------------------------------------------+-- +-- -- | Encode a stream of values with the default options.+-- --+-- -- Optionally prefix the stream with headers (the 'header' function+-- -- may be useful).+encode :: (IsStream t, ToRecord a, Monad m) => Maybe Header+ -> t m a -> t m BS.ByteString+encode = encodeWith defaultEncodeOptions++-- | Encode a stream of values with the default options and a derived+-- header prefixed.+encodeDefault :: forall a t m. (IsStream t, ToRecord a, DefaultOrdered a, Monad m)+ => t m a -> t m BS.ByteString+encodeDefault = encode (Just (headerOrder (undefined :: a)))++-- | Encode a stream of values with the provided options.+--+-- Optionally prefix the stream with headers (the 'header' function+-- may be useful).+encodeWith :: (IsStream t, ToRecord a, Monad m)+ => EncodeOptions + -> Maybe Header+ -> t m a + -> t m BS.ByteString+encodeWith opts mhdr = S.concatMap S.fromList+ . addHeaders+ . S.map enc+ where+ addHeaders = maybe id (S.cons . enc) mhdr++ enc :: (ToRecord v) => v -> [BS.ByteString]+ enc = BSL.toChunks . CI.encodeWith opts . CI.encodeRecord++--------------------------------------------------------------------------------++-- | Use the default ordering to encode all fields\/columns.+encodeByNameDefault :: forall a t m. (IsStream t, DefaultOrdered a, ToNamedRecord a, Monad m)+ => t m a -> t m BS.ByteString+encodeByNameDefault = encodeByName (headerOrder (undefined :: a))++-- | Select the columns that you wish to encode from your data+-- structure using default options (which currently includes+-- printing the header).+encodeByName :: (IsStream t, ToNamedRecord a, Monad m) => Header+ -> t m a -> t m BS.ByteString+encodeByName = encodeByNameWith defaultEncodeOptions++-- | Select the columns that you wish to encode from your data+-- structure.+--+-- Header printing respects 'encIncludeheader'.+encodeByNameWith :: (IsStream t, ToNamedRecord a, Monad m) => EncodeOptions -> Header+ -> t m a -> t m BS.ByteString+encodeByNameWith opts hdr = S.concatMap S.fromList+ . addHeaders+ . S.map enc+ where+ opts' = opts { encIncludeHeader = False }++ addHeaders+ | encIncludeHeader opts = S.cons . BSL.toChunks+ . CI.encodeWith opts' . CI.encodeRecord $ hdr+ | otherwise = id++ enc = BSL.toChunks . CI.encodeByNameWith opts' hdr . CI.encodeNamedRecord++--------------------------------------------------------------------------------++getValues :: (IsStream t, MonadAsync m, Exception e)+ => t m (Either e a) -> t m a+getValues = S.mapM (either throwM return)++newtype CsvParseException = CsvParseException String+ deriving (Eq, Show, Typeable)++instance IsString CsvParseException where+ fromString = CsvParseException++instance Exception CsvParseException where+ displayException (CsvParseException e) = "Error parsing csv: " ++ e+
+ streamly-cassava.cabal view
@@ -0,0 +1,116 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.31.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 09273d7709de37ad53220440e52492922bac950cccc7a1564f5d911a50883102++name: streamly-cassava+version: 0.1.0.0+synopsis: CSV streaming support via cassava for the streamly ecosystem+description: Please see the README on GitHub at <https://github.com/litxio/streamly-cassava#readme>+category: Streaming+homepage: https://github.com/litxio/streamly-cassava#readme+bug-reports: https://github.com/litxio/streamly-cassava/issues+author: Richard Warfield+maintainer: richard@litx.io+copyright: 2019 Richard Warfield+license: BSD3+license-file: LICENSE+build-type: Simple+extra-source-files:+ README.md+ ChangeLog.md++source-repository head+ type: git+ location: https://github.com/litxio/streamly-cassava++library+ exposed-modules:+ Streamly.Csv+ other-modules:+ Paths_streamly_cassava+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , bytestring+ , cassava+ , exceptions+ , mtl+ , streamly+ default-language: Haskell2010++executable streamly-cassava-exe+ main-is: Main.hs+ other-modules:+ Paths_streamly_cassava+ hs-source-dirs:+ app+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , bytestring+ , cassava+ , deepseq+ , exceptions+ , mtl+ , streaming+ , streaming-bytestring+ , streaming-cassava+ , streaming-with+ , streamly+ , streamly-cassava+ , unordered-containers+ , vector+ default-language: Haskell2010++test-suite streamly-cassava-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Paths_streamly_cassava+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ QuickCheck+ , base >=4.7 && <5+ , bytestring+ , cassava+ , exceptions+ , hspec+ , mtl+ , quickcheck-instances+ , streamly+ , streamly-cassava+ , text+ , vector+ default-language: Haskell2010++benchmark streamly-cassava-bench+ type: exitcode-stdio-1.0+ main-is: Bench.hs+ other-modules:+ Paths_streamly_cassava+ hs-source-dirs:+ bench+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , bytestring+ , cassava+ , criterion+ , exceptions+ , mtl+ , streaming+ , streaming-bytestring+ , streaming-cassava+ , streaming-with+ , streamly+ , streamly-cassava+ , vector+ , weigh+ default-language: Haskell2010
+ test/Spec.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE DeriveGeneric, FlexibleContexts, MultiParamTypeClasses, RankNTypes,+ ScopedTypeVariables #-}++{-# OPTIONS_GHC -Wno-unused-binds #-}++{- |+ Module : Main+ Description : Round-trip property testing+ Copyright : (c) Ivan Lazar Miljenovic+ License : MIT+ Maintainer : Ivan.Miljenovic@gmail.com++++ -}++import Streamly.Csv++import Streamly+import qualified Streamly.Prelude as S++import Test.Hspec (describe, hspec)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck (Arbitrary(..))+import Test.QuickCheck.Monadic+import Test.QuickCheck.Instances ()++import Control.Monad.Catch (try, MonadCatch(..), SomeException)+import Data.Text (Text)+import qualified Data.Vector as V+import GHC.Generics (Generic)++--------------------------------------------------------------------------------++main :: IO ()+main = hspec $ do+ describe "Plain records" $ do+ prop "Just data" $ \recs -> + monadicIO $ run (useType encodeDecode recs) >>= assert+ prop "With headers" $ \recs ->+ monadicIO $ run (useType encodeDecodeHeader recs) >>= assert+ describe "Named records" $ do+ prop "Default order" $ \recs ->+ monadicIO $ run (useType encodeDecodeNamed recs) >>= assert+ prop "Reversed order" $ \recs ->+ monadicIO $ run (useType encodeDecodeNamedReordered recs) >>= assert++encodeDecode :: (FromRecord a, ToRecord a, Eq a, MonadAsync m, MonadCatch m)+ => [a] -> m Bool+encodeDecode = encodeDecodeWith (decode NoHeader . encode Nothing)++encodeDecodeHeader :: (DefaultOrdered a, FromRecord a, ToRecord a, Eq a+ , MonadAsync m, MonadCatch m)+ => [a] -> m Bool+encodeDecodeHeader = encodeDecodeWith (decode HasHeader . encodeDefault)++encodeDecodeNamed :: (DefaultOrdered a, FromNamedRecord a, ToNamedRecord a+ , Eq a, MonadAsync m, MonadCatch m)+ => [a] -> m Bool+encodeDecodeNamed = encodeDecodeWith (decodeByName . encodeByNameDefault)++encodeDecodeNamedReordered :: forall a m. (DefaultOrdered a, FromNamedRecord a+ ,ToNamedRecord a, Eq a, MonadAsync m, MonadCatch m)+ => [a] -> m Bool+encodeDecodeNamedReordered = encodeDecodeWith (decodeByName . encodeByName hdr)+ where+ hdr = V.reverse (headerOrder (undefined :: a))++encodeDecodeWith :: forall a m. (Eq a, MonadAsync m, MonadCatch m)+ => (SerialT m a -> SerialT m a)+ -> [a] -> m Bool+encodeDecodeWith f as = fmap (either (const False) (as==))+ . (try :: m [a] -> m (Either SomeException [a]))+ . S.toList+ . f+ . S.fromList+ $ as++useType :: ([Test] -> r) -> [Test] -> r+useType = id++data Test = Test+ { columnA :: !Int+ , longer_column_name :: !Text+ , mebbe :: !(Maybe Double)+ } deriving (Eq, Show, Read, Generic)++-- DeriveAnyClass doesn't work with these types because of the Maybe++instance FromRecord Test+instance ToRecord Test+instance DefaultOrdered Test+instance FromNamedRecord Test+instance ToNamedRecord Test++instance Arbitrary Test where+ arbitrary = Test <$> arbitrary <*> arbitrary <*> arbitrary