41255de · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Switch back to Element instead of HTMLElement

commit41255deec77a7368fa10b8dc803bdd842c6ea06e authorRyan Trinkle <ryan.trinkle@gmail.com> dateThu 4 May 2017, 17:16 (9 years ago) parent8ac807c

3 files changed+26−17

compare with develop

unifiedsplit

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+17−9 reflex-dom-core/src/Reflex/Dom/Old.hs+6−6 reflex-dom-core/src/Reflex/Dom/Widget/Resize.hs+3−2

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+17−9

@@ -137,7 +137,7 @@ import GHCJS.DOM.Node (appendChild_, getOwnerDocumentUnchecked, getParentNodeUnc

137137import qualified GHCJS.DOM.Node as DOM (insertBefore_)

138138import GHCJS.DOM.Types

139139 (liftJSM, askJSM, runJSM, JSM, MonadJSM(..),

140− FocusEvent, IsHTMLElement, IsEvent, IsNode, KeyboardEvent, Node,

140+ FocusEvent, IsElement, IsEvent, IsNode, KeyboardEvent, Node,

141141 ToDOMString, TouchEvent, WheelEvent, uncheckedCastTo, ClipboardEvent)

142142import qualified GHCJS.DOM.Types as DOM

143143import GHCJS.DOM.UIEvent

@@ -314,7 +314,7 @@ wrap e cfg = do

314314 Just ns -> maybe (removeAttributeNS e (Just ns) n) (setAttributeNS e (Just ns) n) mv

315315 eventTriggerRefs :: DMap EventName (EventFilterTriggerRef t er) <- liftJSM $ fmap DMap.fromList $ forM (DMap.toList $ _ghcjsEventSpec_filters $ _rawElementConfig_eventSpec cfg) $ \(en :=> GhcjsEventFilter f) -> do

316316 triggerRef <- liftIO $ newIORef Nothing

317− _ <- elementOnEventName en e $ do

317+ _ <- elementOnEventName en e $ do --TODO: Something safer than this cast

318318 evt <- DOM.event

319319 (flags, k) <- liftJSM $ f $ GhcjsDomEvent evt

320320 when (_eventFlags_preventDefault flags) $ withIsEvent en DOM.preventDefault

@@ -350,10 +350,10 @@ wrap e cfg = do

350350 }

351351

