streaming-cassava (empty) → 0.1.0.0
raw patch · 7 files changed
+441/−0 lines, 7 filesdep +QuickCheckdep +basedep +bytestringsetup-changed
Dependencies added: QuickCheck, base, bytestring, cassava, hspec, mtl, quickcheck-instances, streaming, streaming-bytestring, streaming-cassava, text, transformers, vector
Files
- ChangeLog.md +5/−0
- LICENSE +20/−0
- README.md +19/−0
- Setup.hs +2/−0
- src/Streaming/Cassava.hs +254/−0
- streaming-cassava.cabal +53/−0
- test/roundtrip.hs +88/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for streaming-cassava++## 0.1.0.0 -- 2017-06-30++* First version.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2017 Ivan Lazar Miljenovic++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,19 @@+streaming-cassava+=================++[](https://hackage.haskell.org/package/streaming-cassava) [](https://travis-ci.org/ivan-m/streaming-cassava)++> [cassava] support for the [streaming] ecosystem++[cassava]: http://hackage.haskell.org/package/cassava+[streaming]: http://hackage.haskell.org/package/streaming++This library allows you to easily stream CSV data in and out. You can+do so using both "plain" record-based (with optional header support)+or name-based (header required to determine ordering)+encoding/decoding.++All encoding/decoding options are supported, it's possible to+automatically add on default headers and you can even choose whether+to fail on the first parse error or handle errors on a row-by-row+basis.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ src/Streaming/Cassava.hs view
@@ -0,0 +1,254 @@+{-# LANGUAGE FlexibleContexts, MultiParamTypeClasses, OverloadedStrings,+ ScopedTypeVariables #-}++{- |+ Module : Streaming.Cassava+ Description : Cassava support for the streaming library+ Copyright : (c) Ivan Lazar Miljenovic+ License : MIT+ Maintainer : Ivan.Miljenovic@gmail.com++++ -}+module Streaming.Cassava+ ( -- * Decoding+ decode+ , decodeWith+ , decodeWithErrors+ , CsvParseException (..)+ -- ** 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 DB+import qualified Data.ByteString.Lazy as DBL+import Data.ByteString.Streaming (ByteString)+import qualified Data.ByteString.Streaming as B+import qualified Data.ByteString.Streaming.Internal as B+import Streaming (Of, Stream)+import qualified Streaming.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 Control.Exception (Exception(..))+import Control.Monad.Error.Class (MonadError, throwError)+import Control.Monad.Trans.Class (lift)+import Data.Bifunctor (first)+import Data.Maybe (fromMaybe)+import Data.String (IsString(..))+import Data.Typeable (Typeable)++--------------------------------------------------------------------------------++-- | Use 'defaultOptions' for decoding the provided CSV.+decode :: (MonadError CsvParseException m, FromRecord a)+ => HasHeader -> ByteString m r+ -> Stream (Of a) m r+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 either 'S.mapMaybe' or @'S.effects'+-- . 'S.partitionEithers'@.+--+-- Unlike 'decodeWithErrors', any remaining input is discarded.+decodeWith :: (MonadError CsvParseException m, FromRecord a)+ => DecodeOptions -> HasHeader+ -> ByteString m r -> Stream (Of a) m r+decodeWith opts hdr bs = getValues (decodeWithErrors opts hdr bs)+ >>= 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.+--+-- 'S.partitionEithers' may be useful when using this function.+decodeWithErrors :: (Monad m, FromRecord a) => DecodeOptions -> HasHeader+ -> ByteString m r+ -> Stream (Of (Either CsvParseException a)) m (Either (CsvParseException, ByteString m r) r)+decodeWithErrors opts = runParser . CI.decodeWith opts++runParser :: (Monad m) => Parser a -> ByteString m r+ -> Stream (Of (Either CsvParseException a)) m (Either (CsvParseException, ByteString m r) r)+runParser = loop+ where+ feed f str = (uncurry (loop . f) . fromMaybe (mempty, str))+ -- nxt == Nothing, str is just Return+ =<< lift (B.unconsChunk str)++ loop p str = case p of+ Fail bs err -> return (Left (CsvParseException err, B.consChunk bs str))+ Many es get -> withEach es >> feed get str+ Done es -> do withEach es+ -- This is primarily just to+ -- return the @r@ value, but also+ -- acts as a check on the parser.+ nxt <- lift (B.nextChunk str)+ return $ case nxt of+ Left r -> Right r+ Right _ -> Left ("Unconsumed input", str)++ withEach = S.each . map (first CsvParseException)++--------------------------------------------------------------------------------++-- | Use 'defaultOptions' for decoding the provided CSV.+decodeByName :: (MonadError CsvParseException m, FromNamedRecord a)+ => ByteString m r -> Stream (Of a) m r+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 either 'S.mapMaybe' or @'S.effects'+-- . 'S.partitionEithers'@.+--+-- Unlike 'decodeByNameWithErrors', any remaining input is+-- discarded.+decodeByNameWith :: (MonadError CsvParseException m, FromNamedRecord a)+ => DecodeOptions+ -> ByteString m r -> Stream (Of a) m r+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.+--+-- 'S.partitionEithers' may be useful when using this function.+decodeByNameWithErrors :: (Monad m, FromNamedRecord a) => DecodeOptions+ -> ByteString m r+ -> Stream (Of (Either CsvParseException a)) m (Either (CsvParseException, ByteString m r) r)+decodeByNameWithErrors = loopH . CI.decodeByNameWith+ where+ loopH ph str = case ph of+ FailH bs err -> return (Left (CsvParseException err, B.consChunk bs str))+ PartialH get -> feedH get str+ DoneH _ p -> runParser p str++ feedH f str = (uncurry (loopH . f) . fromMaybe (mempty, str))+ -- nxt == Nothing, str is just Return+ =<< lift (B.unconsChunk str)++--------------------------------------------------------------------------------++-- | Encode a stream of values with the default options.+--+-- Optionally prefix the stream with headers (the 'header' function+-- may be useful).+encode :: (ToRecord a, Monad m) => Maybe Header+ -> Stream (Of a) m r -> ByteString m r+encode = encodeWith defaultEncodeOptions++-- | Encode a stream of values with the default options and a derived+-- header prefixed.+encodeDefault :: forall a m r. (ToRecord a, DefaultOrdered a, Monad m)+ => Stream (Of a) m r -> ByteString m r+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 :: (ToRecord a, Monad m) => EncodeOptions -> Maybe Header+ -> Stream (Of a) m r -> ByteString m r+encodeWith opts mhdr = B.fromChunks+ . S.concat+ . addHeaders+ . S.map enc+ where+ addHeaders = maybe id (S.cons . enc) mhdr++ enc :: (ToRecord v) => v -> [DB.ByteString]+ enc = DBL.toChunks . CI.encodeWith opts . CI.encodeRecord++--------------------------------------------------------------------------------++-- | Use the default ordering to encode all fields\/columns.+encodeByNameDefault :: forall a m r. (DefaultOrdered a, ToNamedRecord a, Monad m)+ => Stream (Of a) m r -> ByteString m r+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 :: (ToNamedRecord a, Monad m) => Header+ -> Stream (Of a) m r -> ByteString m r+encodeByName = encodeByNameWith defaultEncodeOptions++-- | Select the columns that you wish to encode from your data+-- structure.+--+-- Header printing respects 'encIncludeheader'.+encodeByNameWith :: (ToNamedRecord a, Monad m) => EncodeOptions -> Header+ -> Stream (Of a) m r -> ByteString m r+encodeByNameWith opts hdr = B.fromChunks+ . S.concat+ . addHeaders+ . S.map enc+ where+ opts' = opts { encIncludeHeader = False }++ addHeaders+ | encIncludeHeader opts = S.cons . DBL.toChunks+ . CI.encodeWith opts' . CI.encodeRecord $ hdr+ | otherwise = id++ enc = DBL.toChunks . CI.encodeByNameWith opts' hdr . CI.encodeNamedRecord++--------------------------------------------------------------------------------++getValues :: (MonadError e m) => Stream (Of (Either e a)) m r -> Stream (Of a) m r+getValues = S.mapM (either throwError 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
+ streaming-cassava.cabal view
@@ -0,0 +1,53 @@+name: streaming-cassava+version: 0.1.0.0+synopsis: Cassava support for the streaming ecosystem++description:+ Stream values to\/from CSV using Cassava.+ .+ Support is available for both named and \"plain\" data types,+ optional header support and option handling.+license: MIT+license-file: LICENSE+author: Ivan Lazar Miljenovic+maintainer: Ivan.Miljenovic@gmail.com+copyright: Ivan Lazar Miljenovic+category: Data, Streaming+build-type: Simple+extra-source-files: ChangeLog.md, README.md+cabal-version: >=1.10+tested-with: GHC == 8.0.2, GHC == 8.1.*++source-repository head+ type: git+ location: https://github.com/ivan-m/streaming-cassava.git++library+ exposed-modules: Streaming.Cassava+ build-depends: base >=4.8 && <5+ , bytestring+ , cassava == 0.5.*+ , mtl+ , streaming >= 0.1.1.0 && < 0.2+ , streaming-bytestring < 0.2+ , transformers+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall+++test-suite roundtrip+ type: exitcode-stdio-1.0+ main-is: roundtrip.hs+ build-depends: streaming-cassava+ , base+ , hspec == 2.4.*+ , mtl >= 2.2.1 && < 2.3+ , QuickCheck == 2.*+ , quickcheck-instances+ , streaming+ , text+ , vector >= 0.3+ hs-source-dirs: test+ default-language: Haskell2010+ ghc-options: -Wall
+ test/roundtrip.hs view
@@ -0,0 +1,88 @@+{-# 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++++ -}+module Main (main) where++import Streaming.Cassava++import Streaming.Prelude (Of, Stream, each, toList_)++import Test.Hspec (describe, hspec)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck (Arbitrary(..))+import Test.QuickCheck.Instances ()++import Control.Monad.Except (MonadError, runExcept)+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" (useType encodeDecode)+ prop "With headers" (useType encodeDecodeHeader)+ describe "Named records" $ do+ prop "Default order" (useType encodeDecodeNamed)+ prop "Reversed order" (useType encodeDecodeNamedReordered)++encodeDecode :: (FromRecord a, ToRecord a, Eq a) => [a] -> Bool+encodeDecode = encodeDecodeWith (decode NoHeader . encode Nothing)++encodeDecodeHeader :: (DefaultOrdered a, FromRecord a, ToRecord a, Eq a)+ => [a] -> Bool+encodeDecodeHeader = encodeDecodeWith (decode HasHeader . encodeDefault)++encodeDecodeNamed :: (DefaultOrdered a, FromNamedRecord a, ToNamedRecord a, Eq a)+ => [a] -> Bool+encodeDecodeNamed = encodeDecodeWith (decodeByName . encodeByNameDefault)++encodeDecodeNamedReordered :: forall a. (DefaultOrdered a, FromNamedRecord a, ToNamedRecord a, Eq a)+ => [a] -> Bool+encodeDecodeNamedReordered = encodeDecodeWith (decodeByName . encodeByName hdr)+ where+ hdr = V.reverse (headerOrder (undefined :: a))++encodeDecodeWith :: (Eq a)+ => (forall m r. (MonadError CsvParseException m) => Stream (Of a) m r -> Stream (Of a) m r)+ -> [a] -> Bool+encodeDecodeWith f as = either (const False) (as==)+ . runExcept+ . toList_+ . f+ . each+ $ 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