@@ -18,7 +18,7 @@ import Control.Monad.State
1818import Control.Monad.Ref
1919import GHCJS.DOM.Node
2020import GHCJS.DOM.UIEvent
21−import GHCJS.DOM.EventM (event, Signal)
21+import GHCJS.DOM.EventM (event, Signal, EventM)
2222import GHCJS.DOM.Document
2323import GHCJS.DOM.Element
2424import GHCJS.DOM.HTMLElement
@@ -370,14 +370,17 @@ deleteBetweenInclusive s e = do
370370-- Adapters
371371--------------------------------------------------------------------------------
372372
373−--TODO: Get rid of extra version of this function
374−wrapDomEvent element elementOnevent getValue = do
373+wrapDomEvent :: (Functor (Event t), MonadIO m, MonadSample t m, MonadReflexCreateTrigger t m, Reflex t, HasPostGui t h m) => e -> (e -> EventM event e () -> IO (IO ())) -> EventM event e a -> m (Event t a)
374+wrapDomEvent element elementOnevent getValue = wrapDomEventMaybe element elementOnevent $ liftM Just getValue
375+
376+wrapDomEventMaybe :: (Functor (Event t), MonadIO m, MonadSample t m, MonadReflexCreateTrigger t m, Reflex t, HasPostGui t h m) => e -> (e -> EventM event e () -> IO (IO ())) -> EventM event e (Maybe a) -> m (Event t a)
377+wrapDomEventMaybe element elementOnevent getValue = do
375378 postGui <- askPostGui
376379 runWithActions <- askRunWithActions
377380 e <- newEventWithTrigger $ \et -> do
378381 unsubscribe <- {-# SCC "a" #-} liftIO $ {-# SCC "b" #-} elementOnevent element $ {-# SCC "c" #-} do
379− v <- {-# SCC "d" #-} getValue
380− liftIO $ postGui $ runWithActions [et :=> v]
382+ mv <- {-# SCC "d" #-} getValue
383+ forM_ mv $ \v -> liftIO $ postGui $ runWithActions [et :=> v]
381384 return $ liftIO $ do
382385 {-# SCC "e" #-} unsubscribe
383386 return $! {-# SCC "f" #-} e