e0082a2 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Add addEventSpecFlags

commite0082a21ad2ebbf2f7b35463182d54e800840174 authorRyan Trinkle <ryan.trinkle@gmail.com> dateMon 15 Aug 2016, 17:49 (10 years ago) parent4d95d05

3 files changed+16

compare with develop

unifiedsplit

src/Reflex/Dom/Builder/Class.hs+1 src/Reflex/Dom/Builder/Immediate.hs+14 src/Reflex/Dom/Builder/Static.hs+1

src/Reflex/Dom/Builder/Class.hs+1

@@ -52,6 +52,7 @@ class Default (EventSpec d EventResult) => DomSpace d where

5252 type RawElement d :: *

5353 type RawInputElement d :: *

5454 type RawTextAreaElement d :: *

55+ addEventSpecFlags :: proxy d -> EventName en -> (Maybe (er en) -> EventFlags) -> EventSpec d er -> EventSpec d er

5556

5657-- | @'DomBuildek' t m@ indicates that @m@ is a 'Monad' capable of building dynamic DOM in the 'Reflex' timeline @t@

5758class (Monad m, Reflex t, Deletable t m, DomSpace (DomBuilderSpace m)) => DomBuilder t m | m -> t where

src/Reflex/Dom/Builder/Immediate.hs+14

@@ -38,6 +38,7 @@ import Data.Dependent.Sum

3838import Data.Functor.Misc

3939import Data.IORef

4040import Data.Maybe

41+import Data.Monoid

4142import Data.Text (Text)

4243import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode)

4344import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setAttribute, setAttributeNS)

@@ -200,6 +201,19 @@ instance DomSpace GhcjsDomSpace where

200201 type RawElement GhcjsDomSpace = DOM.HTMLElement

201202 type RawInputElement GhcjsDomSpace = DOM.HTMLInputElement

202203 type RawTextAreaElement GhcjsDomSpace = DOM.HTMLTextAreaElement

204+ addEventSpecFlags _ en f es = es

205+ { _ghcjsEventSpec_filters =

206+ let f' = Just . GhcjsEventFilter . \case

207+ Nothing -> \evt -> do

208+ mEventResult <- _ghcjsEventSpec_handler es (en, evt)

209+ return (f mEventResult, return mEventResult)

210+ Just (GhcjsEventFilter oldFilter) -> \evt -> do

211+ (oldFlags, oldContinuation) <- oldFilter evt

212+ mEventResult <- oldContinuation

213+ let newFlags = oldFlags <> f mEventResult

214+ return (newFlags, return mEventResult)

215+ in DMap.alter f' en $ _ghcjsEventSpec_filters es

216+ }

203217

204218newtype GhcjsEventFilter er en = GhcjsEventFilter (GhcjsDomEvent en -> IO (EventFlags, IO (Maybe (er en))))

205219

src/Reflex/Dom/Builder/Static.hs+1

@@ -123,6 +123,7 @@ instance DomSpace StaticDomSpace where

123123 type RawElement StaticDomSpace = ()

124124 type RawInputElement StaticDomSpace = ()

125125 type RawTextAreaElement StaticDomSpace = ()

126+ addEventSpecFlags _ _ _ _ = StaticEventSpec

126127

127128instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) where

128129 type DomBuilderSpace (StaticDomBuilderT t m) = StaticDomSpace