module Pipes.KeyValueCsv.Internal.Csv where
import Pipes.KeyValueCsv.Internal.Types
import Pipes.KeyValueCsv.Common
import Pipes.KeyValueCsv.Types.Common
import Pipes.KeyValueCsv.Types.Csv
import Control.Monad.State.Strict
import Data.Reflection (Given(..))
import Data.Validation
import Data.Vinyl
import Data.Vinyl.Functor
import Pipes
import qualified Pipes.Prelude as Pipes
import Pipes.Group (FreeT(..), FreeF(..))
import qualified Pipes.Group as Group
import Pipes.Parse.Tutorial()
parseLine
:: forall (m :: * -> *) (f :: k -> *) (rs :: [k]) (r :: *)
. ( Monad m
, Given Delimiter
)
=> Rec (CellParser m f) rs
-> Line m r
-> Producer (Rec (WithCsvError :. f) rs) m r
parseLine parser = parseCells parser . cells
parseCells
:: forall (m :: * -> *) (f :: k -> *) (rs :: [k]) (x :: *)
. Monad m
=> Rec (CellParser m f) rs
-> Cells m x
-> Producer (Rec (WithCsvError :. f) rs) m x
parseCells parser stream = do
(result, end) <- lift $ fromCells parser stream
yield result
pure end
validateCell :: (Either String :. f) a -> (Validation [CsvError] :. f) a
validateCell (Compose e) = Compose r
where
r = case e of
Left err -> Failure [CellParseError err]
Right a -> Success a
buildFromCells
:: Monad m
=> Rec (CellParser m f) (r ': rs)
-> Cells m x
-> m ( Rec (WithCsvError :. f) rs -> Rec (WithCsvError :. f) (r ': rs)
, Cells m x
)
buildFromCells (Compose (WrapParser parser) :& _) (Cells fs) = do
ft <- runFreeT fs
case ft of
Pure r -> pure (\rs -> Compose (Failure [MissingCell]) :& rs, Cells $ pure r)
Free (Cell cell) -> do
(result,leftovers) <- runStateT parser cell
end <- runEffect $ leftovers >-> Pipes.drain
pure (\rs -> validateCell result :& rs, Cells end)
fromCells
:: Monad m
=> Rec (CellParser m f) rs
-> Cells m x
-> m (Rec (WithCsvError :. f) rs, x)
fromCells RNil (Cells fs) = do
end <- runEffect $ Group.concats ( Group.maps unCell fs) >-> Pipes.drain
pure (RNil, end)
fromCells parsers@(_ :& ps) stream = do
(run, remaining) <- buildFromCells parsers stream
(result, end) <- fromCells ps remaining
pure (run result, end)