{-|
Module      : Pipes.KeyValueCsv.Internal.KeyValue
Copyright   : (c) Marcin Mrotek, 2015
License     : BSD3
Maintainer  : marcin.jan.mrotek@gmail.com
Stability   : experimental

-}

{-# LANGUAGE
    DataKinds
  , FlexibleContexts
  , FlexibleInstances
  , GADTs
  , MonadComprehensions
  , MultiParamTypeClasses
  , PolyKinds
  , ScopedTypeVariables
  , TypeOperators
  #-}

module Pipes.KeyValueCsv.Internal.KeyValue 
  ( module Pipes.KeyValueCsv.Internal.KeyValue 
  , Record
  ) where

import Pipes.KeyValueCsv.Internal
import Pipes.KeyValueCsv.Internal.Types
import Pipes.KeyValueCsv.Common
import Pipes.KeyValueCsv.Types.Common
import Pipes.KeyValueCsv.Types.KeyValue

import Control.Monad.State.Strict
import Data.Reflection
import Data.Set (Set)
import qualified Data.Set as Set
import qualified Data.Text.Lazy as Lazy
import Data.Validation
import Data.Vinyl
import Data.Vinyl.Functor
import Data.Vinyl.Utils.Proxy
import Pipes hiding (Proxy)
import qualified Pipes.Prelude as Pipes
import Pipes.Group (FreeT(..), FreeF(..))
import qualified Pipes.Group as Group

drawCell 
  :: Monad m
  => StateT (Cells m r) m (Maybe (Lazy.Text))
-- ^Draw a single cell from a 'FreeT'-delimited stream.
drawCell = StateT $ \(Cells cs) -> do
  ft <- runFreeT cs
  case ft of
    Pure r -> pure (Nothing, Cells $ pure r)
    Free (Cell cell) -> do
      (text, remaining) <- runStateT drawText cell
      r <- runEffect $ remaining >-> Pipes.drain
      pure (Just text, Cells r)

missing :: forall (f :: k -> *) (rs :: [k]). Record rs => Rec (WithKeyValueError :. f) rs
-- ^An empty record filled with 'Failure' 'MissingValue'.
missing = recPure (Compose $ Failure [MissingValue]) --missing' proxyRecord

parseKeyValue 
  :: forall (m :: * -> *) (f :: k -> *) (rs :: [k]) (r :: *)
   . ( Given Delimiter
     , Monad m
     , Record rs
     )
  => Rec (CellParser m f) rs -- ^Parser record.
  -> Rec (Const Text)     rs -- ^Key name record.
  -> Set Text                -- ^Name set.
  -> Line m r                -- ^Line to parse.
  -> Producer (Rec (WithKeyValueError :. f) rs) m r
-- ^Parse a single line into an one-shot producer of records with at most one 'Success' field.
parseKeyValue parser names names'set line = do
  (key'm, Cells cs) <- lift $ runStateT (fmap Lazy.toStrict <$> drawCell) $ cells line
  remaining'f <- lift $ runFreeT cs
  case remaining'f of
    Pure r -> pure r
    cell@(Free (Cell remaining)) -> do
      leftovers <- 
        case [k | k <- key'm, Set.member k names'set] of
          Just key -> do
            (result, leftovers) <- lift $ fromKeyValues (key, remaining) parser names missing
            yield result
            pure leftovers
          Nothing -> do
            yield missing
            pure . FreeT $ pure cell
      lift 
        . runEffect 
        $ (Group.concats . Group.maps unCell) leftovers >-> Pipes.drain

fromKeyValues 
  :: forall (m :: * -> *) (f :: k -> *) (rs :: [k]) (x :: *)
   . Monad m
  => (Text, Producer Text m x)     -- ^Key-value pair.
  -> Rec (CellParser m f)       rs -- ^Parser record.
  -> Rec (Const Text)           rs -- ^Key name record.
  -> Rec (WithKeyValueError :. f) rs -- ^Current parsing result.
  -> m (Rec (WithKeyValueError :. f) rs, x)
-- ^Parse a key-value pair into a record with at most one 'Success' field.
fromKeyValues (_,p) RNil RNil RNil = do
  x <- runEffect $ p >-> Pipes.drain
  pure (RNil, x)
fromKeyValues pair@(key,value) (Compose (WrapParser parser) :& ps) (Const expected :& ks) (r :& rs) = do
  if key == expected 
    then do
      (Compose parsed, leftovers) <- runStateT parser value
      result <- runEffect $ leftovers >-> Pipes.drain
      let validated =
            case parsed of
               Left err -> Failure [ValueParsingError err]
               Right a  -> Success a
      pure (Compose validated :& rs, result)
    else do
      (remaining, result) <- fromKeyValues pair ps ks rs
      pure (r :& remaining, result)