352352{-# INLINABLE makeElement #-}

353−makeElement :: forall er t m a. SupportsImmediateDomBuilder t m => Text -> ElementConfig er t (ImmediateDomBuilderT t m) -> ImmediateDomBuilderT t m a -> ImmediateDomBuilderT t m ((Element er GhcjsDomSpace t, a), DOM.HTMLElement)

353+makeElement :: forall er t m a. SupportsImmediateDomBuilder t m => Text -> ElementConfig er t (ImmediateDomBuilderT t m) -> ImmediateDomBuilderT t m a -> ImmediateDomBuilderT t m ((Element er GhcjsDomSpace t, a), DOM.Element)

354354makeElement elementTag cfg child = do

355355 doc <- askDocument

356− e <- liftJSM $ uncheckedCastTo DOM.HTMLElement <$> case cfg ^. namespace of

356+ e <- liftJSM $ uncheckedCastTo DOM.Element <$> case cfg ^. namespace of

357357 Nothing -> createElement doc elementTag

358358 Just ens -> createElementNS doc (Just ens) elementTag

359359 ImmediateDomBuilderT $ iforM_ (cfg ^. initialAttributes) $ \(AttributeName mAttrNamespace n) v -> case mAttrNamespace of

@@ -377,7 +377,7 @@ data GhcjsDomSpace

377377instance DomSpace GhcjsDomSpace where

378378 type EventSpec GhcjsDomSpace = GhcjsEventSpec

379379 type RawTextNode GhcjsDomSpace = DOM.Text

380− type RawElement GhcjsDomSpace = DOM.HTMLElement

380+ type RawElement GhcjsDomSpace = DOM.Element

381381 type RawFile GhcjsDomSpace = DOM.File

382382 type RawInputElement GhcjsDomSpace = DOM.HTMLInputElement

383383 type RawTextAreaElement GhcjsDomSpace = DOM.HTMLTextAreaElement

@@ -427,7 +427,7 @@ instance er ~ EventResult => Default (GhcjsEventSpec er) where

427427 { _ghcjsEventSpec_filters = mempty

428428 , _ghcjsEventSpec_handler = GhcjsEventHandler $ \(en, GhcjsDomEvent evt) -> do

429429 t :: DOM.EventTarget <- withIsEvent en $ Event.getTarget evt --TODO: Rework this; defaultDomEventHandler shouldn't need to take this as an argument

430− let e = uncheckedCastTo DOM.HTMLElement t

430+ let e = uncheckedCastTo DOM.Element t

431431 runReaderT (defaultDomEventHandler e en) evt

432432 }

433433

@@ -952,7 +952,7 @@ type family EventType en where

952952 EventType 'TouchcancelTag = TouchEvent

953953

954954{-# INLINABLE defaultDomEventHandler #-}

955−defaultDomEventHandler :: IsHTMLElement e => e -> EventName en -> EventM e (EventType en) (Maybe (EventResult en))

955+defaultDomEventHandler :: IsElement e => e -> EventName en -> EventM e (EventType en) (Maybe (EventResult en))

956956defaultDomEventHandler e evt = fmap (Just . EventResult) $ case evt of

957957 Click -> return ()

958958 Dblclick -> getMouseEventCoords

@@ -1150,9 +1150,17 @@ showEventName en = case en of

11501150 Touchend -> "Touchend"

11511151 Touchcancel -> "Touchcancel"

11521152

1153+--TODO: Get rid of this hack

1154+-- ElementEventTarget is here to allow us to treat SVG and HTML elements as the same thing; without it, we'll break any existing SVG code.

1155+newtype ElementEventTarget = ElementEventTarget DOM.Element deriving (DOM.IsGObject, DOM.ToJSVal, DOM.IsSlotable, DOM.IsParentNode, DOM.IsNonDocumentTypeChildNode, DOM.IsChildNode, DOM.IsAnimatable, IsNode, IsElement)

1156+instance DOM.FromJSVal ElementEventTarget where

1157+ fromJSVal = fmap (fmap ElementEventTarget) . DOM.fromJSVal

1158+instance DOM.IsEventTarget ElementEventTarget

1159+instance DOM.IsGlobalEventHandlers ElementEventTarget

1160+

11531161{-# INLINABLE elementOnEventName #-}

1154−elementOnEventName :: IsHTMLElement e => EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())

1155−elementOnEventName en e = case en of

1162+elementOnEventName :: IsElement e => EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())

1163+elementOnEventName en e_ = let e = ElementEventTarget (DOM.toElement e_) in case en of

11561164 Abort -> on e Events.abort

11571165 Blur -> on e Events.blur

11581166 Change -> on e Events.change

reflex-dom-core/src/Reflex/Dom/Old.hs+6−6

@@ -70,7 +70,7 @@ import GHCJS.DOM.EventM (EventM)

7070import GHCJS.DOM.NamedNodeMap as NNM

7171import GHCJS.DOM.Node (getFirstChild, getNodeName, removeChild)

7272import GHCJS.DOM.Types

73− (MonadJSM, liftJSM, JSM, IsHTMLElement, IsNode)

73+ (liftJSM, JSM, IsHTMLElement, IsNode)

7474import qualified GHCJS.DOM.Types as DOM

7575import Reflex.Class

7676import Reflex.Dom.Builder.Class

@@ -116,8 +116,8 @@ type MonadWidgetConstraints t m =

116116 , MonadIO m

117117 , MonadIO (Performable m)

118118#ifndef ghcjs_HOST_OS

119− , MonadJSM m

120− , MonadJSM (Performable m)

119+ , DOM.MonadJSM m

120+ , DOM.MonadJSM (Performable m)

121121#endif

122122 , TriggerEvent t m

123123 , HasJSContext m

@@ -233,7 +233,7 @@ wrapElement :: forall t m. MonadWidget t m => (forall en. DOM.HTMLElement -> Eve

233233wrapElement eh e = do

234234 let h :: (EventName en, GhcjsDomEvent en) -> JSM (Maybe (EventResult en))

235235 h (en, GhcjsDomEvent evt) = runReaderT (eh e en) evt

236− wrapRawElement e $ (def :: RawElementConfig EventResult t m)

236+ wrapRawElement (DOM.toElement e) $ (def :: RawElementConfig EventResult t m)

237237 { _rawElementConfig_eventSpec = def

238238 { _ghcjsEventSpec_handler = GhcjsEventHandler h

239239 }

@@ -241,8 +241,8 @@ wrapElement eh e = do

241241

242242unsafePlaceElement :: MonadWidget t m => DOM.HTMLElement -> m (Element EventResult (DomBuilderSpace m) t)

243243unsafePlaceElement e = do

244− placeRawElement e

245− wrapRawElement e def

244+ placeRawElement $ DOM.toElement e

245+ wrapRawElement (DOM.toElement e) def

246246

247247namedNodeMapGetNames :: DOM.NamedNodeMap -> JSM (Set Text)

248248namedNodeMapGetNames self = do

reflex-dom-core/src/Reflex/Dom/Widget/Resize.hs+3−2

@@ -28,6 +28,7 @@ import GHCJS.DOM.Element

2828import qualified GHCJS.DOM.GlobalEventHandlers as Events (scroll)

2929import GHCJS.DOM.EventM (on)

3030import GHCJS.DOM.Types (liftJSM, MonadJSM)

31+import qualified GHCJS.DOM.Types as DOM

3132

3233-- | A widget that wraps the given widget in a div and fires an event when resized.

3334-- Adapted from github.com/marcj/css-element-queries

@@ -79,8 +80,8 @@ resizeDetectorWithAttrs attrs w = do

7980 then return Nothing

8081 else fmap Just reset

8182 pb <- delay 0 =<< getPostBuild

82− expandScroll <- wrapDomEvent (_element_raw expand) (`on` Events.scroll) $ return ()

83− shrinkScroll <- wrapDomEvent (_element_raw shrink) (`on` Events.scroll) $ return ()

83+ expandScroll <- wrapDomEvent (DOM.uncheckedCastTo DOM.HTMLElement $ _element_raw expand) (`on` Events.scroll) $ return ()

84+ shrinkScroll <- wrapDomEvent (DOM.uncheckedCastTo DOM.HTMLElement $ _element_raw shrink) (`on` Events.scroll) $ return ()

8485 size0 <- performEvent $ fmap (const $ liftJSM reset) pb

8586 rec resize <- performEventAsync $ fmap (\d cb -> (liftIO . cb) =<< liftJSM (resetIfChanged d)) $ tag (current dimensions) $ leftmost [expandScroll, shrinkScroll]

8687 dimensions <- holdDyn (Nothing, Nothing) $ leftmost [ size0, fmapMaybe id resize ]