implemented decodeRawRows

src/Data/CSV/Slurp.hs

@@ -33,7 +33,9 @@ module Data.CSV.Slurp (
 ) where
 
 import Conduit (ConduitT, await, mapC, yield, (.|))
-import Control.Monad.Trans.State (StateT, evalStateT)
+import Control.Monad (unless)
+import Control.Monad.Trans.Class (lift)
+import Control.Monad.Trans.State (StateT, evalStateT, get, gets, modify)
 import qualified Data.ByteString as BS
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
@@ -63,20 +65,141 @@ toBytes = await >>= \case
     toBytes
   Nothing -> return ()
 
+-- Internal
+
 data DecodeState = DecodeState
   { isQuoted  :: Bool
+  , fields    :: [BS.ByteString]
   , collected :: BS.ByteString
   } deriving (Eq, Show)
 
+type Decoder m = StateT DecodeState (ConduitT Word8 [BS.ByteString] m) ()
+type Modifier = DecodeState -> DecodeState
+
 newDecodeState :: DecodeState
 newDecodeState = DecodeState
   { isQuoted  = False
+  , fields    = []
   , collected = ""
   }
 
-decodeLoop
-  :: Monad m
-  => StateT DecodeState (ConduitT Word8 [BS.ByteString] m) ()
-decodeLoop = return ()
+-- Decoders
+
+decodeLoop :: Monad m => Decoder m
+decodeLoop = lift await >>= \case
+  Just byte -> case byte of
+    0x22 -> processQuote
+    0x2c -> processComma
+    0x0d -> processCR
+    0x0a -> processLF
+    _    -> performAction $ addByte byte
+  Nothing -> cleanup
+
+processQuote :: Monad m => Decoder m
+processQuote = gets isQuoted >>= \case
+  True  -> processQuotedQuote
+  False -> processUnquotedQuote
+
+processComma :: Monad m => Decoder m
+processComma = gets isQuoted >>= performAction . \case
+  True  -> addByte 0x2c
+  False -> commitField
+
+processCR :: Monad m => Decoder m
+processCR = gets isQuoted >>= \case
+  True  -> performAction $ addByte 0xd
+  False -> endRow
+
+processLF :: Monad m => Decoder m
+processLF = gets isQuoted >>= \case
+  True  -> performAction $ addByte 0xa
+  False -> endRow
+
+processQuotedQuote :: Monad m => Decoder m
+processQuotedQuote = lift await >>= \case
+  Just byte -> case byte of
+    0x22 -> performAction $ addByte 0x22 -- quote
+    0x2c -> performAction commitField    -- comma
+    0x0d -> commitRow                    -- carriage return
+    0x0a -> commitRow                    -- line feed
+    _    -> corruptedField
+  Nothing -> cleanup
+
+processUnquotedQuote :: Monad m => Decoder m
+processUnquotedQuote = gets (BS.null . collected) >>= \case
+  True  -> performAction setQuoted
+  False -> corruptedField
+
+endRow :: Monad m => Decoder m
+endRow = do
+  s <- get
+  if null (fields s) && BS.null (collected s)
+    then decodeLoop
+    else commitRow
+
+commitRow :: Monad m => Decoder m
+commitRow = do
+  modify commitField
+  gets fields >>= lift . yield
+  performAction dropFields
+
+corruptedField :: Monad m => Decoder m
+corruptedField = do
+  modify dropField
+  ignoreField
+
+ignoreField :: Monad m => Decoder m
+ignoreField = lift await >>= \case
+  Just byte -> case byte of
+    0x2c -> performAction commitField -- comma
+    0x0d -> commitRow
+    _    -> ignoreField
+  Nothing -> cleanup
+
+cleanup :: Monad m => Decoder m
+cleanup = do
+  gets isQuoted >>= \case
+    True  -> modify $ commitField . dropField
+    False -> gets (BS.null . collected) >>= \case
+      True  -> return ()
+      False -> modify commitField
+  fs <- gets fields
+  unless (null fs) $
+    lift $ yield fs
+
+performAction :: Monad m => Modifier -> Decoder m
+performAction f = do
+  modify f
+  decodeLoop
+
+-- Modifiers
+
+addByte :: Word8 -> Modifier
+addByte b s = let
+  collected' = BS.snoc (collected s) b
+  in s { collected = collected' }
+
+commitField :: Modifier
+commitField s = let
+  isQuoted'  = False
+  fields'    = fields s ++ [collected s]
+  collected' = ""
+  in s
+  { isQuoted  = isQuoted'
+  , fields    = fields'
+  , collected = collected'
+  }
+
+dropFields :: Modifier
+dropFields s = s { fields = [] }
+
+dropField :: Modifier
+dropField s = s
+  { isQuoted  = False
+  , collected = ""
+  }
+
+setQuoted :: Modifier
+setQuoted s = s { isQuoted = True }
 
 --jl