git.iko.soy/reflex-dom
on develop help sign in
Merge remote-tracking branch 'origin/jsaddle-0.9' into develop
commit2da056cc74d4f32953c13dee559bc63fecea5ebe authorRyan Trinkle <ryan.trinkle@gmail.com> dateSun 28 May 2017, 16:28 (9 years ago) parent38e26177447336
8 files changed+57−34
compare with develop
unifiedsplit
reflex-dom-core/reflex-dom-core.cabal+2−2 reflex-dom-core/src/Foreign/JavaScript/Orphans.hs+7−15 reflex-dom-core/src/Foreign/JavaScript/TH.hs+1 reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+23 reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+12−7 reflex-dom-core/src/Reflex/Dom/Main.hs+1−1 reflex-dom-core/src/Reflex/Dom/Widget/Input.hs+2−2 reflex-dom-core/src/Reflex/Dom/Widget/Resize.hs+9−7
reflex-dom-core/reflex-dom-core.cabal+2−2
@@ -50,8 +50,8 @@ library
5050 dependent-sum-template >= 0.0.0.4 && < 0.1,
5151 directory >= 1.2 && < 1.4,
5252 exception-transformers == 0.4.*,
53− ghcjs-dom >= 0.8.0.0 && < 0.9,
54− jsaddle >=0.8.0.1 && <0.9,
53+ ghcjs-dom >= 0.9.0.0 && < 0.10,
54+ jsaddle >=0.9.0.0 && <0.10,
5555 -- keycode-0.2 has a bug on firefox
5656 keycode >= 0.2.1 && < 0.3,
5757 lens >= 4.7 && < 5,
reflex-dom-core/src/Foreign/JavaScript/Orphans.hs+7−15
@@ -14,23 +14,15 @@ import Reflex.PerformEvent.Base (PerformEventT (..))
1414import Reflex.PostBuild.Base (PostBuildT)
1515import Reflex.Requester.Base (RequesterT)
1616import Reflex.TriggerEvent.Base
17+import Reflex.Query.Base (QueryT)
1718
18−instance (MonadJSM m, ReflexHost t) => MonadJSM (PostBuildT t m) where
19− liftJSM' = lift . liftJSM'
20−
19+instance (MonadJSM m, ReflexHost t) => MonadJSM (PostBuildT t m)
2120instance (MonadJSM (HostFrame t), ReflexHost t) => MonadJSM (PerformEventT t m) where
2221 liftJSM' = PerformEventT . lift . liftJSM'
23−
24−instance MonadJSM m => MonadJSM (DynamicWriterT t w m) where
25− liftJSM' = lift . liftJSM'
26−
27−instance MonadJSM m => MonadJSM (EventWriterT t w m) where
28− liftJSM' = lift . liftJSM'
29−
30−instance MonadJSM m => MonadJSM (RequesterT t request response m) where
31− liftJSM' = lift . liftJSM'
32−
33−instance MonadJSM m => MonadJSM (TriggerEventT t m) where
34− liftJSM' = lift . liftJSM'
22+instance MonadJSM m => MonadJSM (DynamicWriterT t w m)
23+instance MonadJSM m => MonadJSM (EventWriterT t w m)
24+instance MonadJSM m => MonadJSM (RequesterT t request response m)
25+instance MonadJSM m => MonadJSM (TriggerEventT t m)
26+instance MonadJSM m => MonadJSM (QueryT t q m)
3527
3628#endif
reflex-dom-core/src/Foreign/JavaScript/TH.hs+1
@@ -36,6 +36,7 @@ import Reflex.PerformEvent.Class
3636import Reflex.PostBuild.Base
3737import Reflex.Query.Base
3838import Reflex.Requester.Base
39+import Reflex.Query.Base (QueryT(..))
3940
4041#ifdef USE_TEMPLATE_HASKELL
4142import Language.Haskell.TH
reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+23
@@ -37,6 +37,8 @@ import Reflex.PostBuild.Base
3737import Reflex.Query.Base
3838import Reflex.Query.Class
3939import Reflex.Requester.Base
40+import Reflex.Query.Base
41+import Reflex.Query.Class
4042
4143import qualified Control.Category
4244import Control.Lens hiding (element)
@@ -625,6 +627,27 @@ instance Reflex t => HasDomEvent t (TextAreaElement EventResult d t) en where
625627instance DomBuilder t m => DomBuilder t (ReaderT r m) where
626628 type DomBuilderSpace (ReaderT r m) = DomBuilderSpace m
627629
630+instance (DomBuilder t m, MonadFix m, MonadHold t m, Group q, Query q, Additive q) => DomBuilder t (QueryT t q m) where
631+ type DomBuilderSpace (QueryT t q m) = DomBuilderSpace m
632+ textNode = liftTextNode
633+ element elementTag cfg (QueryT child) = QueryT $ do
634+ s <- get
635+ let cfg' = cfg
636+ { _elementConfig_eventSpec = _elementConfig_eventSpec cfg }
637+ (e, (a, newS)) <- lift $ element elementTag cfg' $ runStateT child s
638+ put newS
639+ return (e, a)
640+
641+ inputElement = lift . inputElement
642+ textAreaElement = lift . textAreaElement
643+ selectElement cfg (QueryT child) = QueryT $ do
644+ s <- get
645+ (e, (a, newS)) <- lift $ selectElement cfg $ runStateT child s
646+ put newS
647+ return (e, a)
648+ placeRawElement = lift . placeRawElement
649+ wrapRawElement e = lift . wrapRawElement e
650+
628651type LiftDomBuilder t f m =
629652 ( Reflex t
630653 , MonadTransControlStateless f
reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+12−7
@@ -93,6 +93,7 @@ import Reflex.PostBuild.Class
9393import Reflex.TriggerEvent.Base hiding (askEvents)
9494import qualified Reflex.TriggerEvent.Base as TriggerEventT (askEvents)
9595import Reflex.TriggerEvent.Class
96+import Reflex.Query.Base (QueryT)
9697
9798import Control.Concurrent
9899import Control.Lens hiding (element, ix)
@@ -129,6 +130,7 @@ import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setA
129130import qualified GHCJS.DOM.Element as Element
130131import qualified GHCJS.DOM.Event as Event
131132import qualified GHCJS.DOM.GlobalEventHandlers as Events
133+import qualified GHCJS.DOM.DocumentAndElementEventHandlers as Events
132134import GHCJS.DOM.EventM (EventM, event, on)
133135import qualified GHCJS.DOM.EventM as DOM
134136import qualified GHCJS.DOM.FileList as FileList
@@ -232,6 +234,8 @@ instance HasDocument m => HasDocument (Lazy.StateT s m)
232234instance HasDocument m => HasDocument (EventWriterT t w m)
233235instance HasDocument m => HasDocument (DynamicWriterT t w m)
234236instance HasDocument m => HasDocument (PostBuildT t m)
237+instance HasDocument m => HasDocument (RequesterT t request response m)
238+instance HasDocument m => HasDocument (QueryT t q m)
235239
236240instance Monad m => HasDocument (ImmediateDomBuilderT t m) where
237241 {-# INLINABLE askDocument #-}
@@ -449,7 +453,7 @@ instance er ~ EventResult => Default (GhcjsEventSpec er) where
449453 def = GhcjsEventSpec
450454 { _ghcjsEventSpec_filters = mempty
451455 , _ghcjsEventSpec_handler = GhcjsEventHandler $ \(en, GhcjsDomEvent evt) -> do
452− t :: DOM.EventTarget <- withIsEvent en $ Event.getTarget evt --TODO: Rework this; defaultDomEventHandler shouldn't need to take this as an argument
456+ t :: DOM.EventTarget <- withIsEvent en $ Event.getTargetUnchecked evt --TODO: Rework this; defaultDomEventHandler shouldn't need to take this as an argument
453457 let e = uncheckedCastTo DOM.Element t
454458 runReaderT (defaultDomEventHandler e en) evt
455459 }
@@ -1181,6 +1185,7 @@ instance DOM.FromJSVal ElementEventTarget where
11811185 fromJSVal = fmap (fmap ElementEventTarget) . DOM.fromJSVal
11821186instance DOM.IsEventTarget ElementEventTarget
11831187instance DOM.IsGlobalEventHandlers ElementEventTarget
1188+instance DOM.IsDocumentAndElementEventHandlers ElementEventTarget
11841189
11851190{-# INLINABLE elementOnEventName #-}
11861191elementOnEventName :: IsElement e => EventName en -> e -> EventM e (EventType en) () -> JSM (JSM ())
@@ -1218,12 +1223,12 @@ elementOnEventName en e_ = let e = ElementEventTarget (DOM.toElement e_) in case
12181223 Select -> on e Events.select
12191224 Submit -> on e Events.submit
12201225 Wheel -> on e Events.wheel
1221− Beforecut -> on e Element.beforeCut
1222− Cut -> on e Element.cut
1223− Beforecopy -> on e Element.beforeCopy
1224− Copy -> on e Element.copy
1225− Beforepaste -> on e Element.beforePaste
1226− Paste -> on e Element.paste
1226+ Beforecut -> on e Events.beforeCut
1227+ Cut -> on e Events.cut
1228+ Beforecopy -> on e Events.beforeCopy
1229+ Copy -> on e Events.copy
1230+ Beforepaste -> on e Events.beforePaste
1231+ Paste -> on e Events.paste
12271232 Reset -> on e Events.reset
12281233 Search -> on e Events.search
12291234 Selectstart -> on e Element.selectStart
reflex-dom-core/src/Reflex/Dom/Main.hs+1−1
@@ -181,7 +181,7 @@ runApp' :: (t ~ Spider) => (forall x. AppInput t -> Widget x (AppOutput t)) -> J
181181runApp' app = withJSContextSingleton $ \jsSing -> do
182182 doc <- currentDocumentUnchecked
183183 body <- getBodyUnchecked doc
184− win <- getDefaultView doc
184+ win <- getDefaultViewUnchecked doc
185185 rec o <- attachWidget body jsSing $ do
186186 w <- lift $ wrapWindow win $ _appOutput_windowConfig o
187187 app $ AppInput
reflex-dom-core/src/Reflex/Dom/Widget/Input.hs+2−2
@@ -287,7 +287,7 @@ checkboxView dAttrs dValue = do
287287 postBuild <- getPostBuild
288288 let filters :: DMap EventName (GhcjsEventFilter CheckboxViewEventResult)
289289 filters = DMap.singleton Click $ GhcjsEventFilter $ \(GhcjsDomEvent evt) -> do
290− t <- Event.getTarget evt
290+ t <- Event.getTargetUnchecked evt
291291 b <- Input.getChecked $ uncheckedCastTo Input.HTMLInputElement t
292292 return $ (,) preventDefault $ return $ Just $ CheckboxViewEventResult b
293293 elementConfig :: ElementConfig CheckboxViewEventResult t (DomBuilderSpace m)
@@ -299,7 +299,7 @@ checkboxView dAttrs dValue = do
299299 , _ghcjsEventSpec_handler = GhcjsEventHandler $ \(en, GhcjsDomEvent evt) -> case en of
300300 Click -> error "impossible"
301301 _ -> do
302− e :: DOM.EventTarget <- withIsEvent en $ Event.getTarget evt
302+ e :: DOM.EventTarget <- withIsEvent en $ Event.getTargetUnchecked evt
303303 let myElement = uncheckedCastTo DOM.HTMLElement e
304304 mr <- runReaderT (defaultDomEventHandler myElement en) evt
305305 return $ ffor mr $ \(EventResult r) -> CheckboxViewEventResult $ regularToCheckboxViewEventType en r
reflex-dom-core/src/Reflex/Dom/Widget/Resize.hs+9−7
@@ -27,7 +27,8 @@ import qualified Data.Text as T
2727import GHCJS.DOM.Element
2828import GHCJS.DOM.EventM (on)
2929import qualified GHCJS.DOM.GlobalEventHandlers as Events (scroll)
30−import GHCJS.DOM.Types (MonadJSM, liftJSM)
30+import GHCJS.DOM.Types (MonadJSM, liftJSM, uncheckedCastTo, HTMLElement(..))
31+import GHCJS.DOM.HTMLElement (getOffsetWidth, getOffsetHeight)
3132import qualified GHCJS.DOM.Types as DOM
3233
3334-- | A widget that wraps the given widget in a div and fires an event when resized.
@@ -54,8 +55,9 @@ resizeDetectorWithAttrs attrs w = do
5455 (expand, (expandChild, _)) <- elAttr' "div" containerAttrs $ elAttr' "div" ("style" =: childStyle) $ return ()
5556 (shrink, _) <- elAttr' "div" containerAttrs $ elAttr "div" ("style" =: (childStyle <> "width: 200%; height: 200%;")) $ return ()
5657 return (expand, expandChild, shrink, w')
57− let reset = do
58− let e = _element_raw expand
58+ let p = uncheckedCastTo HTMLElement $ _element_raw parent
59+ reset = do
60+ let e = uncheckedCastTo HTMLElement $ _element_raw expand
5961 s = _element_raw shrink
6062 eow <- getOffsetWidth e
6163 eoh <- getOffsetHeight e
@@ -70,12 +72,12 @@ resizeDetectorWithAttrs attrs w = do
7072 setScrollLeft s ssw
7173 ssh <- getScrollHeight s
7274 setScrollTop s ssh
73− lastWidth <- getOffsetWidth (_element_raw parent)
74− lastHeight <- getOffsetHeight (_element_raw parent)
75+ lastWidth <- getOffsetWidth p
76+ lastHeight <- getOffsetHeight p
7577 return (Just lastWidth, Just lastHeight)
7678 resetIfChanged ds = do
77− pow <- getOffsetWidth (_element_raw parent)
78− poh <- getOffsetHeight (_element_raw parent)
79+ pow <- getOffsetWidth p
80+ poh <- getOffsetHeight p
7981 if ds == (Just pow, Just poh)
8082 then return Nothing
8183 else fmap Just reset