implemented encodeRawRows
This commit is contained in:
@@ -32,6 +32,9 @@ module Data.CSV.Sip (
|
||||
slurpLabelledCSV,
|
||||
slurpRawLabelledCSV,
|
||||
-- * Conduits
|
||||
-- ** Encoding
|
||||
encodeRawRows,
|
||||
-- ** Decoding
|
||||
labelFields,
|
||||
decodeRows,
|
||||
decodeRawRows,
|
||||
@@ -94,6 +97,17 @@ slurpRawLabelledCSV
|
||||
slurpRawLabelledCSV file = runConduit $
|
||||
sourceFile file .| decodeRawRows .| labelFields .|consume
|
||||
|
||||
-- | encode raw CSV stream row by row, each element in the list read
|
||||
-- represents a field, with the entire list representing a row
|
||||
encodeRawRows :: Monad m => ConduitT [BS.ByteString] BS.ByteString m ()
|
||||
encodeRawRows = await >>= \case
|
||||
|
||||
Just fs-> do
|
||||
encodeFields fs
|
||||
encodeRawRows
|
||||
|
||||
Nothing -> return ()
|
||||
|
||||
-- | read a CSV stream, using the first row as a header containing
|
||||
-- field labels
|
||||
labelFields :: (Monad m, Ord a) => ConduitT [a] (M.Map a a) m ()
|
||||
@@ -144,6 +158,16 @@ newDecodeState = DecodeState
|
||||
|
||||
-- Conduits
|
||||
|
||||
encodeFields
|
||||
:: Monad m
|
||||
=> [BS.ByteString]
|
||||
-> ConduitT [BS.ByteString] BS.ByteString m ()
|
||||
encodeFields [] = yield "\r\n"
|
||||
encodeFields [f] = yield $ escapeField f `BS.append` "\r\n"
|
||||
encodeFields (f:fs) = do
|
||||
yield $ escapeField f `BS.append` ","
|
||||
encodeFields fs
|
||||
|
||||
labelLoop :: (Monad m, Ord a) => [a] -> ConduitT [a] (M.Map a a) m ()
|
||||
labelLoop headers = await >>= \case
|
||||
Just values -> do
|
||||
@@ -270,4 +294,19 @@ dropField s = s
|
||||
setQuoted :: Modifier
|
||||
setQuoted s = s { isQuoted = True }
|
||||
|
||||
-- Helpers
|
||||
escapeField :: BS.ByteString -> BS.ByteString
|
||||
escapeField field = let
|
||||
bytes = BS.unpack field
|
||||
in BS.concat
|
||||
[ "\""
|
||||
, BS.pack $ escapeLoop bytes
|
||||
, "\""
|
||||
]
|
||||
|
||||
escapeLoop :: [Word8] -> [Word8]
|
||||
escapeLoop [] = []
|
||||
escapeLoop (0x22:bs) = [0x22, 0x22] ++ escapeLoop bs -- escape quote
|
||||
escapeLoop (b:bs) = b : escapeLoop bs
|
||||
|
||||
--jl
|
||||
|
||||
Reference in New Issue
Block a user