{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Composite.XStep (
RSource(runSource)
, RSource'
, XStep
, XStep'
, runSourceI
, runXStep
, prependXStep
) where
import Composite.Record
import Data.Functor.Identity
import Data.Vinyl
import Data.Vinyl.TypeLevel
import Data.Vinyl.XRec
newtype RSource r m a = RSource { runSource :: r -> m a }
type RSource' r = RSource (Record r)
instance Functor m => IsoHKD (RSource r m) (s :-> a) where
type HKD (RSource r m) (s :-> a) = r -> m a
unHKD f = RSource $ fmap Val . f
toHKD (RSource f) = fmap getVal . f
type XStep m a = XRec (RSource a m)
type XStep' m a = XStep m (Record a)
runSourceI :: Functor m => RSource r m a -> r -> m (Identity a)
runSourceI x = fmap Identity . runSource x
runXStep :: (IsoXRec (RSource a m) b, Applicative m) => XStep m a b -> a -> m (Record b)
runXStep x y = rtraverse (`runSourceI` y) (fromXRec x)
prependXStep :: (IsoXRec (RSource' a m) b, Applicative m) => XStep' m a b -> Record a -> m (Record (b ++ a))
prependXStep f x = (<+> x) <$> runXStep f x