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

git.iko.soy/reflex-dom

on develop help sign in

Switch back to Element instead of HTMLElement

41255deRyan Trinkle9 years ago

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

compare with develop

unifiedsplit

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

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

138import GHCJS.DOM.Types

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

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

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

141 ToDOMString, TouchEvent, WheelEvent, uncheckedCastTo, ClipboardEvent)

142import qualified GHCJS.DOM.Types as DOM

143import GHCJS.DOM.UIEvent

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

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

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

316 triggerRef <- liftIO $ newIORef Nothing

317− _ <- elementOnEventName en e $ do

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

318 evt <- DOM.event

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

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

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

350 }

351

352{-# 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)

354makeElement elementTag cfg child = do

355 doc <- askDocument

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

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

357 Nothing -> createElement doc elementTag

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

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

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

377instance DomSpace GhcjsDomSpace where

378 type EventSpec GhcjsDomSpace = GhcjsEventSpec

379 type RawTextNode GhcjsDomSpace = DOM.Text

380− type RawElement GhcjsDomSpace = DOM.HTMLElement

380+ type RawElement GhcjsDomSpace = DOM.Element

381 type RawFile GhcjsDomSpace = DOM.File

382 type RawInputElement GhcjsDomSpace = DOM.HTMLInputElement

383 type RawTextAreaElement GhcjsDomSpace = DOM.HTMLTextAreaElement

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

427 { _ghcjsEventSpec_filters = mempty

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

429 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

431 runReaderT (defaultDomEventHandler e en) evt

432 }

433

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

952 EventType 'TouchcancelTag = TouchEvent

953

954{-# 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))

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

957 Click -> return ()

958 Dblclick -> getMouseEventCoords

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

1150 Touchend -> "Touchend"

1151 Touchcancel -> "Touchcancel"

1152

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+

1153{-# INLINABLE elementOnEventName #-}

1161{-# INLINABLE elementOnEventName #-}

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

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

1155−elementOnEventName en e = case en of

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

1156 Abort -> on e Events.abort

1164 Abort -> on e Events.abort

1157 Blur -> on e Events.blur

1165 Blur -> on e Events.blur

1158 Change -> on e Events.change

1166 Change -> on e Events.change

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

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

70import GHCJS.DOM.NamedNodeMap as NNM

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

72import GHCJS.DOM.Types

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

73+ (liftJSM, JSM, IsHTMLElement, IsNode)

74import qualified GHCJS.DOM.Types as DOM

75import Reflex.Class

76import Reflex.Dom.Builder.Class

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

116 , MonadIO m

117 , MonadIO (Performable m)

118#ifndef ghcjs_HOST_OS

119− , MonadJSM m

119+ , DOM.MonadJSM m

120− , MonadJSM (Performable m)

120+ , DOM.MonadJSM (Performable m)

121#endif

122 , TriggerEvent t m

123 , HasJSContext m

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

233wrapElement eh e = do

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

235 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)

237 { _rawElementConfig_eventSpec = def

238 { _ghcjsEventSpec_handler = GhcjsEventHandler h

239 }

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

241

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

243unsafePlaceElement e = do

244− placeRawElement e

244+ placeRawElement $ DOM.toElement e

245− wrapRawElement e def

245+ wrapRawElement (DOM.toElement e) def

246

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

248namedNodeMapGetNames self = do

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

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

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

29import GHCJS.DOM.EventM (on)

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

31+import qualified GHCJS.DOM.Types as DOM

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

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

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

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

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

79 then return Nothing

80 then return Nothing

80 else fmap Just reset

81 else fmap Just reset

81 pb <- delay 0 =<< getPostBuild

82 pb <- delay 0 =<< getPostBuild

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

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

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

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

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

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

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

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

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

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