quiver-csv 0.0.0.2 → 0.0.0.3

raw patch · 4 files changed

+392/−2 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• quiver-csv.cabal +7/−2
• src/Control/Quiver/CSV/Decoder.lhs +193/−0
• src/Control/Quiver/CSV/Encoder.lhs +95/−0
• src/Control/Quiver/CSV/Extras.lhs +97/−0

@@ -1,5 +1,5 @@ name:           quiver-csv-version:        0.0.0.2+version:        0.0.0.3 synopsis:       Quiver combinators for cellular CSV data processing homepage:       https://github.com/zadarnowski/quiver-csv category:       Control@@ -28,7 +28,7 @@ source-repository this   type:         git   location:     https://github.com/zadarnowski/quiver-csv.git-  tag:          0.0.0.2+  tag:          0.0.0.3  library   hs-source-dirs:   src@@ -37,6 +37,11 @@    exposed-modules:     Control.Quiver.CSV++  other-modules:+    Control.Quiver.CSV.Decoder+    Control.Quiver.CSV.Encoder+    Control.Quiver.CSV.Extras    build-depends:     base                    >= 4.8 && < 5,

@@ -0,0 +1,193 @@+> -- | Module:    Control.Quiver.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,+> -- * final row is not required to end with CR+LF, and+> -- * within quoted field, a quote character that is not followed by another quote,+> --   comma or line break is accepted literally.++> {-# LANGUAGE PatternSynonyms, RankNTypes #-}++> module Control.Quiver.CSV.Decoder (+>   decodeCSV, decodeLazyCSV+> ) where++> import Data.ByteString (ByteString)+> import Data.Cell+> import Control.Quiver.SP+> import Control.Quiver.ByteString+> import Control.Quiver.CSV.Extras++> import qualified Data.ByteString as ByteString+> import qualified Data.ByteString.Lazy as Lazy++> -- | A Quiver processor that parses a fragmented lazy representation+> --   of a CSV file into a stream of cells.++> decodeLazyCSV :: Functor f => SP Lazy.ByteString (Cell Lazy.ByteString) f CSVError+> decodeLazyCSV = toChunks >->> decodeCSV >&> snd >->> sppure (fmap Lazy.fromStrict) >&> fst++> -- | A Quiver processor that parses a fragmented strict representation+> --   of a CSV file into a stream of cells.++> decodeCSV :: Functor f => SP ByteString (Cell ByteString) f CSVError+> decodeCSV = decodeC+>  where++    At the beginning of a new cell:++>   decodeC = consume () decodeC' (deliver SPComplete)+>   decodeC' s =+>     case ByteString.uncons s of+>       Just (c, xs) ->+>         case c of+>           QC -> decodeQ' xs+>           CC -> Cell ByteString.empty EOC >:> decodeC'  xs+>           CR -> Cell ByteString.empty EOR >:> decodeCr' xs+>           LF -> Cell ByteString.empty EOR >:> decodeC'  xs+>           _  -> decodeU' s 1 xs+>       Nothing -> decodeC++    After decodeC detects a CR:++>   decodeCr = consume () decodeCr' (deliver SPComplete)+>   decodeCr' s =+>     case ByteString.uncons s of+>       Just (c, xs) ->+>         case c of+>           QC -> decodeQ' xs+>           CC -> Cell ByteString.empty EOC >:> decodeC'  xs+>           CR -> Cell ByteString.empty EOR >:> decodeCr' xs+>           LF -> decodeC' xs+>           _  -> decodeU' s 1 xs+>       Nothing -> decodeCr++    Decode a quoted cell:++>   decodeQ = consume () decodeQ' (deliverError IncompleteCell)+>   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 -> decodeQ+>         | otherwise -> 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 -> Cell (ByteString.take i s) EOC >:> decodeC'  xs+>           CR -> Cell (ByteString.take i s) EOR >:> decodeCr' xs+>           LF -> 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 -> decodeQ3 s++    Same as decodeQ2, when the quote ends up at the end of the chunk @qs@:++>   decodeQ3 qs = consume () (decodeQ3' qs) (Cell (ByteString.init qs) EOR >:> deliverError IncompleteRow)+>   decodeQ3' qs s =+>     case ByteString.uncons s of+>       Just (c, xs) ->+>         case c of+>           QC -> decodeR' qs xs+>           CC -> Cell (ByteString.init qs) EOC >:> decodeC'  xs+>           CR -> Cell (ByteString.init qs) EOR >:> decodeCr' xs+>           LF -> Cell (ByteString.init qs) EOR >:> decodeC'  xs+>           _  -> decodeR1' qs s 1 xs -- accept the quote character literally, as an extension to RFC 4180+>       Nothing -> decodeQ3 qs++    Decode more quoted cell parts after a non-empty part @ps@ has been identified:++>   decodeR ps = consume () (decodeR' ps) (Cell ps EOP >:> deliverError IncompleteCell)+>   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 -> decodeR ps+>         | otherwise -> Cell ps EOP >:> decodeR s++    Decode a part of a quoted cell after a non-empty part @ps@ has been identified+    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 -> Cell ps EOP >:> decodeR' (ByteString.take (i + 1) s) xs+>           CC -> produce' EOC (decodeC'  xs)+>           CR -> produce' EOR (decodeCr' xs)+>           LF -> produce' EOR (decodeC'  xs)+>           _  -> decodeR2' ps s (i + 2) xs -- accept the quote character literally, as an extension to RFC 4180+>       Nothing -> decodeR3 ps s i+>    where+>     produce' d pk+>       | (i > 0) = Cell ps EOP >:> Cell (ByteString.take i s) d >:> pk+>       | otherwise = Cell ps d >:> pk++    Same as @decodeR2@, when the quote ends up at the end of the chunk @qs@:++>   decodeR3 ps qs qi = consume () (decodeR3' ps qs qi) (Cell ps EOP >:> Cell (ByteString.init qs) EOR >:> deliverError IncompleteRow)+>   decodeR3' ps qs qi s =+>     case ByteString.uncons s of+>       Just (c, xs) ->+>         case c of+>           QC -> Cell ps EOP >:> decodeR' qs xs+>           CC -> produce' EOC (decodeC'  xs)+>           CR -> produce' EOR (decodeCr' xs)+>           LF -> produce' EOR (decodeC'  xs)+>           _  -> Cell ps EOP >:> decodeR1' qs s 1 xs -- accept the quote character literally, as an extension to RFC 4180+>       Nothing -> decodeR3 ps qs qi+>    where+>     produce' d pk+>       | (qi > 0) = Cell ps EOP >:> Cell (ByteString.init qs) d >:> pk+>       | otherwise = Cell ps d >:> pk++    Decode an unquoted field:++>   decodeU' s i s' =+>     case ByteString.uncons s' of+>       Just (c, xs) ->+>         case c of+>           CC -> Cell (ByteString.take i s) EOC >:> decodeC'  xs+>           CR -> Cell (ByteString.take i s) EOR >:> decodeCr' xs+>           LF -> Cell (ByteString.take i s) EOR >:> decodeC'  xs+>           _  -> let i' = i + 1 in i' `seq` decodeU' s i' xs+>       Nothing -> decodeV s++    Decode an unquoted field after a non-empty part @ps@ has been identified:++>   decodeV ps = consume () (decodeV' ps) (Cell ps EOR >:> deliverError IncompleteRow)+>   decodeV' ps s =+>     case ByteString.uncons s of+>       Just (c, xs) ->+>         case c of+>           CC -> Cell ps EOC >:> decodeC'  xs+>           CR -> Cell ps EOR >:> decodeCr' xs+>           LF -> Cell ps EOR >:> decodeC'  xs+>           _  -> Cell ps EOP >:> decodeU' s 1 xs+>       Nothing -> decodeV ps

@@ -0,0 +1,95 @@+> -- | Module:    Control.Quiver.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.++> {-# LANGUAGE RankNTypes #-}++> module Control.Quiver.CSV.Encoder (+>   encodeCSV, encodeLazyCSV+> ) where++> import Data.ByteString (ByteString)+> import Data.Cell+> import Control.Quiver.SP+> import Control.Quiver.CSV.Extras++> 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 a CSV file,+> --   unconditionally quoting any field values with length greater than @n@.++> encodeCSV :: Int -> SP (Cell ByteString) ByteString f CSVError+> encodeCSV n = loop+>  where++>   loop = consume () loop' (deliver SPComplete)+>   loop' (Cell x EOP) = fieldDelimiter >:> quotePart x loop1+>   loop' (Cell x EOC) = quoteField x (fieldSeparator  >:> loop2)+>   loop' (Cell x EOR) = quoteField x (recordSeparator >:> loop)+>   loop' (Cell x EOT) = quoteField x (recordSeparator >:> loop)++>   loop1 = consume () loop1' (deliverError IncompleteCell)+>   loop1' (Cell x EOP) = quotePart x loop1+>   loop1' (Cell x EOC) = quotePart x (fieldDelimiter >:> fieldSeparator  >:> loop2)+>   loop1' (Cell x EOR) = quotePart x (fieldDelimiter >:> recordSeparator >:> loop)+>   loop1' (Cell x EOT) = quotePart x (fieldDelimiter >:> recordSeparator >:> loop)++>   loop2 = consume () loop' (deliverError IncompleteRow)++>   quoteField x pk+>     | requiresQuoting x = fieldDelimiter >:> quotePart x (fieldDelimiter >:> pk)+>     | otherwise = x *>:> pk++>   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 a CSV file,+> --   unconditionally quoting any field values with length greater than @n@.++> encodeLazyCSV :: Int -> SP (Cell Lazy.ByteString) ByteString f CSVError+> encodeLazyCSV n = loop+>  where++>   loop = consume () loop' (deliver SPComplete)+>   loop' (Cell x EOP) = fieldDelimiter >:> quoteParts x loop1+>   loop' (Cell x EOC) = quoteField x (fieldSeparator  >:> loop2)+>   loop' (Cell x EOR) = quoteField x (recordSeparator >:> loop)+>   loop' (Cell x EOT) = quoteField x (recordSeparator >:> loop)++>   loop1 = consume () loop1' (deliverError IncompleteCell)+>   loop1' (Cell x EOP) = quoteParts x loop1+>   loop1' (Cell x EOC) = quoteParts x (fieldDelimiter >:> fieldSeparator  >:> loop2)+>   loop1' (Cell x EOR) = quoteParts x (fieldDelimiter >:> recordSeparator >:> loop)+>   loop1' (Cell x EOT) = quoteParts x (fieldDelimiter >:> recordSeparator >:> loop)++>   loop2 = consume () loop' (deliverError IncompleteRow)++>   quoteParts x pk = foldr quotePart pk (Lazy.toChunks x)++>   quoteField x pk+>     | requiresQuoting n cs = fieldDelimiter >:> foldr quotePart (fieldDelimiter >:> pk) cs+>     | otherwise = foldr (*>:>) pk cs+>    where cs = Lazy.toChunks x++>   requiresQuoting n' (c:cs) = (m > n' || ByteString.any isSpecial c || requiresQuoting (n - m) cs)+>    where m = fromIntegral (ByteString.length c)+>   requiresQuoting _ [] = False++> quotePart x pk =+>   case ByteString.elemIndex QC x of+>     Just i -> ByteString.take i x *>:> quoteSequence >:> quotePart (ByteString.drop (i + 1) x) pk+>     Nothing -> x *>:> pk

@@ -0,0 +1,97 @@+> -- | Module:    Control.Quiver.CSV.Extras+> -- Description: Miscellaneous definitions+> -- 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+> -- and a few miscellaneous Quiver combinators.++> {-# LANGUAGE PatternSynonyms, ScopedTypeVariables #-}++> module Control.Quiver.CSV.Extras (+>   CSVError (..),+>   (*>:>),+>   deliverError,+>   pattern LF,+>   pattern CR,+>   pattern QC,+>   pattern CC,+>   isSpecial,+>   fieldDelimiter,+>   fieldSeparator,+>   recordSeparator,+>   quoteSequence+> ) where++> import Control.Quiver.SP+> import Data.ByteString (ByteString)+> import Data.Word++> import qualified Data.ByteString as ByteString++> -- | Codec error type.++> data CSVError =++>   -- | Input ends in a partial cell value.+>   --   For encoder, this means that the last 'Cell' of the input stream specifies the 'EOP' delimiter instead of 'EOR' or 'EOT'.+>   --   For decoder, this means that the last cell of the input stream is missing the closing quote character.++>   IncompleteCell |++>   -- | Input ends in a partial row value.+>   --   For encoder, this means that the last 'Cell' of the input stream specifies the 'EOC' delimiter instead of 'EOR' or 'EOT'.+>   --   For decoder, this means that the last row of the input stream is missing the line break sequence.++>   IncompleteRow+>   deriving (Eq, Ord, Show, Enum)++> infixr 5 *>:>++> -- | Emits a bytestring, filtering out the empty ones.++> (*>:>) :: ByteString -> P a' a ByteString b' f (SPResult e) -> P a' a ByteString b' f (SPResult e)+> y *>:> sp+>   | ByteString.null y = sp+>   | otherwise = produce y (const sp) (deliver SPIncomplete)++> -- | Delivers a simple stream processor failure.++> deliverError :: e -> P a' a b b' f (SPResult e)+> deliverError = deliver . SPFailed++> -- | 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 ]+