Csv.hs

{-|
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 -> (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) -- ^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 (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 -- ^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)