{-| Module : Pipes.KeyValueCsv.Internal.Csv Copyright : (c) Marcin Mrotek, 2015 License : BSD3 Maintainer : marcin.jan.mrotek@gmail.com Stability : experimental Helper classes and functions. -} {-# LANGUAGE DataKinds , FlexibleContexts , FlexibleInstances , GADTs , MultiParamTypeClasses , PolyKinds , RankNTypes , TypeOperators #-} 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 -- ^Parse a single row from a stream of text, discard the remaining characters. parseLine parser = parseCells parser . cells parseCells :: forall (m :: * -> *) (f :: k -> *) (rs :: [k]) (x :: *) . Monad m => Rec (CellParser m f) rs -- ^Parser record. -> Cells m x -- ^Stream of cells. -> Producer (Rec (WithCsvError :. f) rs) m x -- ^Parse a row of cells and pack it into a one-shot 'Producer'. parseCells parser stream = do (result, end) <- lift $ fromCells parser stream yield result pure end validateCell :: (Either String :. f) a -> (AccValidation [CsvError] :. f) a validateCell (Compose e) = Compose r where r = case e of Left err -> AccFailure [CellParseError err] Right a -> AccSuccess a buildFromCells :: Monad m => Rec (CellParser m f) (r ': rs) -- ^Parser record. -> Cells m x -- ^Stream of cells. -> m ( Rec (WithCsvError :. f) rs -> Rec (WithCsvError :. f) (r ': rs) , Cells m x ) -- ^A helper function for the 'FromCells' type class. Build a 'Rec' incrementally from 'Cells'. buildFromCells (Compose (WrapParser parser) :& _) (Cells fs) = do ft <- runFreeT fs case ft of Pure r -> pure (\rs -> Compose (AccFailure [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 -- ^Parser record. -> Cells m x -- ^Stream of cells. -> m (Rec (WithCsvError :. f) rs, x) -- ^Parse a row of cells. For more information about parsing with Pipes, see "Pipes.Parse.Tutorial". 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)