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))
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
missing = recPure (Compose $ Failure [MissingValue])
parseKeyValue
:: forall (m :: * -> *) (f :: k -> *) (rs :: [k]) (r :: *)
. ( Given Delimiter
, Monad m
, Record rs
)
=> Rec (CellParser m f) rs
-> Rec (Const Text) rs
-> Set Text
-> Line m r
-> Producer (Rec (WithKeyValueError :. f) rs) m r
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)
-> Rec (CellParser m f) rs
-> Rec (Const Text) rs
-> Rec (WithKeyValueError :. f) rs
-> m (Rec (WithKeyValueError :. f) rs, x)
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)