git.iko.soy/reflex-dom
on develop help sign in
Merge branch 'develop' into ls-case-insensitive-headers
3ef9fbfElliot Cameron
cabal.projectnew file+1
compare with develop
unifiedsplit
@@ -0,0 +1 @@
1+packages: reflex-dom-core, reflex-dom
dep/reflex-platform/github.json+3−3
@@ -1,7 +1,7 @@
1{
1{
2 "owner": "reflex-frp",
2 "owner": "reflex-frp",
3 "repo": "reflex-platform",
3 "repo": "reflex-platform",
4− "branch": "develop",
4+ "branch": "master",
5− "rev": "e7b76dd552a10916c7d8702c11292dac4f4299ea",
5+ "rev": "510b990d0b11f0626afbec5fe8575b5b2395391b",
6− "sha256": "0s1183arrwldcs50qhzgnv94v24n9bgq6dfq64wp0a3q2nzyvgwh"
6+ "sha256": "09cmahsbxr0963wq171c7j139iyzz49hramr4v9nsf684wcwkngv"
7}
7}
reflex-dom-core/ChangeLog.md+41
@@ -2,7 +2,27 @@
2
2
3## Unreleased
3## Unreleased
4
4
5+* Support GHC 8.8.
6+
7+* Fix attribute support for explicitly namespaced elements
8+
9+* Remove deprecation warnings for the following widgets in
10+ `Reflex.Dom.Widget.Basic`:
11+
12+ * `Link`
13+ * `button`
14+ * `dtdd`
15+ * `linkClass`
16+ * `link`
17+ * `tabDisplay`
18+ * `tableDynAttr`
19+
20+* Fix bug in hydration when dealing with unexpected HTML ([#361](https://github.com/reflex-frp/reflex-dom/pull/361)).
21+
22+## 0.5.3
23+
5* Deprecate a number of old inflexible widget helpers in `Reflex.Dom.Widget.Basic`:
24* Deprecate a number of old inflexible widget helpers in `Reflex.Dom.Widget.Basic`:
25+
6 * `Link`
26 * `Link`
7 * `button`
27 * `button`
8 * `dtdd`
28 * `dtdd`
@@ -11,24 +31,45 @@
11 * `tabDisplay`
31 * `tabDisplay`
12 * `tableDynAttr`
32 * `tableDynAttr`
13
33
34+ And in `Reflex.Dom.Widget.Input`:
35+
36+ * `TextInput`
37+ * `TextAreaConfig`
38+ * `CheckboxConfig`
39+ * `FileInput`
40+
41+ * Add `< 0.7` upper bound for reflex
42+
43+* *(Breaking change)* The mouse wheel event now is a `WheelEventResult` rather than `()`.
44+ This provides information about the wheel's motion beyond the fact that it merely moved.
45+
14## 0.5.2
46## 0.5.2
15
47
16* Update to use new dependent-sum/map packages and drop dependency on `*Tag` classes (e.g., `ShowTag`).
48* Update to use new dependent-sum/map packages and drop dependency on `*Tag` classes (e.g., `ShowTag`).
49+
17* Update version bounds of base, containers, and stm
50* Update version bounds of base, containers, and stm
51+
18* Update to use the newly split `these`/`semialign` packages. To use the pre-split `these` package, set the `split-these` flag to false.
52* Update to use the newly split `these`/`semialign` packages. To use the pre-split `these` package, set the `split-these` flag to false.
53+
19* Reintroduce "data-ssr": elements without this attribute are skipped during
54* Reintroduce "data-ssr": elements without this attribute are skipped during
20 hydration.
55 hydration.
56+
21* Fix an issue in the hydration tests that prevented the test from finding the chromium executable
57* Fix an issue in the hydration tests that prevented the test from finding the chromium executable
58+
22* Relax constraints on `dyn` and `widgetHold` to match the ones in `networkView` and `networkHold` respectively
59* Relax constraints on `dyn` and `widgetHold` to match the ones in `networkView` and `networkHold` respectively
60+
23* Fix prerender for RequesterT so that it doesn't accidentally discard a request that is made at the same moment as getPostBuild's Event fires
61* Fix prerender for RequesterT so that it doesn't accidentally discard a request that is made at the same moment as getPostBuild's Event fires
24
62
25## 0.5.1
63## 0.5.1
26
64
27* Added support for marking elements with a "data-skip-hydration" attribute, which will cause hydration to ignore and skip over them.
65* Added support for marking elements with a "data-skip-hydration" attribute, which will cause hydration to ignore and skip over them.
66+
28* Removed "data-ssr" attributes from statically rendered output.
67* Removed "data-ssr" attributes from statically rendered output.
29
68
30## 0.5
69## 0.5
31
70
32* Add HydrationDomBuilderT to support hydration of statically rendered DOM nodes. See the note at the top of Reflex.Dom.Builder.Immediate.
71* Add HydrationDomBuilderT to support hydration of statically rendered DOM nodes. See the note at the top of Reflex.Dom.Builder.Immediate.
72+
33* As a result of the hydration changes, the Prerender class has changed, the type of `prerender` has changed and it is now a class method.
73* As a result of the hydration changes, the Prerender class has changed, the type of `prerender` has changed and it is now a class method.
74+
34* Add the Reflex.Dom.Xhr.FormData module to make posting formdata over xhr more convenient.
75* Add the Reflex.Dom.Xhr.FormData module to make posting formdata over xhr more convenient.
reflex-dom-core/reflex-dom-core.cabal+9−8
@@ -1,5 +1,5 @@
1Name: reflex-dom-core
1Name: reflex-dom-core
2−Version: 0.5.2.0
2+Version: 0.5.3
3Synopsis: Functional Reactive Web Apps with Reflex
3Synopsis: Functional Reactive Web Apps with Reflex
4Description: Reflex-DOM is a Functional Reactive web framework based on the Reflex FRP engine
4Description: Reflex-DOM is a Functional Reactive web framework based on the Reflex FRP engine
5License: BSD3
5License: BSD3
@@ -48,7 +48,7 @@ library
48 hs-source-dirs: src
48 hs-source-dirs: src
49 build-depends:
49 build-depends:
50 aeson >= 0.8 && < 1.5,
50 aeson >= 0.8 && < 1.5,
51− base >= 4.7 && < 4.13,
51+ base >= 4.7 && < 4.14,
52 bifunctors >= 4.2 && < 6,
52 bifunctors >= 4.2 && < 6,
53 bimap >= 0.3 && < 0.4,
53 bimap >= 0.3 && < 0.4,
54 blaze-builder,
54 blaze-builder,
@@ -64,17 +64,17 @@ library
64 directory >= 1.2 && < 1.4,
64 directory >= 1.2 && < 1.4,
65 exception-transformers == 0.4.*,
65 exception-transformers == 0.4.*,
66 ghcjs-dom >= 0.9.1.0 && < 0.10,
66 ghcjs-dom >= 0.9.1.0 && < 0.10,
67− jsaddle >=0.9.0.0 && <0.10,
67+ jsaddle >= 0.9.0.0 && < 0.10,
68 -- keycode-0.2 has a bug on firefox
68 -- keycode-0.2 has a bug on firefox
69 keycode >= 0.2.1 && < 0.3,
69 keycode >= 0.2.1 && < 0.3,
70 lens >= 4.7 && < 5,
70 lens >= 4.7 && < 5,
71 monad-control >= 1.0.1 && < 1.1,
71 monad-control >= 1.0.1 && < 1.1,
72 mtl >= 2.1 && < 2.3,
72 mtl >= 2.1 && < 2.3,
73− primitive >= 0.5 && < 0.7,
73+ primitive >= 0.5 && < 0.8,
74 random,
74 random,
75 ref-tf == 0.4.*,
75 ref-tf == 0.4.*,
76− reflex >= 0.6.2,
76+ reflex >= 0.6.2 && < 0.7,
77− semigroups >= 0.16 && < 0.19,
77+ semigroups >= 0.16 && < 0.20,
78 stm >= 2.4 && < 2.6,
78 stm >= 2.4 && < 2.6,
79 text == 1.2.*,
79 text == 1.2.*,
80 transformers >= 0.3 && < 0.6,
80 transformers >= 0.3 && < 0.6,
@@ -85,7 +85,7 @@ library
85 hs-source-dirs: src-ghcjs
85 hs-source-dirs: src-ghcjs
86 build-depends:
86 build-depends:
87 ghcjs-base,
87 ghcjs-base,
88− hashable == 1.2.*
88+ hashable >= 1.2 && < 1.4
89 else
89 else
90 hs-source-dirs: src-ghc
90 hs-source-dirs: src-ghc
91 if !os(windows)
91 if !os(windows)
@@ -93,7 +93,7 @@ library
93
93
94 if flag(split-these)
94 if flag(split-these)
95 build-depends:
95 build-depends:
96− semialign >= 1 && < 1.1,
96+ semialign >= 1 && < 1.2,
97 these >= 1 && < 1.1
97 these >= 1 && < 1.1
98 else
98 else
99 build-depends:
99 build-depends:
@@ -167,6 +167,7 @@ test-suite hlint
167test-suite hydration
167test-suite hydration
168 build-depends: base
168 build-depends: base
169 , aeson
169 , aeson
170+ , async
170 , bytestring
171 , bytestring
171 , chrome-test-utils
172 , chrome-test-utils
172 , constraints
173 , constraints
reflex-dom-core/src/Reflex/Dom/Builder/Class/Events.hs+11−1
@@ -159,7 +159,17 @@ type family EventResultType (en :: EventTag) :: * where
159 EventResultType 'TouchmoveTag = TouchEventResult
159 EventResultType 'TouchmoveTag = TouchEventResult
160 EventResultType 'TouchendTag = TouchEventResult
160 EventResultType 'TouchendTag = TouchEventResult
161 EventResultType 'TouchcancelTag = TouchEventResult
161 EventResultType 'TouchcancelTag = TouchEventResult
162− EventResultType 'WheelTag = ()
162+ EventResultType 'WheelTag = WheelEventResult
163+
164+data DeltaMode = DeltaPixel | DeltaLine | DeltaPage
165+ deriving (Show, Read, Eq, Ord, Bounded, Enum)
166+
167+data WheelEventResult = WheelEventResult
168+ { _wheelEventResult_deltaX :: Double
169+ , _wheelEventResult_deltaY :: Double
170+ , _wheelEventResult_deltaZ :: Double
171+ , _wheelEventResult_deltaMode :: DeltaMode
172+ } deriving (Show, Read, Eq, Ord)
163
173
164data TouchEventResult = TouchEventResult
174data TouchEventResult = TouchEventResult
165 { _touchEventResult_altKey :: Bool
175 { _touchEventResult_altKey :: Bool
reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+58−36
@@ -141,7 +141,7 @@ import Data.Text (Text)
141import Foreign.JavaScript.Internal.Utils
141import Foreign.JavaScript.Internal.Utils
142import Foreign.JavaScript.TH
142import Foreign.JavaScript.TH
143import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode, createComment)
143import GHCJS.DOM.Document (Document, createDocumentFragment, createElement, createElementNS, createTextNode, createComment)
144−import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setAttribute, setAttributeNS, hasAttribute, hasAttributeNS)
144+import GHCJS.DOM.Element (getScrollTop, removeAttribute, removeAttributeNS, setAttribute, setAttributeNS, hasAttribute)
145import GHCJS.DOM.EventM (EventM, event, on)
145import GHCJS.DOM.EventM (EventM, event, on)
146import GHCJS.DOM.KeyboardEvent as KeyboardEvent
146import GHCJS.DOM.KeyboardEvent as KeyboardEvent
147import GHCJS.DOM.MouseEvent
147import GHCJS.DOM.MouseEvent
@@ -192,6 +192,7 @@ import qualified GHCJS.DOM.TouchEvent as TouchEvent
192import qualified GHCJS.DOM.TouchList as TouchList
192import qualified GHCJS.DOM.TouchList as TouchList
193import qualified GHCJS.DOM.Types as DOM
193import qualified GHCJS.DOM.Types as DOM
194import qualified GHCJS.DOM.Window as Window
194import qualified GHCJS.DOM.Window as Window
195+import qualified GHCJS.DOM.WheelEvent as WheelEvent
195import qualified Reflex.Patch.DMap as PatchDMap
196import qualified Reflex.Patch.DMap as PatchDMap
196import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove
197import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove
197import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
198import qualified Reflex.Patch.MapWithMove as PatchMapWithMove
@@ -318,8 +319,7 @@ addHydrationStepWithSetup :: (Adjustable t m, MonadIO m) => m a -> (a -> Hydrati
318addHydrationStepWithSetup setup f = getHydrationMode >>= \case
319addHydrationStepWithSetup setup f = getHydrationMode >>= \case
319 HydrationMode_Immediate -> pure ()
320 HydrationMode_Immediate -> pure ()
320 HydrationMode_Hydrating -> do
321 HydrationMode_Hydrating -> do
321− switchover <- HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_switchover
322+ s <- lift setup
322− (s, _) <- lift $ runWithReplace setup $ return () <$ switchover
323 addHydrationStep (f s)
323 addHydrationStep (f s)
324
324
325-- | Add a hydration step
325-- | Add a hydration step
@@ -767,15 +767,10 @@ hydrateElement elementTag cfg child = do
767 let skipAttr = "data-hydration-skip" :: DOM.JSString
767 let skipAttr = "data-hydration-skip" :: DOM.JSString
768 ssrAttr = "data-ssr" :: DOM.JSString
768 ssrAttr = "data-ssr" :: DOM.JSString
769 shouldSkip :: DOM.Element -> HydrationRunnerT t m Bool
769 shouldSkip :: DOM.Element -> HydrationRunnerT t m Bool
770− shouldSkip e = case cfg ^. namespace of
770+ shouldSkip e = do
771− Nothing -> do
772− skip <- hasAttribute e skipAttr
771+ skip <- hasAttribute e skipAttr
773− ssr <- hasAttribute e ssrAttr
772+ ssr <- hasAttribute e ssrAttr
774− pure $ skip || not ssr
775− Just ns -> do
776− skip <- hasAttributeNS e (Just ns) skipAttr
777− ssr <- hasAttributeNS e (Just ns) ssrAttr
778− pure $ skip || not ssr
773+ pure $ skip || not ssr
779 childDom <- liftIO $ readIORef childDelayedRef
774 childDom <- liftIO $ readIORef childDelayedRef
780 let rawCfg = extractRawElementConfig cfg
775 let rawCfg = extractRawElementConfig cfg
781 doc <- askDocument
776 doc <- askDocument
@@ -1277,8 +1272,8 @@ hydrateComment doc t mSetContents = do
1277skipToAndReplaceComment
1272skipToAndReplaceComment
1278 :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)
1273 :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)
1279 => Text
1274 => Text
1280− -> IORef Text
1275+ -> IORef (Maybe Text)
1281− -> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text, IORef Text)
1276+ -> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text, IORef (Maybe Text))
1282skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case
1277skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case
1283 HydrationMode_Immediate -> do
1278 HydrationMode_Immediate -> do
1284 -- If we're in immediate mode, we don't try to replace an existing comment,
1279 -- If we're in immediate mode, we don't try to replace an existing comment,
@@ -1286,43 +1281,50 @@ skipToAndReplaceComment prefix key0Ref = getHydrationMode >>= \case
1286 t <- textNodeImmediate $ TextNodeConfig ("" :: Text) Nothing
1281 t <- textNodeImmediate $ TextNodeConfig ("" :: Text) Nothing
1287 append $ toNode t
1282 append $ toNode t
1288 textNodeRef <- liftIO $ newIORef t
1283 textNodeRef <- liftIO $ newIORef t
1289− keyRef <- liftIO $ newIORef ""
1284+ keyRef <- liftIO $ newIORef Nothing
1290 pure (pure (), textNodeRef, keyRef)
1285 pure (pure (), textNodeRef, keyRef)
1291 HydrationMode_Hydrating -> do
1286 HydrationMode_Hydrating -> do
1292 doc <- askDocument
1287 doc <- askDocument
1293 textNodeRef <- liftIO $ newIORef $ error "textNodeRef not yet initialized"
1288 textNodeRef <- liftIO $ newIORef $ error "textNodeRef not yet initialized"
1294 keyRef <- liftIO $ newIORef $ error "keyRef not yet initialized"
1289 keyRef <- liftIO $ newIORef $ error "keyRef not yet initialized"
1290+ let
1291+ go Nothing _ = do
1292+ tn <- createTextNode doc ("" :: Text)
1293+ insertAfterPreviousNode tn
1294+ HydrationRunnerT $ modify' $ \s -> s { _hydrationState_failed = True }
1295+ pure (tn, Nothing)
1295− let go key0 mLastNode = do
1296+ go (Just key0) mLastNode = do
1296− parent <- askParent
1297+ parent <- askParent
1297− node <- maybe (Node.getFirstChildUnchecked parent) Node.getNextSiblingUnchecked mLastNode
1298+ maybe (Node.getFirstChild parent) Node.getNextSibling mLastNode >>= \case
1299+ Nothing -> go Nothing Nothing
1298− DOM.castTo DOM.Comment node >>= \case
1300+ Just node -> DOM.castTo DOM.Comment node >>= \case
1299 Just comment -> do
1301 Just comment -> do
1300− commentText <- Node.getTextContentUnchecked comment
1302+ commentText <- fromMaybe (error "Cannot get text content of comment node") <$> Node.getTextContent comment
1301− case T.stripPrefix (prefix <> key0) commentText of
1303+ case T.stripPrefix (prefix <> key0) commentText of -- 'key0' may be @""@ in which case we're just finding the actual key; TODO: Don't be clever.
1302 Just key -> do
1304 Just key -> do
1303 -- Replace the comment with an (invisible) text node
1305 -- Replace the comment with an (invisible) text node
1304 tn <- createTextNode doc ("" :: Text)
1306 tn <- createTextNode doc ("" :: Text)
1305 Node.replaceChild_ parent tn comment
1307 Node.replaceChild_ parent tn comment
1306− pure (tn, key)
1308+ pure (tn, Just key)
1307 Nothing -> do
1309 Nothing -> do
1308− go key0 (Just node)
1310+ go (Just key0) (Just node)
1309 Nothing -> do
1311 Nothing -> do
1310− go key0 (Just node)
1312+ go (Just key0) (Just node)
1311− switchComment = do
1313+ switchComment = do
1312− key0 <- liftIO $ readIORef key0Ref
1314+ key0 <- liftIO $ readIORef key0Ref
1313− (tn, key) <- go key0 =<< getPreviousNode
1315+ (tn, key) <- go key0 =<< getPreviousNode
1314− setPreviousNode $ Just $ toNode tn
1316+ setPreviousNode $ Just $ toNode tn
1315− liftIO $ do
1317+ liftIO $ do
1316− writeIORef textNodeRef tn
1318+ writeIORef textNodeRef tn
1317− writeIORef keyRef key
1319+ writeIORef keyRef key
1318 pure (switchComment, textNodeRef, keyRef)
1320 pure (switchComment, textNodeRef, keyRef)
1319
1321
1320{-# INLINABLE skipToReplaceStart #-}
1322{-# INLINABLE skipToReplaceStart #-}
1321−skipToReplaceStart :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text, IORef Text)
1323+skipToReplaceStart :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text, IORef (Maybe Text))
1322−skipToReplaceStart = skipToAndReplaceComment "replace-start" =<< liftIO (newIORef "")
1324+skipToReplaceStart = skipToAndReplaceComment "replace-start" =<< liftIO (newIORef $ Just "") -- TODO: Don't rely on clever usage @""@ to make this work.
1323
1325
1324{-# INLINABLE skipToReplaceEnd #-}
1326{-# INLINABLE skipToReplaceEnd #-}
1325−skipToReplaceEnd :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => IORef Text -> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text)
1327+skipToReplaceEnd :: (MonadJSM m, Reflex t, MonadFix m, Adjustable t m, MonadHold t m, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document) => IORef (Maybe Text) -> HydrationDomBuilderT s t m (HydrationRunnerT t m (), IORef DOM.Text)
1326skipToReplaceEnd key = fmap (\(m,e,_) -> (m,e)) $ skipToAndReplaceComment "replace-end" key
1328skipToReplaceEnd key = fmap (\(m,e,_) -> (m,e)) $ skipToAndReplaceComment "replace-end" key
1327
1329
1328instance SupportsHydrationDomBuilder t m => NotReady t (HydrationDomBuilderT s t m) where
1330instance SupportsHydrationDomBuilder t m => NotReady t (HydrationDomBuilderT s t m) where
@@ -2248,7 +2250,7 @@ defaultDomEventHandler e evt = fmap (Just . EventResult) $ case evt of
2248 Touchend -> getTouchEvent
2250 Touchend -> getTouchEvent
2249 Touchcancel -> getTouchEvent
2251 Touchcancel -> getTouchEvent
2250 Mousewheel -> return ()
2252 Mousewheel -> return ()
2251− Wheel -> return ()
2253+ Wheel -> getWheelEvent
2252
2254
2253{-# INLINABLE defaultDomWindowEventHandler #-}
2255{-# INLINABLE defaultDomWindowEventHandler #-}
2254defaultDomWindowEventHandler :: DOM.Window -> EventName en -> EventM DOM.Window (EventType en) (Maybe (EventResult en))
2256defaultDomWindowEventHandler :: DOM.Window -> EventName en -> EventM DOM.Window (EventType en) (Maybe (EventResult en))
@@ -2298,7 +2300,7 @@ defaultDomWindowEventHandler w evt = fmap (Just . EventResult) $ case evt of
2298 Touchend -> getTouchEvent
2300 Touchend -> getTouchEvent
2299 Touchcancel -> getTouchEvent
2301 Touchcancel -> getTouchEvent
2300 Mousewheel -> return ()
2302 Mousewheel -> return ()
2301− Wheel -> return ()
2303+ Wheel -> getWheelEvent
2302
2304
2303{-# INLINABLE withIsEvent #-}
2305{-# INLINABLE withIsEvent #-}
2304withIsEvent :: EventName en -> (IsEvent (EventType en) => r) -> r
2306withIsEvent :: EventName en -> (IsEvent (EventType en) => r) -> r
@@ -2607,6 +2609,26 @@ getTouchEvent = do
2607 , _touchEventResult_touches = touches
2609 , _touchEventResult_touches = touches
2608 }
2610 }
2609
2611
2612+{-# INLINABLE getWheelEvent #-}
2613+getWheelEvent :: EventM e WheelEvent WheelEventResult
2614+getWheelEvent = do
2615+ e <- event
2616+ dx :: Double <- WheelEvent.getDeltaX e
2617+ dy :: Double <- WheelEvent.getDeltaY e
2618+ dz :: Double <- WheelEvent.getDeltaZ e
2619+ deltaMode :: Word <- WheelEvent.getDeltaMode e
2620+ return $ WheelEventResult
2621+ { _wheelEventResult_deltaX = dx
2622+ , _wheelEventResult_deltaY = dy
2623+ , _wheelEventResult_deltaZ = dz
2624+ , _wheelEventResult_deltaMode = case deltaMode of
2625+ 0 -> DeltaPixel
2626+ 1 -> DeltaLine
2627+ 2 -> DeltaPage
2628+ -- See https://developer.mozilla.org/en-US/docs/Web/API/WheelEvent/deltaMode
2629+ _ -> error "getWheelEvent: impossible encoding"
2630+ }
2631+
2610instance MonadSample t m => MonadSample t (HydrationDomBuilderT s t m) where
2632instance MonadSample t m => MonadSample t (HydrationDomBuilderT s t m) where
2611 {-# INLINABLE sample #-}
2633 {-# INLINABLE sample #-}
2612 sample = lift . sample
2634 sample = lift . sample
reflex-dom-core/src/Reflex/Dom/Builder/Static.hs+12−9
@@ -55,7 +55,6 @@ import Reflex.PerformEvent.Class
55import Reflex.PostBuild.Base
55import Reflex.PostBuild.Base
56import Reflex.PostBuild.Class
56import Reflex.PostBuild.Class
57import Reflex.TriggerEvent.Class
57import Reflex.TriggerEvent.Class
58−import System.Random (randomRIO)
59
58
60data StaticDomBuilderEnv t = StaticDomBuilderEnv
59data StaticDomBuilderEnv t = StaticDomBuilderEnv
61 { _staticDomBuilderEnv_shouldEscape :: Bool
60 { _staticDomBuilderEnv_shouldEscape :: Bool
@@ -64,6 +63,7 @@ data StaticDomBuilderEnv t = StaticDomBuilderEnv
64 -- We use this to add a "selected" attribute to the appropriate "option" child element.
63 -- We use this to add a "selected" attribute to the appropriate "option" child element.
65 -- This is not yet a perfect simulation of what the browser does, but it is much closer than doing nothing.
64 -- This is not yet a perfect simulation of what the browser does, but it is much closer than doing nothing.
66 -- TODO: Handle edge cases, e.g. setting to a value for which there is no option, then adding that option dynamically afterwards.
65 -- TODO: Handle edge cases, e.g. setting to a value for which there is no option, then adding that option dynamically afterwards.
66+ , _staticDomBuilderEnv_nextRunWithReplaceKey :: IORef Int
67 }
67 }
68
68
69newtype StaticDomBuilderT t m a = StaticDomBuilderT
69newtype StaticDomBuilderT t m a = StaticDomBuilderT
@@ -164,7 +164,7 @@ instance (SupportsStaticDomBuilder t m, Monad m) => HasDocument (StaticDomBuilde
164instance (Reflex t, Adjustable t m, MonadHold t m, SupportsStaticDomBuilder t m) => Adjustable t (StaticDomBuilderT t m) where
164instance (Reflex t, Adjustable t m, MonadHold t m, SupportsStaticDomBuilder t m) => Adjustable t (StaticDomBuilderT t m) where
165 runWithReplace a0 a' = do
165 runWithReplace a0 a' = do
166 e <- StaticDomBuilderT ask
166 e <- StaticDomBuilderT ask
167− key <- replaceStart
167+ key <- replaceStart e
168 (result0, result') <- lift $ runWithReplace (runStaticDomBuilderT a0 e) (flip runStaticDomBuilderT e <$> a')
168 (result0, result') <- lift $ runWithReplace (runStaticDomBuilderT a0 e) (flip runStaticDomBuilderT e <$> a')
169 o <- hold (snd result0) $ fmapCheap snd result'
169 o <- hold (snd result0) $ fmapCheap snd result'
170 StaticDomBuilderT $ modify $ (:) $ join o
170 StaticDomBuilderT $ modify $ (:) $ join o
@@ -174,10 +174,9 @@ instance (Reflex t, Adjustable t m, MonadHold t m, SupportsStaticDomBuilder t m)
174 traverseDMapWithKeyWithAdjust = hoistDMapWithKeyWithAdjust traverseDMapWithKeyWithAdjust mapPatchDMap
174 traverseDMapWithKeyWithAdjust = hoistDMapWithKeyWithAdjust traverseDMapWithKeyWithAdjust mapPatchDMap
175 traverseDMapWithKeyWithAdjustWithMove = hoistDMapWithKeyWithAdjust traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove
175 traverseDMapWithKeyWithAdjustWithMove = hoistDMapWithKeyWithAdjust traverseDMapWithKeyWithAdjustWithMove mapPatchDMapWithMove
176
176
177−-- TODO remove this?
178−replaceStart :: (DomBuilder t m, MonadIO m) => m Text
177+replaceStart :: (DomBuilder t m, MonadIO m) => StaticDomBuilderEnv t -> m Text
179−replaceStart = do
178+replaceStart env = do
180− str <- liftIO $ replicateM 8 $ randomRIO ('a', 'z')
179+ str <- show <$> liftIO (atomicModifyRef (_staticDomBuilderEnv_nextRunWithReplaceKey env) $ \k -> (succ k, k))
181 let key = "-" <> T.pack str
180 let key = "-" <> T.pack str
182 _ <- commentNode $ def { _commentNodeConfig_initialContents = "replace-start" <> key }
181 _ <- commentNode $ def { _commentNodeConfig_initialContents = "replace-start" <> key }
183 pure key
182 pure key
@@ -287,7 +286,8 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh
287 es <- newFanEventWithTrigger $ \_ _ -> return (return ())
286 es <- newFanEventWithTrigger $ \_ _ -> return (return ())
288 StaticDomBuilderT $ do
287 StaticDomBuilderT $ do
289 let shouldEscape = elementTag `Set.notMember` noEscapeElements
288 let shouldEscape = elementTag `Set.notMember` noEscapeElements
289+ nextRunWithReplaceKey <- asks _staticDomBuilderEnv_nextRunWithReplaceKey
290− (result, innerHtml) <- lift $ lift $ runStaticDomBuilderT child $ StaticDomBuilderEnv shouldEscape Nothing
290+ (result, innerHtml) <- lift $ lift $ runStaticDomBuilderT child $ StaticDomBuilderEnv shouldEscape Nothing nextRunWithReplaceKey
291 attrs0 <- foldDyn applyMap (cfg ^. initialAttributes) (cfg ^. modifyAttributes)
291 attrs0 <- foldDyn applyMap (cfg ^. initialAttributes) (cfg ^. modifyAttributes)
292 selectValue <- asks _staticDomBuilderEnv_selectValue
292 selectValue <- asks _staticDomBuilderEnv_selectValue
293 let addSelectedAttr attrs sel = case Map.lookup "value" attrs of
293 let addSelectedAttr attrs sel = case Map.lookup "value" attrs of
@@ -341,7 +341,9 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh
341 selectElement cfg child = do
341 selectElement cfg child = do
342 v <- holdDyn (cfg ^. selectElementConfig_initialValue) (cfg ^. selectElementConfig_setValue)
342 v <- holdDyn (cfg ^. selectElementConfig_initialValue) (cfg ^. selectElementConfig_setValue)
343 (e, result) <- element "select" (_selectElementConfig_elementConfig cfg) $ do
343 (e, result) <- element "select" (_selectElementConfig_elementConfig cfg) $ do
344+ (a, innerHtml) <- StaticDomBuilderT $ do
345+ nextRunWithReplaceKey <- asks _staticDomBuilderEnv_nextRunWithReplaceKey
344− (a, innerHtml) <- StaticDomBuilderT $ lift $ lift $ runStaticDomBuilderT child $ StaticDomBuilderEnv False $ Just (current v)
346+ lift $ lift $ runStaticDomBuilderT child $ StaticDomBuilderEnv False (Just $ current v) nextRunWithReplaceKey
345 StaticDomBuilderT $ lift $ modify $ (:) innerHtml
347 StaticDomBuilderT $ lift $ modify $ (:) innerHtml
346 return a
348 return a
347 let wrapped = SelectElement
349 let wrapped = SelectElement
@@ -363,7 +365,8 @@ renderStatic :: StaticWidget x a -> IO (a, ByteString)
363renderStatic w = do
365renderStatic w = do
364 runDomHost $ do
366 runDomHost $ do
365 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef
367 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef
368+ nextRunWithReplaceKey <- newRef 0
366− let env0 = StaticDomBuilderEnv True Nothing
369+ let env0 = StaticDomBuilderEnv True Nothing nextRunWithReplaceKey
367 ((res, bs), FireCommand fire) <- hostPerformEventT $ runStaticDomBuilderT (runPostBuildT w postBuild) env0
370 ((res, bs), FireCommand fire) <- hostPerformEventT $ runStaticDomBuilderT (runPostBuildT w postBuild) env0
368 mPostBuildTrigger <- readRef postBuildTriggerRef
371 mPostBuildTrigger <- readRef postBuildTriggerRef
369 forM_ mPostBuildTrigger $ \postBuildTrigger -> fire [postBuildTrigger :=> Identity ()] $ return ()
372 forM_ mPostBuildTrigger $ \postBuildTrigger -> fire [postBuildTrigger :=> Identity ()] $ return ()
reflex-dom-core/src/Reflex/Dom/Widget/Basic.hs−29
@@ -138,7 +138,6 @@ dynComment t = do
138display :: (PostBuild t m, DomBuilder t m, Show a) => Dynamic t a -> m ()
138display :: (PostBuild t m, DomBuilder t m, Show a) => Dynamic t a -> m ()
139display = dynText . fmap (T.pack . show)
139display = dynText . fmap (T.pack . show)
140
140
141−{-# DEPRECATED button "Use 'elAttr'' in combination with 'domEvent' instead" #-}
142button :: DomBuilder t m => Text -> m (Event t ())
141button :: DomBuilder t m => Text -> m (Event t ())
143button t = do
142button t = do
144 (e, _) <- element "button" def $ text t
143 (e, _) <- element "button" def $ text t
@@ -272,47 +271,21 @@ dynamicAttributesToModifyAttributesWithInitial attrs0 d = do
272 return $ if Map.null p then Nothing else Just p
271 return $ if Map.null p then Nothing else Just p
273 return modificationsNeeded
272 return modificationsNeeded
274
273
275−--------------------------------------------------------------------------------
276−-- Copied and pasted from Reflex.Widget.Class
277−--------------------------------------------------------------------------------
278−
279−{-
280−schedulePostBuild x = performEvent_ . (x <$) =<< getPostBuild
281−
282−elDynHtml' :: DomBuilder t m => Text -> Dynamic t Text -> m (El t)
283−elDynHtml' elementTag html = do
284− e <- buildEmptyElement elementTag (Map.empty :: Map Text Text)
285− schedulePostBuild $ setInnerHTML e . Just =<< sample (current html)
286− performEvent_ $ fmap (setInnerHTML e . Just) $ updated html
287− wrapElement defaultDomEventHandler e
288−
289−elDynHtmlAttr' :: DomBuilder t m => Text -> Map Text Text -> Dynamic t Text -> m (El t)
290−elDynHtmlAttr' elementTag attrs html = do
291− e <- buildEmptyElement elementTag attrs
292− schedulePostBuild $ setInnerHTML e . Just =<< sample (current html)
293− performEvent_ $ fmap (setInnerHTML e . Just) $ updated html
294− wrapElement defaultDomEventHandler e
295−-}
296−
297−{-# DEPRECATED Link "Will be removed when 'linkClass' and 'link' are removed" #-}
298newtype Link t
274newtype Link t
299 = Link { _link_clicked :: Event t ()
275 = Link { _link_clicked :: Event t ()
300 }
276 }
301
277
302−{-# DEPRECATED linkClass "Use 'elAttr'' in combination with 'domEvent' for just clicks. Use 'routeLink' for Obelisk navigation" #-}
303linkClass :: DomBuilder t m => Text -> Text -> m (Link t)
278linkClass :: DomBuilder t m => Text -> Text -> m (Link t)
304linkClass s c = do
279linkClass s c = do
305 (l,_) <- elAttr' "a" ("class" =: c) $ text s
280 (l,_) <- elAttr' "a" ("class" =: c) $ text s
306 return $ Link $ domEvent Click l
281 return $ Link $ domEvent Click l
307
282
308−{-# DEPRECATED link "Use 'elAttr'' in combination with 'domEvent' for just clicks. Use 'routeLink' for Obelisk navigation" #-}
309link :: DomBuilder t m => Text -> m (Link t)
283link :: DomBuilder t m => Text -> m (Link t)
310link s = linkClass s ""
284link s = linkClass s ""
311
285
312divClass :: forall t m a. DomBuilder t m => Text -> m a -> m a
286divClass :: forall t m a. DomBuilder t m => Text -> m a -> m a
313divClass = elClass "div"
287divClass = elClass "div"
314
288
315−{-# DEPRECATED dtdd "Use an application specific widget generating function" #-}
316dtdd :: forall t m a. DomBuilder t m => Text -> m a -> m a
289dtdd :: forall t m a. DomBuilder t m => Text -> m a -> m a
317dtdd h w = do
290dtdd h w = do
318 el "dt" $ text h
291 el "dt" $ text h
@@ -323,7 +296,6 @@ blank = return ()
323
296
324-- TODO: Move to an example project.
297-- TODO: Move to an example project.
325-- | A widget to display a table with static columns and dynamic rows.
298-- | A widget to display a table with static columns and dynamic rows.
326−{-# DEPRECATED tableDynAttr "Use an application specific widget generating function" #-}
327tableDynAttr :: forall t m r k v. (Ord k, DomBuilder t m, MonadHold t m, PostBuild t m, MonadFix m)
299tableDynAttr :: forall t m r k v. (Ord k, DomBuilder t m, MonadHold t m, PostBuild t m, MonadFix m)
328 => Text -- ^ Class applied to <table> element
300 => Text -- ^ Class applied to <table> element
329 -> [(Text, k -> Dynamic t r -> m v)] -- ^ Columns of (header, row key -> row value -> child widget)
301 -> [(Text, k -> Dynamic t r -> m v)] -- ^ Columns of (header, row key -> row value -> child widget)
@@ -343,7 +315,6 @@ tableDynAttr klass cols dRows rowAttrs = elAttr "div" (Map.singleton "style" "zo
343-- | A widget to construct a tabbed view that shows only one of its child widgets at a time.
315-- | A widget to construct a tabbed view that shows only one of its child widgets at a time.
344-- Creates a header bar containing a <ul> with one <li> per child; clicking a <li> displays
316-- Creates a header bar containing a <ul> with one <li> per child; clicking a <li> displays
345-- the corresponding child and hides all others.
317-- the corresponding child and hides all others.
346−{-# DEPRECATED tabDisplay "Use an application specific widget generating function" #-}
347tabDisplay :: forall t m k. (MonadFix m, DomBuilder t m, MonadHold t m, PostBuild t m, Ord k)
318tabDisplay :: forall t m k. (MonadFix m, DomBuilder t m, MonadHold t m, PostBuild t m, Ord k)
348 => Text -- ^ Class applied to <ul> element
319 => Text -- ^ Class applied to <ul> element
349 -> Text -- ^ Class applied to currently active <li> element
320 -> Text -- ^ Class applied to currently active <li> element
reflex-dom-core/src/Reflex/Dom/Widget/Input.hs+4−38
@@ -54,6 +54,7 @@ import qualified Text.Read as T
54import qualified GHCJS.DOM.Event as Event
54import qualified GHCJS.DOM.Event as Event
55import qualified GHCJS.DOM.HTMLInputElement as Input
55import qualified GHCJS.DOM.HTMLInputElement as Input
56
56
57+{-# DEPRECATED TextInput, _textInput_element, TextInputConfig, textInput "Use 'inputElement' directly" #-}
57data TextInput t
58data TextInput t
58 = TextInput { _textInput_value :: Dynamic t Text
59 = TextInput { _textInput_value :: Dynamic t Text
59 , _textInput_input :: Event t Text
60 , _textInput_input :: Event t Text
@@ -161,6 +162,7 @@ rangeInput (RangeInputConfig initial eSetValue dAttrs) = do
161 , _rangeInput_element = _inputElement_raw i
162 , _rangeInput_element = _inputElement_raw i
162 }
163 }
163
164
165+{-# DEPRECATED TextAreaConfig, TextArea, textArea "Use 'textAreaElement' directly" #-}
164data TextAreaConfig t
166data TextAreaConfig t
165 = TextAreaConfig { _textAreaConfig_initialValue :: Text
167 = TextAreaConfig { _textAreaConfig_initialValue :: Text
166 , _textAreaConfig_setValue :: Event t Text
168 , _textAreaConfig_setValue :: Event t Text
@@ -198,6 +200,7 @@ textArea (TextAreaConfig initial eSet attrs) = do
198 , _textArea_element = _textAreaElement_raw i
200 , _textArea_element = _textAreaElement_raw i
199 }
201 }
200
202
203+{-# DEPRECATED CheckboxConfig, Checkbox, checkbox, checkboxView, CheckboxViewEventResultType, regularToCheckboxViewEventType, CheckboxViewEventResult "Use 'inputElement' directly" #-}
201data CheckboxConfig t
204data CheckboxConfig t
202 = CheckboxConfig { _checkboxConfig_setValue :: Event t Bool
205 = CheckboxConfig { _checkboxConfig_setValue :: Event t Bool
203 , _checkboxConfig_attributes :: Dynamic t (Map Text Text)
206 , _checkboxConfig_attributes :: Dynamic t (Map Text Text)
@@ -321,6 +324,7 @@ checkboxView dAttrs dValue = do
321 i <- inputElement inputElementConfig
324 i <- inputElement inputElementConfig
322 return $ unCheckboxViewEventResult <$> select (_element_events $ _inputElement_element i) (WrapArg Click)
325 return $ unCheckboxViewEventResult <$> select (_element_events $ _inputElement_element i) (WrapArg Click)
323
326
327+{-# DEPRECATED FileInput, FileInputConfig, fileInput "Use 'inputElement' directly" #-}
324data FileInput d t
328data FileInput d t
325 = FileInput { _fileInput_value :: Dynamic t [File]
329 = FileInput { _fileInput_value :: Dynamic t [File]
326 , _fileInput_element :: RawInputElement d
330 , _fileInput_element :: RawInputElement d
@@ -681,41 +685,3 @@ instance HasValue (Dropdown t k) where
681instance HasValue (Checkbox t) where
685instance HasValue (Checkbox t) where
682 type Value (Checkbox t) = Dynamic t Bool
686 type Value (Checkbox t) = Dynamic t Bool
683 value = _checkbox_value
687 value = _checkbox_value
684−
685−{-
686−type family Controller sm t a where
687− Controller Edit t a = (a, Event t a) -- Initial value and setter
688− Controller View t a = Dynamic t a -- Value (always)
689−
690−type family Output sm t a where
691− Output Edit t a = Dynamic t a -- Value (always)
692− Output View t a = Event t a -- Requested changes
693−
694−data CheckboxConfig sm t
695− = CheckboxConfig { _checkbox_input :: Controller sm t Bool
696− , _checkbox_attributes :: Attributes
697− }
698−
699−instance Reflex t => Default (CheckboxConfig Edit t) where
700− def = CheckboxConfig (False, never) mempty
701−
702−data Checkbox sm t
703− = Checkbox { _checkbox_output :: Output sm t Bool
704− }
705−
706−data StateMode = Edit | View
707−
708−--TODO: There must be a more generic way to get this witness and allow us to case on the type-level StateMode
709−data StateModeWitness (sm :: StateMode) where
710− EditWitness :: StateModeWitness Edit
711− ViewWitness :: StateModeWitness View
712−
713−class HasStateModeWitness (sm :: StateMode) where
714− stateModeWitness :: StateModeWitness sm
715−
716−instance HasStateModeWitness Edit where
717− stateModeWitness = EditWitness
718−
719−instance HasStateModeWitness View where
720− stateModeWitness = ViewWitness
721−-}
reflex-dom-core/test/hydration.hs+94−26
@@ -1,13 +1,9 @@
1−{-# OPTIONS_GHC -fno-warn-orphans #-}
2{-# LANGUAGE BangPatterns #-}
1{-# LANGUAGE BangPatterns #-}
3−{-# LANGUAGE StandaloneDeriving #-}
4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5−{-# LANGUAGE UndecidableInstances #-}
6{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE ConstraintKinds #-}
7−{-# LANGUAGE CPP #-}
8{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
9{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
10{-# LANGUAGE GADTs #-}
5{-# LANGUAGE GADTs #-}
6+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
11{-# LANGUAGE LambdaCase #-}
7{-# LANGUAGE LambdaCase #-}
12{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE MultiParamTypeClasses #-}
13{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE OverloadedStrings #-}
@@ -15,13 +11,19 @@
15{-# LANGUAGE RankNTypes #-}
11{-# LANGUAGE RankNTypes #-}
16{-# LANGUAGE RecursiveDo #-}
12{-# LANGUAGE RecursiveDo #-}
17{-# LANGUAGE ScopedTypeVariables #-}
13{-# LANGUAGE ScopedTypeVariables #-}
14+{-# LANGUAGE StandaloneDeriving #-}
18{-# LANGUAGE TemplateHaskell #-}
15{-# LANGUAGE TemplateHaskell #-}
19{-# LANGUAGE TupleSections #-}
16{-# LANGUAGE TupleSections #-}
20{-# LANGUAGE TypeApplications #-}
17{-# LANGUAGE TypeApplications #-}
21{-# LANGUAGE TypeFamilies #-}
18{-# LANGUAGE TypeFamilies #-}
19+{-# LANGUAGE UndecidableInstances #-}
20+
21+{-# OPTIONS_GHC -fno-warn-orphans #-}
22
22
23import Prelude hiding (fail)
23import Prelude hiding (fail)
24import Control.Concurrent
24import Control.Concurrent
25+import qualified Control.Concurrent.Async as Async
26+import Control.Lens.Operators
25import Control.Monad hiding (fail)
27import Control.Monad hiding (fail)
26import Control.Monad.Catch
28import Control.Monad.Catch
27import Control.Monad.Fail
29import Control.Monad.Fail
@@ -31,7 +33,7 @@ import Control.Monad.Ref
31import Data.Constraint.Extras
33import Data.Constraint.Extras
32import Data.Constraint.Extras.TH
34import Data.Constraint.Extras.TH
33import Data.Dependent.Map (DMap)
35import Data.Dependent.Map (DMap)
34−import Data.Dependent.Sum (DSum(..), (==>), EqTag(..), ShowTag(..))
36+import Data.Dependent.Sum (DSum(..), (==>))
35import Data.Functor.Identity
37import Data.Functor.Identity
36import Data.Functor.Misc
38import Data.Functor.Misc
37import Data.GADT.Compare.TH
39import Data.GADT.Compare.TH
@@ -62,7 +64,6 @@ import Test.Hspec (xit)
62import Test.Hspec.WebDriver hiding (runWD, click, uploadFile, WD)
64import Test.Hspec.WebDriver hiding (runWD, click, uploadFile, WD)
63import qualified Test.Hspec.WebDriver as WD
65import qualified Test.Hspec.WebDriver as WD
64import Test.WebDriver (WD(..))
66import Test.WebDriver (WD(..))
65−import Test.WebDriver.Exceptions (ServerError(..))
66
67
67import qualified Data.ByteString.Lazy as LBS
68import qualified Data.ByteString.Lazy as LBS
68import qualified Data.Dependent.Map as DMap
69import qualified Data.Dependent.Map as DMap
@@ -78,6 +79,9 @@ import qualified Test.WebDriver.Capabilities as WD
78import Test.Util.ChromeFlags
79import Test.Util.ChromeFlags
79import Test.Util.UnshareNetwork
80import Test.Util.UnshareNetwork
80
81
82+-- ORPHAN: https://github.com/kallisti-dev/hs-webdriver/pull/167
83+deriving instance MonadMask WD
84+
81chromium :: FilePath
85chromium :: FilePath
82chromium = $(staticWhich "chromium")
86chromium = $(staticWhich "chromium")
83
87
@@ -770,6 +774,15 @@ tests withDebugging wdConfig caps _selenium = do
770 prerender_ (pure ()) (liftIO $ trigger "Client")
774 prerender_ (pure ()) (liftIO $ trigger "Client")
771 textNode $ TextNodeConfig "Initial" $ Just e
775 textNode $ TextNodeConfig "Initial" $ Just e
772
776
777+ describe "namespaces" $ session' $ do
778+ it "dyn can be nested in namespaced widget" $ runWD $ do
779+ testWidget (pure ()) (checkTextInTag "svg" "one") $ do
780+ let svgRootCfg = def
781+ & (elementConfig_namespace ?~ "http://www.w3.org/2000/svg")
782+ & (elementConfig_initialAttributes .~ ("width" =: "100%" <> "height" =: "100%" <> "viewBox" =: "0 0 1536 2048"))
783+ void $ element "svg" svgRootCfg $ do
784+ dyn_ $ text "one" <$ pure ()
785+
773 describe "runWithReplace" $ session' $ do
786 describe "runWithReplace" $ session' $ do
774 it "works" $ runWD $ do
787 it "works" $ runWD $ do
775 replaceChan :: Chan Text <- liftIO newChan
788 replaceChan :: Chan Text <- liftIO newChan
@@ -914,6 +927,58 @@ tests withDebugging wdConfig caps _selenium = do
914 , el "span" . text <$> replace
927 , el "span" . text <$> replace
915 ]
928 ]
916
929
930+ let checkInnerHtml t x = findElemWithRetry (WD.ByTag t) >>= (`attr` "innerHTML") >>= (`shouldBe` Just x)
931+ it "removes bracketing comments" $ runWD $ do
932+ replaceChan :: Chan () <- liftIO newChan
933+ let
934+ preSwitchover = checkInnerHtml "div" "before|<!--replace-start-0-->inner1<!--replace-end-0-->|after"
935+ check () = do
936+ liftIO $ writeChan replaceChan () -- trigger creation of p tag
937+ _ <- findElemWithRetry $ WD.ByTag "p" -- wait till p tag is created
938+ checkInnerHtml "div" "before|<p>inner2</p>|after"
939+ testWidget' preSwitchover check $ do
940+ replace <- triggerEventWithChan replaceChan
941+ el "div" $ do
942+ text "before|"
943+ _ <- runWithReplace (text "inner1") $ el "p" (text "inner2") <$ replace
944+ text "|after"
945+ it "ignores extra ending bracketing comment" $ runWD $ do
946+ replaceChan :: Chan () <- liftIO newChan
947+ let
948+ preSwitchover = checkInnerHtml "div" "before|<!--replace-start-0-->inner1<!--replace-end-0--><!--replace-end-0-->|after"
949+ check () = do
950+ liftIO $ writeChan replaceChan () -- trigger creation of p tag
951+ _ <- findElemWithRetry $ WD.ByTag "p" -- wait till p tag is created
952+ checkInnerHtml "div" "before|inner2|after"
953+ testWidget' preSwitchover check $ do
954+ replace <- triggerEventWithChan replaceChan
955+ el "div" $ do
956+ text "before|"
957+ _ <- runWithReplace (text "inner1" *> comment "replace-end-0") $ text "inner2" <$ replace
958+ text "|after"
959+ void $ runWithReplace blank $ el "p" blank <$ replace -- Signal tag for end of test
960+ it "ignores missing ending bracketing comments" $ runWD $ do
961+ replaceChan :: Chan () <- liftIO newChan
962+ let
963+ preSwitchover = do
964+ checkInnerHtml "div" "before|<!--replace-start-0-->inner1<!--replace-end-0-->|after"
965+ divEl <- findElemWithRetry (WD.ByTag "div")
966+ let wrongHtml = "<!--replace-start-0-->inner1"
967+ actualHtml :: String <- WD.executeJS
968+ [WD.JSArg divEl, WD.JSArg wrongHtml]
969+ "arguments[0].innerHTML = arguments[1]; return arguments[0].innerHTML"
970+ actualHtml `shouldBe` wrongHtml
971+ check () = do
972+ liftIO $ writeChan replaceChan () -- trigger creation of p tag
973+ _ <- findElemWithRetry $ WD.ByTag "p" -- wait till p tag is created
974+ checkInnerHtml "div" "before|<p>inner2</p>|after"
975+ testWidget' preSwitchover check $ do
976+ replace <- triggerEventWithChan replaceChan
977+ el "div" $ do
978+ text "before|"
979+ _ <- runWithReplace (text "inner1") $ el "p" (text "inner2") <$ replace
980+ text "|after"
981+
917 describe "traverseDMapWithKeyWithAdjust" $ session' $ do
982 describe "traverseDMapWithKeyWithAdjust" $ session' $ do
918 let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a)
983 let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a)
919 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do
984 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do
@@ -1305,8 +1370,8 @@ withRetry a = wait 300
1305 where wait :: Int -> WD a
1370 where wait :: Int -> WD a
1306 wait 0 = a
1371 wait 0 = a
1307 wait n = try a >>= \case
1372 wait n = try a >>= \case
1308− Left (_ :: SomeException) -> do
1373+ Left (e :: SomeException) -> do
1309− liftIO $ threadDelay 100000
1374+ liftIO $ putStrLn ("(retrying due to " <> show e <> ")") *> threadDelay 100000
1310 wait $ n - 1
1375 wait $ n - 1
1311 Right v -> return v
1376 Right v -> return v
1312
1377
@@ -1388,23 +1453,26 @@ testWidgetDebug' withDebugging beforeJS afterSwitchover bodyWidget = do
1388 ]
1453 ]
1389 -- hSilence to get rid of ConnectionClosed logs
1454 -- hSilence to get rid of ConnectionClosed logs
1390 silenceIfDebug = if withDebugging then id else hSilence [stderr]
1455 silenceIfDebug = if withDebugging then id else hSilence [stderr]
1391− jsaddleWarp = forkIO $ silenceIfDebug $ Warp.runSettings settings application
1456+ jsaddleWarp = silenceIfDebug $ Warp.runSettings settings application
1392− jsaddleTid <- liftIO jsaddleWarp
1457+ withAsync' jsaddleWarp $ do
1393− putStrLnDebug "taking waitJSaddle"
1458+ putStrLnDebug "taking waitJSaddle"
1394− liftIO $ takeMVar waitJSaddle
1459+ liftIO $ takeMVar waitJSaddle
1395− putStrLnDebug "opening page"
1460+ putStrLnDebug "opening page"
1396− WD.openPage $ "http://localhost:" <> show jsaddlePort
1461+ WD.openPage $ "http://localhost:" <> show jsaddlePort
1397− putStrLnDebug "running beforeJS"
1462+ putStrLnDebug "running beforeJS"
1398− a <- beforeJS
1463+ a <- beforeJS
1399− putStrLnDebug "putting waitBeforeJS"
1464+ putStrLnDebug "putting waitBeforeJS"
1400− liftIO $ putMVar waitBeforeJS ()
1465+ liftIO $ putMVar waitBeforeJS ()
1401− putStrLnDebug "taking waitUntilSwitchover"
1466+ putStrLnDebug "taking waitUntilSwitchover"
1402− liftIO $ takeMVar waitUntilSwitchover
1467+ liftIO $ takeMVar waitUntilSwitchover
1403− putStrLnDebug "running afterSwitchover"
1468+ putStrLnDebug "running afterSwitchover"
1404− b <- afterSwitchover a
1469+ afterSwitchover a
1405− putStrLnDebug "killing jsaddle thread"
1470+
1406− liftIO $ killThread jsaddleTid
1471+withAsync' :: (MonadIO m, MonadMask m) => IO a -> m b -> m b
1407− return b
1472+withAsync' f g = bracket
1473+ (liftIO $ Async.async f)
1474+ (liftIO . Async.uninterruptibleCancel)
1475+ (const g)
1408
1476
1409data Key2 a where
1477data Key2 a where
1410 Key2_Int :: Int -> Key2 Int
1478 Key2_Int :: Int -> Key2 Int
reflex-dom/ChangeLog.md+6−2
@@ -1,12 +1,15 @@
1# Revision history for reflex-dom
1# Revision history for reflex-dom
2
2
3−## Unreleased
3+## 0.5.3
4+
4* On Android, enable prompting the user for geolocation
5* On Android, enable prompting the user for geolocation
5 permissions on demand by default. See
6 permissions on demand by default. See
6 https://developer.android.com/reference/android/webkit/WebChromeClient.html#onGeolocationPermissionsShowPrompt(java.lang.String,%20android.webkit.GeolocationPermissions.Callback)
7 https://developer.android.com/reference/android/webkit/WebChromeClient.html#onGeolocationPermissionsShowPrompt(java.lang.String,%20android.webkit.GeolocationPermissions.Callback)
7 for details.
8 for details.
8
9
10+ * Add `< 0.7` upper bound for reflex
11+
9−## 0.5.1
12+## 0.5.2
10
13
11* The default jsaddle backend on macOS when built from nix
14* The default jsaddle backend on macOS when built from nix
12 is now jsaddle-wkwebview, matching the behaviour of cabal
15 is now jsaddle-wkwebview, matching the behaviour of cabal
@@ -15,4 +18,5 @@
15## 0.5
18## 0.5
16
19
17* Re-export new hydration widget "mainWidget" functions.
20* Re-export new hydration widget "mainWidget" functions.
21+
18* The use-warp flag now properly takes precedence on macOS.
22* The use-warp flag now properly takes precedence on macOS.
reflex-dom/reflex-dom.cabal+3−3
@@ -1,5 +1,5 @@
1Name: reflex-dom
1Name: reflex-dom
2−Version: 0.5.2.0
2+Version: 0.5.3
3Synopsis: Functional Reactive Web Apps with Reflex
3Synopsis: Functional Reactive Web Apps with Reflex
4Description:
4Description:
5 Reflex-DOM is a Functional Reactive web framework based on the Reflex FRP engine.
5 Reflex-DOM is a Functional Reactive web framework based on the Reflex FRP engine.
@@ -59,8 +59,8 @@ library
59 build-depends:
59 build-depends:
60 base >= 4.7 && < 4.13,
60 base >= 4.7 && < 4.13,
61 bytestring == 0.10.*,
61 bytestring == 0.10.*,
62− reflex >= 0.6.2,
62+ reflex >= 0.6.2 && < 0.7,
63− reflex-dom-core >=0.5.2 && <0.6,
63+ reflex-dom-core >=0.5.2 && < 0.6,
64 text == 1.2.*
64 text == 1.2.*
65 if !impl(ghcjs)
65 if !impl(ghcjs)
66 if flag(use-warp) && (os(linux) || os(osx))
66 if flag(use-warp) && (os(linux) || os(osx))