module Control.Wire.Core
(
Wire,
evalWith,
initial,
withM,
Event,
catMapE,
hold,
hold',
never,
unfoldE,
Switch(..),
manage,
manage',
sequenceW,
switch,
switch',
hoistW
)
where
import Control.Wire.Internal
newtype Switch f m a b =
Switch {
fromSwitch :: forall s. (Wire m a b -> s) -> f s -> f s
}
catMapE :: (a -> Maybe b) -> Event a -> Event b
catMapE f = event NotNow (maybe NotNow Now . f)
evalWith :: (Applicative m) => (forall b. a -> b -> b) -> Wire m a a
evalWith strat = let w = Wire (\x -> x `strat` pure (x, w)) in w
hoistW :: (Functor m) => (a -> a') -> (forall x. a -> m' x -> m x) -> Wire m' a' b -> Wire m a b
hoistW f trans = go
where
go w' =
Wire $ \x ->
(\ ~(y, w) -> (y, go w))
<$> trans x (stepWire w' (f x))
hold :: (Applicative m) => a -> Wire m (Event a) a
hold x' = delayW x' (hold' x')
hold' :: (Applicative m) => a -> Wire m (Event a) a
hold' x' = Wire $ (\x -> pure (x, hold' x)) . event x' id
initial :: (Applicative m) => Wire m (m a) a
initial = Wire $ fmap (\y -> (y, pure y))
manage
:: (Traversable f, Applicative m)
=> f (Wire m a b)
-> Wire m (a, Event (Switch f m a b)) (f b)
manage ws' =
Wire $ \ ~(x, mf) ->
(\ys -> (fst <$> ys,
manage (event id (\(Switch f) -> f id) mf (snd <$> ys))))
<$> traverse (`stepWire` x) ws'
manage'
:: (Traversable f, Applicative m)
=> f (Wire m a b)
-> Wire m (a, Event (Switch f m a b)) (f b)
manage' ws' =
Wire $ \ ~(x, mf) ->
(\ys -> (fst <$> ys,
manage' (snd <$> ys)))
<$> traverse (`stepWire` x) (event id (\(Switch f) -> f id) mf ws')
never :: Event a
never = NotNow
sequenceW :: (Traversable f, Applicative m) => f (Wire m a b) -> Wire m a (f b)
sequenceW ws' =
Wire $ \x ->
(\ys -> (fst <$> ys,
sequenceW (snd <$> ys)))
<$> traverse (\w' -> stepWire w' x) ws'
switch :: (Functor m) => Wire m a (b, Event (Wire m a b)) -> Wire m a b
switch w' =
Wire $ \x ->
(\ ~(~(y, mw), w) -> (y, event (switch w) id mw))
<$> stepWire w' x
switch' :: (Monad m) => Wire m a (b, Event (Wire m a b)) -> Wire m a b
switch' w' =
Wire $ \x -> do
~(~(y, mw), w) <- stepWire w' x
case mw of
NotNow -> pure (y, switch' w)
Now nw -> stepWire nw x
unfoldE :: (Applicative m) => s -> Wire m (Event (s -> (a, s))) (Event a)
unfoldE s' =
Wire $ \mf ->
pure (case mf of
NotNow -> (NotNow, unfoldE s')
Now f -> let (x, s) = f s' in (Now x, unfoldE s))
withM :: (Monad m) => (s -> Wire m a b) -> (a -> m s) -> Wire m a b
withM w f =
Wire $ \x -> do
s0 <- f x
stepWire (w s0) x