pipes-cellular-csv (empty) → 1.0.0.0
raw patch · 6 files changed
+424/−0 lines, 6 filesdep +basedep +bytestringdep +data-cellsetup-changed
Dependencies added: base, bytestring, data-cell, pipes, pipes-cellular
Files
- LICENSE +28/−0
- Setup.hs +3/−0
- pipes-cellular-csv.cabal +48/−0
- src/Pipes/CSV/Decoder.lhs +189/−0
- src/Pipes/CSV/Encoder.lhs +95/−0
- src/Pipes/CSV/Syntax.lhs +61/−0
+ LICENSE view
@@ -0,0 +1,28 @@++ Efficient pipes-based cellular CSV codec+ ========================================++ Copyright © 2015 Patryk Zadarnowski «pat@jantar.org».+ 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. ➂ The name of any+ author may not be used to endorse or promote products derived from this+ software without their specific prior written permission.++ THIS SOFTWARE IS PROVIDED “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 AUTHORS 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.+
+ Setup.hs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain
+ pipes-cellular-csv.cabal view
@@ -0,0 +1,48 @@+name: pipes-cellular-csv+version: 1.0.0.0+synopsis: Efficient pipes-based cellular CSV codec+homepage: https://github.com/zadarnowski/pipes-cellular-csv+category: Control, Pipes+stability: alpha++author: Patryk Zadarnowski+maintainer: Patryk Zadarnowski <pat@jantar.org>++copyright: Copyright (c) 2015 Patryk Zadarnowski++description:++ This library provides an efficient pipes-based implementation+ of a cellular CSV codec designed for fast streaming of data+ with guaranteed constant memory usage.++cabal-version: >= 1.18+build-type: Simple+license: BSD3+license-file: LICENSE++source-repository head+ type: git+ location: https://github.com/zadarnowski/pipes-cellular-csv.git++source-repository this+ type: git+ location: https://github.com/zadarnowski/pipes-cellular-csv.git+ tag: 1.0.0.0++library+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall -fno-warn-unused-do-bind -fno-warn-missing-signatures++ exposed-modules:+ Pipes.CSV.Decoder+ Pipes.CSV.Encoder+ Pipes.CSV.Syntax++ build-depends:+ base >= 4.8 && < 5,+ bytestring >= 0.10.6.0,+ data-cell >= 1.0.0.2,+ pipes >= 4.1.5,+ pipes-cellular >= 0.0.0.1
+ src/Pipes/CSV/Decoder.lhs view
@@ -0,0 +1,189 @@+> -- | Module: Pipes.CSV.Decoder+> -- Description: Streaming CSV decoder+> -- Copyright: © 2015 Patryk Zadarnowski <pat@jantar.org>+> -- License: BSD3+> -- Maintainer: pat@jantar.org+> -- Stability: experimental+> -- Portability: portable+> --+> -- Streaming CSV file decoder compliant with RFC 4180.+> -- It follows the RFC 4180 quite strictly, with the following+> -- minor extensions:+> --+> -- * arbitrary characters, including ASCII control codes and non-ASCII code points+> -- are accepted anywhere in the input,+> -- * CR and LF are accepted as row separators in addition to the standard CR+LF,+> -- * rows can have varying number of fields,+> -- * within quoted field, a quote character that is not followed by another quote,+> -- comma or line break is accepted literally.++> module Pipes.CSV.Decoder (+> decodeCSV, decodeLazyCSV+> ) where++> import Data.ByteString (ByteString)+> import Data.Cell+> import Data.Int+> import Pipes+> import Pipes.CSV.Syntax+> import Pipes.ByteString.Chunks++> import qualified Data.ByteString as ByteString+> import qualified Data.ByteString.Lazy as Lazy++> -- | An infinite pipe that parses a fragmented lazy representation of+> -- of a CSV file into a stream of cells.++> decodeLazyCSV :: Monad m => Pipe Lazy.ByteString (Cell ByteString) m ()+> decodeLazyCSV = toChunks >-> decodeCSV++> -- | An infinite pipe that parses a fragmented strict representation of+> -- of a CSV file into a stream of cells.++> decodeCSV :: Monad m => Pipe ByteString (Cell ByteString) m ()+> decodeCSV = await >>= decodeC+> where++ At the beginning of a new cell:++> decodeC s =+> case ByteString.uncons s of+> Just (c, xs) ->+> case c of+> QC -> decodeQ xs+> CC -> yield (Cell ByteString.empty EOC) >> decodeC xs+> CR -> yield (Cell ByteString.empty EOR) >> decodeCr xs+> LF -> yield (Cell ByteString.empty EOR) >> decodeC xs+> _ -> decodeU1 s 1 xs+> Nothing -> await >>= decodeC++ After decode1 detects a CR:++> decodeCr s =+> case ByteString.uncons s of+> Just (c, xs) ->+> case c of+> QC -> decodeQ xs+> CC -> yield (Cell ByteString.empty EOC) >> decodeC xs+> CR -> yield (Cell ByteString.empty EOR) >> decodeCr xs+> LF -> decodeC xs+> _ -> decodeU1 s 1 xs+> Nothing -> await >>= decodeCr++ Decode a quoted cell:++> decodeQ s = decodeQ1 s 0 s++ Decode a quoted cell, beginning the search for the next+ quote at a given string position:++> decodeQ1 s i s' =+> case ByteString.elemIndex QC s' of+> Just i' -> let i'' = i + i' in i'' `seq` decodeQ2 s i'' (ByteString.drop (i' + 1) s')+> Nothing+> | ByteString.null s -> await >>= decodeQ+> | otherwise -> await >>= decodeR s++ Decode a part of a quoted cell after a quote character has been located at @s!i@:++> decodeQ2 s i s' =+> case ByteString.uncons s' of+> Just (c, xs) ->+> case c of+> QC -> decodeR (ByteString.take (i + 1) s) xs+> CC -> yield (Cell (ByteString.take i s) EOC) >> decodeC xs+> CR -> yield (Cell (ByteString.take i s) EOR) >> decodeCr xs+> LF -> yield (Cell (ByteString.take i s) EOR) >> decodeC xs+> _ -> let i' = i + 2 in i' `seq` decodeQ2 s i' xs -- accept the quote character literally, as an extension to RFC 4180+> Nothing -> await >>= decodeQ3 s++ Same as @decodeQ2@, when the quote ends up at the end of the chunk @qs@:++> decodeQ3 qs s =+> case ByteString.uncons s of+> Just (c, xs) ->+> case c of+> QC -> decodeR qs xs+> CC -> yield (Cell (ByteString.init qs) EOC) >> decodeC xs+> CR -> yield (Cell (ByteString.init qs) EOR) >> decodeCr xs+> LF -> yield (Cell (ByteString.init qs) EOR) >> decodeC xs+> _ -> decodeR1 qs s 1 xs -- accept the quote character literally, as an extension to RFC 4180+> Nothing -> await >>= decodeQ3 qs++ Decode more quoted cell parts after a non-empty part @ps@ has been identified:++> decodeR ps s = decodeR1 ps s 0 s++ Decode more quoted cell parts after a non-empty part @ps@ has been identified,+ beginning the search for the next quote at a given string position:++> decodeR1 ps s i s' =+> case ByteString.elemIndex QC s' of+> Just i' -> let i'' = i + i' in i'' `seq` decodeR2 ps s i'' (ByteString.drop (i' + 1) s')+> Nothing+> | ByteString.null s -> await >>= decodeR ps+> | otherwise -> yield (Cell ps EOP) >> await >>= decodeR s++ Decode a part of a quoted cell after a non-empty part @ps@ has been identifier+ and after a quote character has been located at @s!i@:++> decodeR2 ps s i s' =+> case ByteString.uncons s' of+> Just (c, xs) ->+> case c of+> QC -> yield (Cell ps EOP) >> decodeR (ByteString.take (i + 1) s) xs+> CC -> yield2 ps s i EOC >> decodeC xs+> CR -> yield2 ps s i EOR >> decodeCr xs+> LF -> yield2 ps s i EOR >> decodeC xs+> _ -> decodeR2 ps s (i + 2) xs -- accept the quote character literally, as an extension to RFC 4180+> Nothing -> await >>= decodeR3 ps s i++ Same as @decodeR2@, when the quote ends up at the end of the chunk @qs@:++> decodeR3 ps qs i s =+> case ByteString.uncons s of+> Just (c, xs) ->+> case c of+> QC -> yield (Cell ps EOP) >> decodeR qs xs+> CC -> yield2 ps s i EOC >> decodeC xs+> CR -> yield2 ps s i EOR >> decodeCr xs+> LF -> yield2 ps s i EOR >> decodeC xs+> _ -> yield (Cell ps EOP) >> decodeR1 qs s 1 xs -- accept the quote character literally, as an extension to RFC 4180+> Nothing -> await >>= decodeR3 ps qs i++ Decode an unquoted field:++> decodeU1 s i s' =+> case ByteString.uncons s' of+> Just (c, xs) ->+> case c of+> CC -> yield (Cell (ByteString.take i s) EOC) >> decodeC xs+> CR -> yield (Cell (ByteString.take i s) EOR) >> decodeCr xs+> LF -> yield (Cell (ByteString.take i s) EOR) >> decodeC xs+> _ -> let i' = i + 1 in i' `seq` decodeU1 s i' xs+> Nothing -> await >>= decodeV s++ Decode an unquoted field after a non-empty part @ps@ has been identified:++> decodeV ps s = decodeV1 ps s 0 s++ Decode more characters of an unquoted field,+ after a non-empty part @ps@ has been identified:++> decodeV1 ps s i s' =+> case ByteString.uncons s' of+> Just (c, xs) ->+> case c of+> CC -> yield2 ps s i EOC >> decodeC xs+> CR -> yield2 ps s i EOR >> decodeCr xs+> LF -> yield2 ps s i EOR >> decodeC xs+> _ -> let i' = i + 1::Int64 in i' `seq` decodeV1 ps s i' xs+> Nothing+> | (i > 0) -> yield (Cell ps EOC) >> await >>= decodeV s+> | otherwise -> await >>= decodeV ps++ Yield a non-empty cell part and a possibly empty final cell part:++> yield2 ps s i e+> | (i > 0) = yield (Cell ps EOP) >> yield (Cell s e)+> | otherwise = yield (Cell ps e)
+ src/Pipes/CSV/Encoder.lhs view
@@ -0,0 +1,95 @@+> -- | Module: Pipes.CSV.Encoder+> -- Description: Streaming CSV encoder+> -- Copyright: © 2015 Patryk Zadarnowski <pat@jantar.org>+> -- License: BSD3+> -- Maintainer: pat@jantar.org+> -- Stability: experimental+> -- Portability: portable+> --+> -- Streaming CSV file decoder compliant with RFC 4180.+> -- All fields are quoted except for short fields consisting+> -- entirely of “safe” ASCII characters, i.e., printable 7-bit+> -- characters other than quote and comma. The maximum length+> -- of an unquoted field is supplied explicitly to the encoder,+> -- which allows us to decide whether a given field requires+> -- quoting without unbounded lookahead.++> module Pipes.CSV.Encoder (+> encodeCSV, encodeLazyCSV+> ) where++> import Control.Monad+> import Data.ByteString (ByteString)+> import Data.Cell+> import Pipes+> import Pipes.CSV.Syntax++> import qualified Data.ByteString as ByteString+> import qualified Data.ByteString.Lazy as Lazy++> -- | @encodeCSV n@ is an infinite pipe that converts a stream+> -- of cells into a fragmented strict representation of of a CSV file,+> -- unconditionally quoting any field values with length greater than @n@.++> encodeCSV :: Monad m => Int -> Pipe (Cell ByteString) ByteString m ()+> encodeCSV n = encode1+> where++> encode1 = await >>= encode2++> encode2 (Cell x EOP) = yield fieldDelimiter >> quotePart x >> await >>= encode3+> encode2 (Cell x EOC) = quoteField x >> yield fieldSeparator >> encode1+> encode2 (Cell x EOR) = quoteField x >> yield recordSeparator >> encode1+> encode2 (Cell x EOT) = quoteField x >> yield recordSeparator >> encode1++> encode3 (Cell x EOP) = quotePart x >> await >>= encode3+> encode3 (Cell x EOC) = quotePart x >> yield fieldDelimiter >> yield fieldSeparator >> encode1+> encode3 (Cell x EOR) = quotePart x >> yield fieldDelimiter >> yield recordSeparator >> encode1+> encode3 (Cell x EOT) = quotePart x >> yield fieldDelimiter >> yield recordSeparator >> encode1++> quoteField x+> | requiresQuoting x = yield fieldDelimiter >> quotePart x >> yield fieldDelimiter+> | otherwise = yield' x++> requiresQuoting x = (ByteString.length x > n || ByteString.any isSpecial x)++> -- | @encodeLazyCSV n@ is an infinite pipe that converts a stream+> -- of cells into a fragmented lazy representation of of a CSV file,+> -- unconditionally quoting any field values with length greater than @n@.++> encodeLazyCSV :: Monad m => Int -> Pipe (Cell Lazy.ByteString) ByteString m ()+> encodeLazyCSV n = encode1+> where++> encode1 = await >>= encode2++> encode2 (Cell x EOP) = yield fieldDelimiter >> quoteLazyPart x >> await >>= encode3+> encode2 (Cell x EOC) = quoteLazyField x >> yield fieldSeparator >> encode1+> encode2 (Cell x EOR) = quoteLazyField x >> yield recordSeparator >> encode1+> encode2 (Cell x EOT) = quoteLazyField x >> yield recordSeparator >> encode1++> encode3 (Cell x EOP) = quoteLazyPart x >> await >>= encode3+> encode3 (Cell x EOC) = quoteLazyPart x >> yield fieldDelimiter >> yield fieldSeparator >> encode1+> encode3 (Cell x EOR) = quoteLazyPart x >> yield fieldDelimiter >> yield recordSeparator >> encode1+> encode3 (Cell x EOT) = quoteLazyPart x >> yield fieldDelimiter >> yield recordSeparator >> encode1++> quoteLazyField x+> | requiresQuoting n cs = yield fieldDelimiter >> quoteChunks cs >> yield fieldDelimiter+> | otherwise = mapM_ yield' cs+> where+> cs = Lazy.toChunks x++> quoteLazyPart = quoteChunks . Lazy.toChunks++> quoteChunks = mapM_ quotePart++> requiresQuoting n' (c:cs) = (m > n' || ByteString.any isSpecial c || requiresQuoting (n - m) cs)+> where m = fromIntegral (ByteString.length c)+> requiresQuoting _ [] = False++> quotePart x =+> case ByteString.elemIndex QC x of+> Just i -> yield' (ByteString.take i x) >> yield quoteSequence >> quotePart (ByteString.drop (i + 1) x)+> Nothing -> yield' x++> yield' x = unless (ByteString.null x) (yield x)
+ src/Pipes/CSV/Syntax.lhs view
@@ -0,0 +1,61 @@+> -- | Module: Pipes.CSV.Syntax+> -- Description: Basic elements of the CSV lexical syntax+> -- Copyright: © 2015 Patryk Zadarnowski <pat@jantar.org>+> -- License: BSD3+> -- Maintainer: pat@jantar.org+> -- Stability: experimental+> -- Portability: portable+> --+> -- CSV syntax elements as defined in RFC 4180.++> {-# LANGUAGE PatternSynonyms, ScopedTypeVariables #-}++> module Pipes.CSV.Syntax (+> pattern LF,+> pattern CR,+> pattern QC,+> pattern CC,+> isSpecial,+> fieldDelimiter,+> fieldSeparator,+> recordSeparator,+> quoteSequence+> ) where++> import Data.ByteString (ByteString)+> import Data.Word++> import qualified Data.ByteString as ByteString++> -- | line byte value+> pattern LF = 0x0A :: Word8++> -- | carriage return byte value+> pattern CR = 0x0D :: Word8++> -- | quote character byte value+> pattern QC = 0x22 :: Word8++> -- | comma character byte value+> pattern CC = 0x2C :: Word8++> -- | Identifies special byte values, which should never appear within unquoted CSV fields.+> isSpecial :: Word8 -> Bool+> isSpecial x = (x == QC || x == CC || x < 0x20 || x > 0x7E)++> -- | The field delimiter string (a quote character.)+> fieldDelimiter :: ByteString+> fieldDelimiter = ByteString.singleton QC++> -- | The field separator string (a comma character.)+> fieldSeparator :: ByteString+> fieldSeparator = ByteString.singleton CC++> -- | The field separator (CR+LF byte sequence.)+> recordSeparator :: ByteString+> recordSeparator = ByteString.pack [ CR, LF ]++> -- | An escaped quote string (double quote character.)+> quoteSequence :: ByteString+> quoteSequence = ByteString.pack [ QC, QC ]+