@@ -4,6 +4,7 @@ module Reflex.Host.Class where
44import Reflex.Class
55
66import Control.Applicative
7+import Control.Monad
78import Control.Monad.Fix
89import Control.Monad.Trans
910import Control.Monad.Trans.Reader (ReaderT())
@@ -13,7 +14,7 @@ import Control.Monad.Trans.Except (ExceptT())
1314import Control.Monad.Trans.RWS (RWST())
1415import Control.Monad.Trans.State (StateT())
1516import qualified Control.Monad.Trans.State.Strict as Strict
16−import Data.Dependent.Sum (DSum)
17+import Data.Dependent.Sum (DSum (..))
1718import Data.Monoid
1819import Data.GADT.Compare
1920import Control.Monad.Ref
@@ -114,6 +115,25 @@ newEventWithTriggerRef = do
114115 return (e, rt)
115116{-# INLINE newEventWithTriggerRef #-}
116117
118+fireEventRef :: (MonadReflexHost t m, MonadRef m, Ref m ~ Ref IO) => Ref m (Maybe (EventTrigger t a)) -> a -> m ()
119+fireEventRef mtRef input = do
120+ mt <- readRef mtRef
121+ case mt of
122+ Nothing -> return ()
123+ Just trigger -> fireEvents [trigger :=> input]
124+
125+fireEventRefAndRead :: (MonadReflexHost t m, MonadRef m, Ref m ~ Ref IO) => Ref m (Maybe (EventTrigger t a)) -> a -> EventHandle t b -> m (Maybe b)
126+fireEventRefAndRead mtRef input e = do
127+ mt <- readRef mtRef
128+ case mt of
129+ Nothing -> return Nothing -- Since we aren't firing the input, the output can't fire
130+ Just trigger -> fireEventsAndRead [trigger :=> input] $ do
131+ mGetValue <- readEvent e
132+ case mGetValue of
133+ Nothing -> return Nothing
134+ Just getValue -> liftM Just getValue
135+
136+
117137--------------------------------------------------------------------------------
118138-- Instances
119139--------------------------------------------------------------------------------