33ac899 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Add wrapDomEventMaybe

33ac899Ryan Trinkle12 years ago

src/Reflex/Dom/Widget/Basic.hs+8−5

compare with develop

unifiedsplit

@@ -18,7 +18,7 @@ import Control.Monad.State

18import Control.Monad.Ref

19import GHCJS.DOM.Node

20import GHCJS.DOM.UIEvent

21−import GHCJS.DOM.EventM (event, Signal)

21+import GHCJS.DOM.EventM (event, Signal, EventM)

22import GHCJS.DOM.Document

23import GHCJS.DOM.Element

24import GHCJS.DOM.HTMLElement

@@ -370,14 +370,17 @@ deleteBetweenInclusive s e = do

370-- Adapters

371--------------------------------------------------------------------------------

372

373−--TODO: Get rid of extra version of this function

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 = do

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

375 postGui <- askPostGui

378 postGui <- askPostGui

376 runWithActions <- askRunWithActions

379 runWithActions <- askRunWithActions

377 e <- newEventWithTrigger $ \et -> do

380 e <- newEventWithTrigger $ \et -> do

378 unsubscribe <- {-# SCC "a" #-} liftIO $ {-# SCC "b" #-} elementOnevent element $ {-# SCC "c" #-} do

381 unsubscribe <- {-# SCC "a" #-} liftIO $ {-# SCC "b" #-} elementOnevent element $ {-# SCC "c" #-} do

379− v <- {-# SCC "d" #-} getValue

382+ mv <- {-# SCC "d" #-} getValue

380− liftIO $ postGui $ runWithActions [et :=> v]

383+ forM_ mv $ \v -> liftIO $ postGui $ runWithActions [et :=> v]

381 return $ liftIO $ do

384 return $ liftIO $ do

382 {-# SCC "e" #-} unsubscribe

385 {-# SCC "e" #-} unsubscribe

383 return $! {-# SCC "f" #-} e

386 return $! {-# SCC "f" #-} e