module Control.Wire.Trans.Exhibit
(
WExhibit(..)
)
where
import Control.Arrow
import Control.Wire.Types
class Arrow (>~) => WExhibit (>~) where
event :: Wire e (>~) a b -> Wire e (>~) a (Maybe b)
exhibit :: Wire e (>~) a b -> Wire e (>~) a (Either e b)
gotEvent :: Wire e (>~) a b -> Wire e (>~) a Bool
instance Monad m => WExhibit (Kleisli m) where
event (WmPure f) =
WmPure $ \(f -> (mx, w)) ->
(Right (either (const Nothing) Just mx), event w)
event (WmGen c) =
WmGen $ \x' -> do
(mx, w) <- c x'
return (Right (either (const Nothing) Just mx), event w)
exhibit (WmPure f) =
WmPure $ \(f -> (mx, w)) ->
(Right mx, exhibit w)
exhibit (WmGen c) =
WmGen $ \x' -> do
(mx, w) <- c x'
return (Right mx, exhibit w)
gotEvent (WmPure f) =
WmPure $ \(f -> (mx, w)) ->
(Right (isRight mx), gotEvent w)
gotEvent (WmGen c) =
WmGen $ \x' -> do
(mx, w) <- c x'
return (Right (isRight mx), gotEvent w)
isRight :: Either e a -> Bool
isRight (Right _) = True
isRight (Left _) = False