module Pipes.KeyValueCsv.KeyValue
( module Pipes.KeyValueCsv.KeyValue
, Record
, KeyValueError(..)
) where
import Pipes.KeyValueCsv.Internal.KeyValue
import Pipes.KeyValueCsv.Internal.Types
import Pipes.KeyValueCsv.Types.KeyValue
import Control.Lens
import Data.Reflection
import qualified Data.Set as Set
import Data.Validation
import Data.Vinyl
import Data.Vinyl.Functor
import Pipes
import qualified Pipes.Prelude as Pipes
import qualified Pipes.Group as Group
parseKeyValues
:: forall (m :: * -> *) (f :: k -> *) (rs :: [k]) (r :: *)
. ( Given Delimiter
, Monad m
, Record rs
)
=> KeyValueOptions m f rs
-> Lines m r
-> m (Rec (WithKeyValueError :. f) rs, r)
parseKeyValues options =
foldHeader
. Group.concats
. Group.maps (parseKeyValue (options^.kvParser) names names'set)
. unLines
where
names = options^.keyNames
names'set = Set.fromList $ recordToList names
foldHeader
:: ( Monad m
, Record rs
)
=> Producer (Rec (WithKeyValueError :. f) rs) m r
-> m (Rec (WithKeyValueError :. f) rs, r)
foldHeader = Pipes.fold' joinRecs missing id
joinRecs :: Rec (WithKeyValueError :. f) rs -> Rec (WithKeyValueError :. f) rs -> Rec (WithKeyValueError :. f) rs
joinRecs RNil RNil = RNil
joinRecs RNil _ = error "impossible"
joinRecs _ RNil= error "impossible"
joinRecs (Compose va :& as) (Compose vb :& bs) = Compose new :& joinRecs as bs
where
new = case (va, vb) of
(AccSuccess a, AccFailure [MissingValue]) -> AccSuccess a
(AccFailure [MissingValue], AccSuccess b) -> AccSuccess b
(AccSuccess _, AccSuccess _) -> AccFailure [MultipleValues]
(AccSuccess _, AccFailure f) -> AccFailure f
(AccFailure f, AccSuccess _) -> AccFailure f
(AccFailure [MissingValue], AccFailure f) -> AccFailure f
(AccFailure f, AccFailure [MissingValue]) -> AccFailure f
(AccFailure f1, AccFailure f2) -> AccFailure $ MultipleValues : (f1++f2)