packages feed

pipes-csv 1.2.0 → 1.3.0

raw patch · 3 files changed

+255/−20 lines, 3 filesdep +HUnitdep +pipes-bytestringdep +pipes-csvdep ~basedep ~bytestringdep ~cassava

Dependencies added: HUnit, pipes-bytestring, pipes-csv, test-framework, test-framework-hunit

Dependency ranges changed: base, bytestring, cassava, vector

Files

pipes-csv.cabal view
@@ -1,5 +1,5 @@ name:                pipes-csv-version:             1.2.0+version:             1.3.0 synopsis:            Fast, streaming csv parser license:             MIT license-file:        LICENSE@@ -25,10 +25,36 @@     , Pipes.Csv.Encoding    build-depends:-      base       >= 4       && < 5-    , cassava    >= 0.2     && < 0.3-    , pipes      >= 4       && < 5-    , unordered-containers     < 0.3-    , blaze-builder            < 0.4-    , bytestring               < 0.11-    , vector                   < 0.11+      base                  >= 4       && < 5+    , cassava               >= 0.3     && < 0.4+    , pipes                 >= 4       && < 5+    , unordered-containers  < 0.3+    , blaze-builder         < 0.4+    , bytestring            < 0.11+    , vector                < 0.11+++flag test-hunit+  default: True+  manual: True++test-suite hunit+  type: exitcode-stdio-1.0+  main-is: test-pipes-csv.hs+  ghc-options: -w -threaded -rtsopts -with-rtsopts=-N+  hs-source-dirs: test++  if !flag(test-hunit)+    buildable: False+  else+    build-depends:+        base+      , HUnit >= 1.2+      , pipes                 >= 4       && < 5+      , pipes-bytestring     >= 2       && < 3+      , pipes-csv+      , cassava+      , vector+      , bytestring+      , test-framework       >= 0.6+      , test-framework-hunit >= 0.2
src/Pipes/Csv.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}  {-| This module allows constant-space CSV parsing. @@ -34,7 +33,8 @@  -- * Re-exports -- $reexports-  module Data.Csv+  module Data.Csv,+  HasHeader(..) ) where  @@ -48,7 +48,7 @@ import Data.ByteString (ByteString) import Blaze.ByteString.Builder (toByteString, fromByteString) import Data.Monoid ((<>))-import Data.Csv.Incremental (Parser(..), HeaderParser(..))+import Data.Csv.Incremental (Parser(..), HeaderParser(..), HasHeader(..)) import Data.Csv (   Header, DecodeOptions, EncodeOptions(encDelimiter), FromRecord(..),   FromNamedRecord(..), ToRecord(..), ToField(..), FromField(..),@@ -82,6 +82,8 @@ --persons :: Monad m => Producer ByteString m () -> Producer Person m () --persons p = 'decodeByName' p >-> right --+---- note: right can be replaced with Pipes.Prelude.concat in ghc-7.8,+----       thanks to a Foldable instance for Either --right :: (Monad m) => Pipe (Either a b) b m r --right = loop --  where@@ -108,8 +110,7 @@ feedParser parser source = case parser of     Fail _ e  -> yield (Left e)     Done es   -> each es-    Some es k -> each es >> cont k source-    Partial k -> cont k source+    Many es k -> each es >> cont k source   where     cont = continue feedParser @@ -146,7 +147,7 @@  -- | Equivalent to @'decodeWith' 'defaultDecodeOptions'@. decode :: (Monad m, FromRecord a)-       => Bool+       => CI.HasHeader        -> Producer ByteString m ()        -> Producer (Either String a) m () decode = decodeWith defaultDecodeOptions@@ -156,10 +157,10 @@ -- producing either errors or 'FromRecord's. decodeWith :: (Monad m, FromRecord a)            => DecodeOptions-           -> Bool+           -> HasHeader            -> Producer ByteString m ()            -> Producer (Either String a) m ()-decodeWith opts skipHeader src = feedParser (CI.decodeWith opts skipHeader) src+decodeWith opts hasHeader src = feedParser (CI.decodeWith opts hasHeader) src   -- | Equivalent to @'decodeByNameWith' 'defaultDecodeOptions'@.@@ -178,12 +179,12 @@ decodeByNameWith opts src = feedHeaderParser (CI.decodeByNameWith opts) src  -- | Encode records as strict 'ByteString's-encode :: (Monad m, ToRecord a) => forall r. Pipe a ByteString m r+encode :: (Monad m, ToRecord a) => Pipe a ByteString m r encode = encodeWith defaultEncodeOptions  -- | Encode named records as strict 'ByteString's encodeByName :: (Monad m, ToNamedRecord a)-             => Header -> forall r. Pipe a ByteString m r+             => Header -> Pipe a ByteString m r encodeByName = encodeByNameWith defaultEncodeOptions  -- | Encode a record with a trailing CrLf@@ -193,7 +194,7 @@ -- | Encode records as strict 'ByteString's encodeWith :: (Monad m, ToRecord a)            => EncodeOptions-           -> forall r. Pipe a ByteString m r+           -> Pipe a ByteString m r encodeWith opts = P.map (encodeWithCrLf delim . toRecord)   where     delim = encDelimiter opts@@ -202,7 +203,7 @@ encodeByNameWith :: (Monad m, ToNamedRecord a)                  => EncodeOptions                  -> Header-                 -> forall r. Pipe a ByteString m r+                 -> Pipe a ByteString m r encodeByNameWith opts hdr = do   yield $ toByteString $ encodeRecord delim hdr <> fromByteString "\r\n"   P.map (encodeWithCrLf delim . namedRecordToRecord hdr . toNamedRecord)
+ test/test-pipes-csv.hs view
@@ -0,0 +1,208 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults -fno-warn-unused-do-bind -fno-warn-orphans -fno-warn-unused-imports -fno-warn-unused-binds #-}+{-# LANGUAGE OverloadedStrings #-}++module Main (+    main+ ) where++import           Test.Framework as TF+import           Test.Framework.Providers.HUnit (testCase)+import           Test.HUnit++import           Control.Applicative+import           Control.Monad+import qualified Data.ByteString.Char8 as C+import qualified Data.Vector as DV++import           Data.Csv ((.:), (.!), FromNamedRecord(..), FromRecord(..),+                           Record, HasHeader(..))+import           Pipes.ByteString (stdin, ByteString)+import           Pipes.Csv (decode, decodeByName)+import           Pipes+import qualified Pipes.Prelude as P++-- helper functions+right :: (Monad m) => Pipe (Either a b) b m r+right = loop+  where+    loop = await >>= \s -> case s of+      Left _  -> loop+      Right v -> yield v >> loop++-- decode to vector+decoder :: Monad m+        => Producer ByteString m ()+        -> Producer (Either String Record) m ()+decoder = decode NoHeader++decoderStream =+    [ ""+    , "1"+    , "\n"+    , "1,2\n"+    , "1,2,3\n"+    , "\n" -- ignores empty line+    , "no line end needed on last chunk"+    ]++decoderResult =+    [+        ["1"]+      , ["1","2"]+      , ["1","2","3"]+      , ["no line end needed on last chunk"]+    ]++testDecoder :: Assertion+testDecoder =+    map DV.fromList decoderResult @=?+    P.toList (decoder (each $ map C.pack decoderStream) >-> right)++ioDecoder = runEffect $+    for (decoder (each $ map C.pack decoderStream)) (lift . print)++-- decode to Int tuple+decoderTuple :: Monad m+         => Producer ByteString m ()+         -> Producer (Either String (Int, Int)) m ()+decoderTuple = decode NoHeader++decoderTupleStream =+    [ ""+    , "1,2"+    , "\n"+    , "1,2\n"+    , "2,3\n"+    , "\n" -- ignores empty line+    , "one,two\n"+    , "no line end needed on last chunk\n"+    , "0,0"+    ]++decoderTupleResult =+    [ Right (1,2)+    , Right (1,2)+    , Right (2,3)+    , Left "expected Int, got \"one\" (Failed reading: takeWhile1)"+    , Left "cannot unpack array of length 1 into a pair. Input record: fromList [\"no line end needed on last chunk\"]"+    , Right (0,0)+    ]++testDecoderTuple :: Assertion+testDecoderTuple =+    decoderTupleResult @=?+    P.toList (decoderTuple (each $ map C.pack decoderTupleStream))++ioDecoderTuple = runEffect $+    for (decoderTuple (each $ map C.pack decoderTupleStream)) (lift . print)++-- (unnamed) Person Record++data Person = Person String Int+            deriving (Show, Eq)++instance FromRecord Person where+  parseRecord v =+    Person <$> v .! 0+           <*> v .! 1++decoderPerson :: Monad m+        => Producer ByteString m ()+        -> Producer (Either String Person) m ()+decoderPerson = decode NoHeader++decoderPersonStream =+    [ ""+    , "Jack,21\nJill,55\n"+    , "Jimbo,21,beyond this is discarded,and this\n"+    , "Bill,1\n"+    , "Bill"+    , "y"+    , ","+    , "2"+    , "\n"+    , "Sue,22abc\n" -- consumes 22 and discards "abc"+    -- , "zz\n" -- throws an exception+    , "no space allowed, 99\n"+    , "eof,99"+    ]++decoderPersonResult =+    [ Right (Person "Jack" 21)+    , Right (Person "Jill" 55)+    , Right (Person "Jimbo" 21)+    , Right (Person "Bill" 1)+    , Right (Person "Billy" 2)+    , Right (Person "Sue" 22)+    , Left "expected Int, got \" 99\" (Failed reading: takeWhile1)"+    , Right (Person "eof" 99)+    ]++testDecoderPerson :: Assertion+testDecoderPerson =+    decoderPersonResult @=?+    P.toList (decoderPerson (each $ map C.pack decoderPersonStream))++ioDecoderPerson = runEffect $+    for (decoderPerson (each $ map C.pack decoderPersonStream)) (lift . print)++-- data record version of Person++data Person' = Person' {+    name :: String+  , age :: Int+  } deriving (Show)++instance FromRecord Person' where+  parseRecord v =+    Person' <$> v .! 0+            <*> v .! 1++decoderPerson' :: Monad m+        => Producer ByteString m ()+        -> Producer (Either String Person') m ()+decoderPerson' = decode NoHeader++ioDecoderPerson' = runEffect $+    for (decoderPerson' (each $ map C.pack decoderPersonStream)) (lift . print)++decoderPerson'Result = [21,55,21,1,2,22,99]++testDecoderPerson' :: Assertion+testDecoderPerson' =+    decoderPerson'Result @=?+    P.toList (decoderPerson' (each $ map C.pack decoderPersonStream)+        >-> right >-> P.map age)++-- named person record+instance FromNamedRecord Person where+  parseNamedRecord p =+    Person <$> p .: "name"+           <*> p .: "age"++decoderNamedPerson :: Monad m+        => Producer ByteString m ()+        -> Producer (Either String Person) m ()+decoderNamedPerson = decodeByName++decoderNamedPersonStream = "Name,Age\n" : decoderPersonStream++ioDecoderNamedPerson = runEffect $+    for (decoderNamedPerson (each $ map C.pack decoderNamedPersonStream))+        (lift . print)++-- test frame+main :: IO ()+main = defaultMain tests++tests :: [TF.Test]+tests =+  [+    testGroup "Pipes.Csv." decodeTests+  ]++decodeTests = [ testCase "HUnit" testDecoder+              , testCase "HUnit" testDecoderTuple+              , testCase "HUnit" testDecoderPerson+              , testCase "HUnit" testDecoderPerson'+              ]