module Control.Wire.Trans.Combine
(
context,
contextLatest,
contextLimit,
multicast
)
where
import qualified Control.Wire.TimedMap as Tm
import qualified Data.Map as M
import qualified Data.Traversable as T
import Control.Wire.TimedMap (TimedMap)
import Control.Wire.Wire
import Data.Map (Map)
context ::
forall a b m e k. (Monad m, Ord k)
=> (a -> k)
-> Wire e m a b
-> Wire e m a b
context key w0 = context' M.empty 0
where
context' :: Map k (Wire e m a b, Time) -> Time -> Wire e m a b
context' !ctxs t' =
mkGen $ \dt' x' -> do
let ctx = key x'
(w', t0) = M.findWithDefault (w0, t') ctx ctxs
t = t' + dt'
dt = t t0
(mx, w) <- dt `seq` stepWire w' dt x'
return (mx, context' (M.insert ctx (w, t) ctxs) t)
contextLatest ::
(Monad m, Ord k)
=> (a -> k)
-> Int
-> Wire e m a b
-> Wire e m a b
contextLatest key maxWires = contextLimit key (\_ _ -> Tm.cut maxWires)
contextLimit ::
forall a b m e k. (Monad m, Ord k)
=> (a -> k)
-> (forall w. Int -> Time -> TimedMap Time k w -> TimedMap Time k w)
-> Wire e m a b
-> Wire e m a b
contextLimit key uf w0 = context' 0 Tm.empty 0
where
context' :: Int -> TimedMap Time k (Wire e m a b) -> Time -> Wire e m a b
context' !n !ctxs t' =
mkGen $ \dt' x' -> do
let ctx = key x'
(w', t0) = Tm.findWithDefault (w0, t') ctx ctxs
t = t' + dt'
dt = t t0
(mx, w) <- dt `seq` stepWire w' dt x'
return (mx, context' (n + 1) (uf n t (Tm.insert t ctx w ctxs)) t)
multicast ::
(Monad m, T.Traversable f)
=> f (Wire e m a b)
-> Wire e m a (f b)
multicast ws' =
mkGen $ \dt x' -> do
res <- T.mapM (\w -> stepWire w dt x') ws'
let resx = T.sequence . fmap (\(mx, w) -> fmap (, w) mx) $ res
return (fmap (fmap fst) resx, multicast (fmap snd res))