develop..1facfef · reflex-dom

git.iko.soy/reflex-dom

on 1facfef help sign in

.github/workflows/haskell.ymldeleted−47

since splitsnapshots

unifiedsplit

@@ -1,47 +0,0 @@

1−name: github-action

2−

3−on: [push, pull_request]

4−

5−jobs:

6− build:

7− strategy:

8− matrix:

9− ghc: ['8.4.4', '8.6.5', '8.8.4', '8.10.2']

10− os: ['ubuntu-latest', 'macos-latest']

11− exclude:

12− # There are some linker warnings in 802 on darwin that

13− # cause compilation to fail

14− # See https://github.com/NixOS/nixpkgs/issues/25139

15− - ghc: '8.0.2'

16− os: 'macos-latest'

17− runs-on: ${{ matrix.os }}

18−

19− name: GHC ${{ matrix.ghc }} on ${{ matrix.os }}

20− steps:

21− - uses: actions/checkout@v2

22− - uses: actions/setup-haskell@v1

23− with:

24− ghc-version: ${{ matrix.ghc }}

25− - name: Cache

26− uses: actions/cache@v1

27− env:

28− cache-name: cache-cabal

29− with:

30− path: ~/.cabal

31− key: ${{ runner.os }}-${{ matrix.ghc }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }}

32− restore-keys: |

33− ${{ runner.os }}-${{ matrix.ghc }}-build-${{ env.cache-name }}-

34− ${{ runner.os }}-${{ matrix.ghc }}-build-

35− ${{ runner.os }}-${{ matrix.ghc }}-

36− ${{ runner.os }}

37−

38− - name: Set up cabal project file to avoid webkit2gtk

39− run: cp cabal.project-nogtk cabal.project

40− - name: Install dependencies

41− run: |

42− cabal update

43− cabal build --only-dependencies --enable-tests --enable-benchmarks all

44− - name: Build

45− run: cabal build --enable-tests --enable-benchmarks all

46− - name: Run tests

47− run: cabal test all

LICENSEdeleted−12

@@ -1,12 +0,0 @@

3−

4−Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

5−

6−1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.

7−

8−2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.

9−

10−3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.

11−

12−THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md+9−9

@@ -1,21 +1,21 @@

1## [Reflex-DOM](https://reflex-frp.org)

3−[![Haskell](https://img.shields.io/badge/language-Haskell-orange.svg)](https://haskell.org) [![Hackage](https://img.shields.io/hackage/v/reflex-dom.svg)](https://hackage.haskell.org/package/reflex-dom) [![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/reflex-dom/badge)](https://matrix.hackage.haskell.org/#/package/reflex-dom) [![BSD3 License](https://img.shields.io/badge/license-BSD3-blue.svg)](https://github.com/reflex-frp/reflex-dom/blob/master/LICENSE)

3+[![Hackage](https://img.shields.io/hackage/v/reflex-dom.svg)](http://hackage.haskell.org/package/reflex-dom)

5−Web applications without callbacks or side-effects. Reflex-DOM brings the power of [Functional Reactive Programming (FRP)](https://wiki.haskell.org/Functional_Reactive_Programming) to the web. Build [HTML](https://developer.mozilla.org/en-US/docs/Web/HTML) and other [Document Object Model (DOM)](https://developer.mozilla.org/en-US/docs/Web/API/Document_Object_Model) data with a pure functional interface.

5+### A Framework for Functional Reactive Web Apps in Haskell

7−Reflex-DOM is a framework for building web applications in [Haskell](https://www.haskell.org/), based on the [Functional Reactive Programming](https://wiki.haskell.org/Functional_Reactive_Programming) library [Reflex](https://github.com/reflex-frp/reflex).

7+Reflex-DOM is a framework for building web applications in Haskell, based on the [Functional Reactive Programming](https://wiki.haskell.org/Functional_Reactive_Programming) library [Reflex](https://github.com/reflex-frp/reflex).

9+A summary of Reflex-DOM functions is available in the [quick reference](Quickref.md).

9**Visit https://reflex-frp.org/ for more information, tutorials, documentation and [examples](https://examples.reflex-frp.org/).**

11**Visit https://reflex-frp.org/ for more information, tutorials, documentation and [examples](https://examples.reflex-frp.org/).**

11### Additional resources

13### Additional resources

14+[Get started with Reflex](https://github.com/reflex-frp/reflex-platform)

15+

16+[/r/reflexfrp](https://www.reddit.com/r/reflexfrp)

13−* [Official Website](https://reflex-frp.org/)

14−* [Quick Reference](Quickref.md)

15−* [Obelisk](https://github.com/obsidiansystems/obelisk#obelisk): A framework built on Reflex and Reflex-DOM for functional reactive web and mobile applications, with batteries included.

16−* [Get started with Reflex](https://github.com/reflex-frp/reflex-platform)

17−* [/r/reflexfrp](https://www.reddit.com/r/reflexfrp)

18−* [irc.freenode.net #reflex-frp](http://webchat.freenode.net?channels=%23reflex-frp&uio=d4)

18+[irc.freenode.net #reflex-frp](http://webchat.freenode.net?channels=%23reflex-frp&uio=d4)

20### Hacking

cabal.project+1−10

@@ -1,10 +1 @@

1−packages:

2− reflex-dom-core/

1+packages: reflex-dom-core, reflex-dom

3− reflex-dom/

4− chrome-test-utils/

5− reflex-dom-test-selenium/

6−

7−source-repository-package

8− type: git

9− location: https://github.com/dfordivam/hspec-webdriver-clone

10− tag: 0d748b7bb7cd74dce0a55a1ec86b01dbb8a71cd8

cabal.project-nogtkdeleted−14

@@ -1,14 +0,0 @@

1−packages:

2− reflex-dom-core/

3− reflex-dom/

4−

5−package reflex-dom-core

6− flags: -hydration-tests -gc-tests

7−

8−package reflex-dom

9− flags: +use-warp -webkit2gtk

10−

11−source-repository-package

12− type: git

13− location: https://github.com/dfordivam/hspec-webdriver-clone

14− tag: 0d748b7bb7cd74dce0a55a1ec86b01dbb8a71cd8

chrome-test-utils/LICENSE+1−1

@@ -1,4 +1,4 @@

2All rights reserved.

4Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

chrome-test-utils/chrome-test-utils.cabal+1−1

@@ -1,5 +1,5 @@

1Name: chrome-test-utils

2−Version: 0.5

2+Version: 0.4

3Synopsis: Utilities to write headless Chromium tests

4License: BSD3

5License-file: LICENSE

chrome-test-utils/src/Test/Util/UnshareNetwork.hs+2−2

@@ -4,8 +4,8 @@ import System.Linux.Namespaces

4import System.Posix

5import System.Process

7−unshareNetwork :: IO ()

7+unshareNetork :: IO ()

8−unshareNetwork = do

8+unshareNetork = do

9 uid <- getEffectiveUserID

10 unshare [User, Network]

11 writeUserMappings Nothing [UserMapping 0 uid 1]

dep/reflex-platform/default.nix+6−1

@@ -1,2 +1,7 @@

1# DO NOT HAND-EDIT THIS FILE

2−import (import ./thunk.nix)

2+import ((import <nixpkgs> {}).fetchFromGitHub (

3+ let json = builtins.fromJSON (builtins.readFile ./github.json);

4+ in { inherit (json) owner repo rev sha256;

5+ private = json.private or false;

6+ }

7+))

dep/reflex-platform/github.json+3−4

@@ -1,8 +1,7 @@

2 "owner": "reflex-frp",

3 "repo": "reflex-platform",

4− "branch": "aa-bump-some",

4+ "branch": "master",

5− "private": false,

5+ "rev": "510b990d0b11f0626afbec5fe8575b5b2395391b",

6− "rev": "fd5acecb50474f795734db9fb924cc3b2fd2b508",

6+ "sha256": "09cmahsbxr0963wq171c7j139iyzz49hramr4v9nsf684wcwkngv"

7− "sha256": "0wsdd67g42klsf9n3pxb3pndjdz36nzf8gp7pfm8j6nyyy2qribk"

dep/reflex-platform/thunk.nixdeleted−9

@@ -1,9 +0,0 @@

1−# DO NOT HAND-EDIT THIS FILE

2−let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:

3− if !fetchSubmodules && !private then builtins.fetchTarball {

4− url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;

5− } else (import <nixpkgs> {}).fetchFromGitHub {

6− inherit owner repo rev sha256 fetchSubmodules private;

7− };

8− json = builtins.fromJSON (builtins.readFile ./github.json);

9−in fetch json

reflex-dom-core/ChangeLog.md+30−45

@@ -1,66 +1,51 @@

1# Revision history for reflex-dom-core

3−## 0.6.2.1

3+## Unreleased

5−* Fix hlint complaints with newer GHC.

6−

7−## 0.6.2.0

8−

9−* ([#400](https://github.com/reflex-frp/reflex-dom/pull/400/files)) Set value of input elements in static renderer

10−

11−## 0.6.1.0

12−

13−* Bump version bounds

14−* Update for new dependent-map and dependent-sum version (after the "some" package split)

15−* Add `MonadAtomicRef` instance for `UnrunnableT`

16−* Fix ([#467](https://github.com/reflex-frp/reflex-dom/issues/467)): Prevent multiple firings of XHR response event

17−* Updates for GHC 8.10

18−* Move `HasSetValue` from Reflex.Dom.Widget.Input to Reflex.Dom.Builder.Class and add an instance for `TextAreaElementConfig`

19−* Add `now` to the `MonadHold` instance for `UnrunnableT`

20−

21−

22−## 0.6.0.0

23−

24−* ([#375](https://github.com/reflex-frp/reflex-dom/pull/375)) **(Breaking change)** Expose resized dimensions from `resizeDetector`, `resizeDetectorWithStyle`, and `resizeDetectorWithAttrs` from `Reflex.Dom.Widget.Resize`.

25−* ([#374](https://github.com/reflex-frp/reflex-dom/pull/374)) **(Breaking change)** Provide text clipboard data as value of `Paste` event.

26−* ([#348](https://github.com/reflex-frp/reflex-dom/pull/348)) **(Breaking change)** Make XHR response headers case insensitive by changing `_xhrResponse_headers :: Map Text Text` to `_xhrResponse_headers :: Map (CI Text) Text`.

27−* ([#225](https://github.com/reflex-frp/reflex-dom/pull/225)) **(Breaking change)** Add a functional dependency to `HasDomEvent`.

28−* ([#342](https://github.com/reflex-frp/reflex-dom/issues/342)) **(Breaking change)** The mouse wheel event is now a `WheelEventResult` rather than `()`. This provides information about the wheel's motion beyond the fact that it merely moved.

29* ([#353](https://github.com/reflex-frp/reflex-dom/pull/353)) Support GHC 8.8.

5* ([#353](https://github.com/reflex-frp/reflex-dom/pull/353)) Support GHC 8.8.

30* ([#358](https://github.com/reflex-frp/reflex-dom/pull/358)) Fix attribute support for explicitly namespaced elements.

6* ([#358](https://github.com/reflex-frp/reflex-dom/pull/358)) Fix attribute support for explicitly namespaced elements.

31* ([#363](https://github.com/reflex-frp/reflex-dom/pull/363)) Remove deprecation warnings for the following widgets in

7* ([#363](https://github.com/reflex-frp/reflex-dom/pull/363)) Remove deprecation warnings for the following widgets in

32 `Reflex.Dom.Widget.Basic`:

8 `Reflex.Dom.Widget.Basic`:

33− * `Link`

10+ * `Link`

34− * `button`

11+ * `button`

35− * `dtdd`

12+ * `dtdd`

36− * `linkClass`

13+ * `linkClass`

37− * `link`

14+ * `link`

38− * `tabDisplay`

15+ * `tabDisplay`

39− * `tableDynAttr`

16+ * `tableDynAttr`

40* ([#361](https://github.com/reflex-frp/reflex-dom/pull/361)) Fix bug in hydration causing the JavaScript to crash when dealing with unexpected HTML.

17* ([#361](https://github.com/reflex-frp/reflex-dom/pull/361)) Fix bug in hydration causing the JavaScript to crash when dealing with unexpected HTML.

41−* ([#310](https://github.com/reflex-frp/reflex-dom/issues/310)) Fix the static rendering of which dropdown value is selected.

42* ([#364](https://github.com/reflex-frp/reflex-dom/pull/364)) Export attributes used for controlling hydration at the element level:

18* ([#364](https://github.com/reflex-frp/reflex-dom/pull/364)) Export attributes used for controlling hydration at the element level:

43 * "data-ssr" is now available as `Reflex.Dom.Builder.Immediate.hydratableAttribute`.

19 * "data-ssr" is now available as `Reflex.Dom.Builder.Immediate.hydratableAttribute`.

44 * "data-hydration-skip" is now available as `Reflex.Dom.Builder.Immediate.skipHydrationAttribute`.

20 * "data-hydration-skip" is now available as `Reflex.Dom.Builder.Immediate.skipHydrationAttribute`.

21+* ([#348](https://github.com/reflex-frp/reflex-dom/pull/348)) **(Breaking change)** Make XHR response headers case insensitive by changing `_xhrResponse_headers :: Map Text Text` to `_xhrResponse_headers :: Map (CI Text) Text`.

22+* ([#225](https://github.com/reflex-frp/reflex-dom/pull/225)) **(Breaking change)** Add a functional dependency to `HasDomEvent`.

45* ([#366](https://github.com/reflex-frp/reflex-dom/pull/366)) Bump bounds for `reflex` to include 0.7.

23* ([#366](https://github.com/reflex-frp/reflex-dom/pull/366)) Bump bounds for `reflex` to include 0.7.

25+

47## 0.5.3

26## 0.5.3

49* Deprecate a number of old inflexible widget helpers in `Reflex.Dom.Widget.Basic`:

28* Deprecate a number of old inflexible widget helpers in `Reflex.Dom.Widget.Basic`:

29+

50− * `Link`

30+ * `Link`

51− * `button`

31+ * `button`

52− * `dtdd`

32+ * `dtdd`

53− * `linkClass`

33+ * `linkClass`

54− * `link`

34+ * `link`

55− * `tabDisplay`

35+ * `tabDisplay`

56− * `tableDynAttr`

36+ * `tableDynAttr`

58 And in `Reflex.Dom.Widget.Input`:

38 And in `Reflex.Dom.Widget.Input`:

39+

59− * `TextInput`

40+ * `TextInput`

60− * `TextAreaConfig`

41+ * `TextAreaConfig`

61− * `CheckboxConfig`

42+ * `CheckboxConfig`

62− * `FileInput`

43+ * `FileInput`

44+

63−* Add `< 0.7` upper bound for `reflex`.

45+ * Add `< 0.7` upper bound for reflex

46+

47+* *(Breaking change)* The mouse wheel event now is a `WheelEventResult` rather than `()`.

48+ This provides information about the wheel's motion beyond the fact that it merely moved.

65## 0.5.2

50## 0.5.2

reflex-dom-core/LICENSE+1−1

@@ -1,4 +1,4 @@

2All rights reserved.

4Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

reflex-dom-core/reflex-dom-core.cabal+21−43

@@ -1,18 +1,7 @@

1−cabal-version: 1.24

2Name: reflex-dom-core

1Name: reflex-dom-core

3−Version: 0.6.2.1

2+Version: 0.5.3

4Synopsis: Functional Reactive Web Apps with Reflex

3Synopsis: Functional Reactive Web Apps with Reflex

5−Description:

6− Web applications without callbacks or side-effects.

7− Reflex-DOM brings the power of functional reactive programming (FRP) to the web.

8− Build HTML and other Document Object Model (DOM) data with a pure functional interface.

9− .

10− Reflex-DOM is a Functional Reactive web framework based on the Reflex FRP engine: <https://reflex-frp.org/>.

4+Description: Reflex-DOM is a Functional Reactive web framework based on the Reflex FRP engine

11− .

12− The @reflex-dom@ package is a small wrapper around the @reflex-dom-core@ package. It pulls in the

13− correct set of dependencies for each target platform (GHCJS, WebKitGTK, WASM, mobile, etc.).

14− Libraries should depend on @reflex-dom-core@ and executables will usually depend on @reflex-dom@.

15− All of @reflex-dom-core@'s modules are re-exported by @reflex-dom@.

16License: BSD3

5License: BSD3

17License-file: LICENSE

6License-file: LICENSE

18Author: Ryan Trinkle

7Author: Ryan Trinkle

@@ -20,6 +9,7 @@ Maintainer: ryan.trinkle@gmail.com

20Stability: Experimental

9Stability: Experimental

21Category: FRP, Web, GUI, HTML, Javascript, Reactive, Reactivity, User Interfaces, User-interface

10Category: FRP, Web, GUI, HTML, Javascript, Reactive, Reactivity, User Interfaces, User-interface

22Build-type: Simple

11Build-type: Simple

12+Cabal-version: >=1.9.2

23-- Deal with https://github.com/haskell/cabal/issues/2544 / https://github.com/haskell/cabal/issues/367

13-- Deal with https://github.com/haskell/cabal/issues/2544 / https://github.com/haskell/cabal/issues/367

24extra-source-files: src-ghc/Foreign/JavaScript/Internal/Utils.hs

14extra-source-files: src-ghc/Foreign/JavaScript/Internal/Utils.hs

25 src-ghcjs/Foreign/JavaScript/Internal/Utils.hs

15 src-ghcjs/Foreign/JavaScript/Internal/Utils.hs

@@ -54,32 +44,22 @@ flag split-these

54 manual: False

44 manual: False

55 default: True

45 default: True

57−flag hydration-tests

58− description: Whether to run the hydration tests (currently only available on linux)

59− default: True

60− manual: True

61−

62−flag gc-tests

63− description: Whether to run the gc tests (currently only available on linux)

64− default: True

65− manual: True

66−

67library

47library

68 hs-source-dirs: src

48 hs-source-dirs: src

69 build-depends:

49 build-depends:

70− aeson >= 0.8 && < 1.6,

50+ aeson >= 0.8 && < 1.5,

71− base >= 4.7 && < 4.15,

51+ base >= 4.7 && < 4.14,

72 bifunctors >= 4.2 && < 6,

52 bifunctors >= 4.2 && < 6,

73− bimap >= 0.3 && < 0.5,

53+ bimap >= 0.3 && < 0.4,

74− blaze-builder >= 0.4.1 && < 0.5,

54+ blaze-builder,

75 bytestring == 0.10.*,

55 bytestring == 0.10.*,

76 case-insensitive < 1.3,

56 case-insensitive < 1.3,

77 containers >= 0.6 && < 0.7,

57 containers >= 0.6 && < 0.7,

78− constraints >= 0.9 && < 0.13,

58+ constraints >= 0.9 && < 0.12,

79 contravariant >= 1.4 && < 1.6,

59 contravariant >= 1.4 && < 1.6,

80 data-default >= 0.5 && < 0.8,

60 data-default >= 0.5 && < 0.8,

81− dependent-map >= 0.3 && < 0.5,

61+ dependent-map >= 0.3 && < 0.4,

82− dependent-sum >= 0.6 && < 0.8,

62+ dependent-sum >= 0.6 && < 0.7,

83 dependent-sum-template >= 0.1 && < 0.2,

63 dependent-sum-template >= 0.1 && < 0.2,

84 directory >= 1.2 && < 1.4,

64 directory >= 1.2 && < 1.4,

85 exception-transformers == 0.4.*,

65 exception-transformers == 0.4.*,

@@ -91,9 +71,9 @@ library

91 monad-control >= 1.0.1 && < 1.1,

71 monad-control >= 1.0.1 && < 1.1,

92 mtl >= 2.1 && < 2.3,

72 mtl >= 2.1 && < 2.3,

93 primitive >= 0.5 && < 0.8,

73 primitive >= 0.5 && < 0.8,

94− random >= 1.1 && < 1.2,

74+ random,

95 ref-tf == 0.4.*,

75 ref-tf == 0.4.*,

96− reflex >= 0.8 && < 0.9,

76+ reflex >= 0.6.2 && < 0.8,

97 semigroups >= 0.16 && < 0.20,

77 semigroups >= 0.16 && < 0.20,

98 stm >= 2.4 && < 2.6,

78 stm >= 2.4 && < 2.6,

99 text == 1.2.*,

79 text == 1.2.*,

@@ -114,7 +94,7 @@ library

114 if flag(split-these)

94 if flag(split-these)

115 build-depends:

95 build-depends:

116 semialign >= 1 && < 1.2,

96 semialign >= 1 && < 1.2,

117− these >= 1 && < 1.2

97+ these >= 1 && < 1.1

118 else

98 else

119 build-depends:

99 build-depends:

120 these >= 0.4 && < 0.9

100 these >= 0.4 && < 0.9

@@ -153,7 +133,6 @@ library

153 Reflex.Dom.Xhr.ResponseType

133 Reflex.Dom.Xhr.ResponseType

154 Reflex.Dom.Xhr.Exception

134 Reflex.Dom.Xhr.Exception

155

135

156− default-language: Haskell98

157 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans -fspecialise-aggressively

136 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans -fspecialise-aggressively

158 ghc-prof-options: -fprof-auto

137 ghc-prof-options: -fprof-auto

159

138

@@ -168,21 +147,22 @@ library

168

147

169 if flag(use-template-haskell)

148 if flag(use-template-haskell)

170 build-depends:

149 build-depends:

150+ dependent-sum >= 0.6,

171 dependent-sum-template >= 0.1 && < 0.2,

151 dependent-sum-template >= 0.1 && < 0.2,

172− template-haskell >= 2.12.0 && < 2.17

152+ template-haskell

173 other-extensions: TemplateHaskell

153 other-extensions: TemplateHaskell

174 cpp-options: -DUSE_TEMPLATE_HASKELL

154 cpp-options: -DUSE_TEMPLATE_HASKELL

175 other-modules:

155 other-modules:

176 Reflex.Dom.Builder.Class.TH

156 Reflex.Dom.Builder.Class.TH

157+ else

158+ build-depends:

159+ dependent-sum == 0.6.*

177

160

178test-suite hlint

161test-suite hlint

179− build-depends:

162+ build-depends: base, hlint

180− base,

181− hlint >= 2.0 && < 4.0

182 hs-source-dirs: test

163 hs-source-dirs: test

183 main-is: hlint.hs

164 main-is: hlint.hs

184 type: exitcode-stdio-1.0

165 type: exitcode-stdio-1.0

185− default-language: Haskell98

186

166

187test-suite hydration

167test-suite hydration

188 build-depends: base

168 build-depends: base

@@ -229,8 +209,7 @@ test-suite hydration

229 ghc-prof-options: -fprof-auto -optP-DPROFILING

209 ghc-prof-options: -fprof-auto -optP-DPROFILING

230 main-is: hydration.hs

210 main-is: hydration.hs

231 type: exitcode-stdio-1.0

211 type: exitcode-stdio-1.0

232− default-language: Haskell98

233− if !os(linux) || !arch(x86_64) || flag(profile-reflex) || !flag(hydration-tests)

212+ if !os(linux) || !arch(x86_64) || flag(profile-reflex)

234 buildable: False

213 buildable: False

235

214

236-- broken test on base 4.11 & ghc 8.4.3

215-- broken test on base 4.11 & ghc 8.4.3

@@ -249,8 +228,7 @@ test-suite gc

249 ghc-prof-options: -fprof-auto -optP-DPROFILING

228 ghc-prof-options: -fprof-auto -optP-DPROFILING

250 main-is: gc.hs

229 main-is: gc.hs

251 type: exitcode-stdio-1.0

230 type: exitcode-stdio-1.0

252− default-language: Haskell98

253− if !os(linux) || !arch(x86_64) || !flag(gc-tests)

231+ if !os(linux) || !arch(x86_64)

254 buildable: False

232 buildable: False

255

233

256source-repository head

234source-repository head

reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+1−10

@@ -9,12 +9,11 @@

9{-# LANGUAGE GeneralizedNewtypeDeriving #-}

10#if !MIN_VERSION_base(4,9,0)

11{-# LANGUAGE ImpredicativeTypes #-}

12−#else

13−{-# LANGUAGE Rank2Types #-} -- Implied by ImpredicativeTypes

14#endif

12#endif

15{-# LANGUAGE LambdaCase #-}

13{-# LANGUAGE LambdaCase #-}

16{-# LANGUAGE OverloadedStrings #-}

14{-# LANGUAGE OverloadedStrings #-}

17{-# LANGUAGE PolyKinds #-}

15{-# LANGUAGE PolyKinds #-}

16+{-# LANGUAGE Rank2Types #-}

18{-# LANGUAGE RecursiveDo #-}

17{-# LANGUAGE RecursiveDo #-}

19{-# LANGUAGE ScopedTypeVariables #-}

18{-# LANGUAGE ScopedTypeVariables #-}

20{-# LANGUAGE StandaloneDeriving #-}

19{-# LANGUAGE StandaloneDeriving #-}

@@ -745,11 +744,3 @@ instance HasDocument m => HasDocument (DynamicWriterT t w m)

745instance HasDocument m => HasDocument (PostBuildT t m)

744instance HasDocument m => HasDocument (PostBuildT t m)

746instance HasDocument m => HasDocument (RequesterT t request response m)

745instance HasDocument m => HasDocument (RequesterT t request response m)

747instance HasDocument m => HasDocument (QueryT t q m)

746instance HasDocument m => HasDocument (QueryT t q m)

748−

749−class HasSetValue a where

750− type SetValue a :: *

751− setValue :: Lens' a (SetValue a)

752−

753−instance Reflex t => HasSetValue (TextAreaElementConfig er t m) where

754− type SetValue (TextAreaElementConfig er t m) = Event t Text

755− setValue = textAreaElementConfig_setValue

reflex-dom-core/src/Reflex/Dom/Builder/Class/Events.hs+1−2

@@ -14,7 +14,6 @@ import Data.GADT.Compare.TH

14import Data.GADT.Compare

15 (GOrdering(..), (:~:)(..), GEq(..), GCompare(..))

16#endif

17−import Data.Text (Text)

19data EventTag

18data EventTag

20 = AbortTag

19 = AbortTag

@@ -152,7 +151,7 @@ type family EventResultType (en :: EventTag) :: * where

152 EventResultType 'BeforecopyTag = ()

151 EventResultType 'BeforecopyTag = ()

153 EventResultType 'CopyTag = ()

152 EventResultType 'CopyTag = ()

154 EventResultType 'BeforepasteTag = ()

153 EventResultType 'BeforepasteTag = ()

155− EventResultType 'PasteTag = Maybe Text

154+ EventResultType 'PasteTag = ()

156 EventResultType 'ResetTag = ()

155 EventResultType 'ResetTag = ()

157 EventResultType 'SearchTag = ()

156 EventResultType 'SearchTag = ()

158 EventResultType 'SelectstartTag = ()

157 EventResultType 'SelectstartTag = ()

reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+21−72

@@ -2,6 +2,7 @@

2{-# LANGUAGE CPP #-}

3{-# LANGUAGE ConstraintKinds #-}

4{-# LANGUAGE DataKinds #-}

5+{-# LANGUAGE DeriveFunctor #-}

5{-# LANGUAGE DeriveTraversable #-}

6{-# LANGUAGE DeriveTraversable #-}

6{-# LANGUAGE EmptyDataDecls #-}

7{-# LANGUAGE EmptyDataDecls #-}

7{-# LANGUAGE FlexibleContexts #-}

8{-# LANGUAGE FlexibleContexts #-}

@@ -48,7 +49,6 @@ module Reflex.Dom.Builder.Immediate

48 , HydrationMode (..)

49 , HydrationMode (..)

49 , HydrationRunnerT (..)

50 , HydrationRunnerT (..)

50 , runHydrationRunnerT

51 , runHydrationRunnerT

51− , runHydrationRunnerTWithFailure

52 , ImmediateDomBuilderT

53 , runHydrationDomBuilderT

54 , getHydrationMode

@@ -135,18 +135,15 @@ import Data.Functor.Compose

135import Data.Functor.Constant

136import Data.Functor.Misc

137import Data.Functor.Product

138−import Data.GADT.Compare (GCompare)

139import Data.IORef

138import Data.IORef

140import Data.IntMap.Strict (IntMap)

139import Data.IntMap.Strict (IntMap)

141import Data.Maybe

140import Data.Maybe

142import Data.Monoid ((<>))

141import Data.Monoid ((<>))

143import Data.Some (Some(..))

142import Data.Some (Some(..))

144−import Data.GADT.Compare (GCompare)

145import Data.String (IsString)

143import Data.String (IsString)

146import Data.Text (Text)

144import Data.Text (Text)

147import Foreign.JavaScript.Internal.Utils

145import Foreign.JavaScript.Internal.Utils

148import Foreign.JavaScript.TH

146import Foreign.JavaScript.TH

149−import GHCJS.DOM.ClipboardEvent as ClipboardEvent

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

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

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

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

152import GHCJS.DOM.EventM (EventM, event, on)

149import GHCJS.DOM.EventM (EventM, event, on)

@@ -182,7 +179,6 @@ import qualified Data.IntMap.Strict as IntMap

182import qualified Data.Map as Map

179import qualified Data.Map as Map

183import qualified Data.Text as T

180import qualified Data.Text as T

184import qualified GHCJS.DOM as DOM

181import qualified GHCJS.DOM as DOM

185−import qualified GHCJS.DOM.DataTransfer as DataTransfer

186import qualified GHCJS.DOM.DocumentAndElementEventHandlers as Events

182import qualified GHCJS.DOM.DocumentAndElementEventHandlers as Events

187import qualified GHCJS.DOM.DocumentOrShadowRoot as Document

183import qualified GHCJS.DOM.DocumentOrShadowRoot as Document

188import qualified GHCJS.DOM.Element as Element

184import qualified GHCJS.DOM.Element as Element

@@ -294,21 +290,12 @@ localRunner (HydrationRunnerT m) s parent = do

294runHydrationRunnerT

290runHydrationRunnerT

295 :: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))

291 :: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))

296 => HydrationRunnerT t m a -> Maybe Node -> Node -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a

292 => HydrationRunnerT t m a -> Maybe Node -> Node -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a

297−runHydrationRunnerT m = runHydrationRunnerTWithFailure m (pure ())

298−

299−{-# INLINABLE runHydrationRunnerTWithFailure #-}

300−runHydrationRunnerTWithFailure

301− :: (MonadRef m, Ref m ~ IORef, Monad m, PerformEvent t m, MonadFix m, MonadReflexCreateTrigger t m, MonadJSM m, MonadJSM (Performable m))

302− => HydrationRunnerT t m a -> IO () -> Maybe Node -> Node -> Chan [DSum (EventTriggerRef t) TriggerInvocation] -> m a

303−runHydrationRunnerTWithFailure (HydrationRunnerT m) onFailure s parent events = flip runDomRenderHookT events $ flip runReaderT parent $ do

293+runHydrationRunnerT (HydrationRunnerT m) s parent events = flip runDomRenderHookT events $ flip runReaderT parent $ do

304 (a, s') <- runStateT m (HydrationState s False)

294 (a, s') <- runStateT m (HydrationState s False)

305 traverse_ removeSubsequentNodes $ _hydrationState_previousNode s'

295 traverse_ removeSubsequentNodes $ _hydrationState_previousNode s'

306 when (_hydrationState_failed s') $ liftIO $ putStrLn "reflex-dom warning: hydration failed: the DOM was not as expected at switchover time. This may be due to invalid HTML which the browser has altered upon parsing, some external JS altering the DOM, or the page being served from an outdated cache."

296 when (_hydrationState_failed s') $ liftIO $ putStrLn "reflex-dom warning: hydration failed: the DOM was not as expected at switchover time. This may be due to invalid HTML which the browser has altered upon parsing, some external JS altering the DOM, or the page being served from an outdated cache."

307− when (_hydrationState_failed s') $ liftIO onFailure

308 pure a

297 pure a

309

298

310−

311−

312instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationRunnerT t m) where

299instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (HydrationRunnerT t m) where

313 {-# INLINABLE newEventWithTrigger #-}

300 {-# INLINABLE newEventWithTrigger #-}

314 newEventWithTrigger = lift . newEventWithTrigger

301 newEventWithTrigger = lift . newEventWithTrigger

@@ -332,7 +319,7 @@ instance (Reflex t, MonadFix m) => DomRenderHook t (HydrationRunnerT t m) where

332-- done *before* the switchover to immediate mode - this is most likely some

319-- done *before* the switchover to immediate mode - this is most likely some

333-- form of 'hold' which we want to remove after hydration is done

320-- form of 'hold' which we want to remove after hydration is done

334{-# INLINABLE addHydrationStepWithSetup #-}

321{-# INLINABLE addHydrationStepWithSetup #-}

335−addHydrationStepWithSetup :: MonadIO m => m a -> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()

322+addHydrationStepWithSetup :: (Adjustable t m, MonadIO m) => m a -> (a -> HydrationRunnerT t m ()) -> HydrationDomBuilderT s t m ()

336addHydrationStepWithSetup setup f = getHydrationMode >>= \case

323addHydrationStepWithSetup setup f = getHydrationMode >>= \case

337 HydrationMode_Immediate -> pure ()

324 HydrationMode_Immediate -> pure ()

338 HydrationMode_Hydrating -> do

325 HydrationMode_Hydrating -> do

@@ -937,26 +924,14 @@ inputElementInternal cfg = getHydrationMode >>= \case

937 doc <- askDocument

924 doc <- askDocument

938 -- Expected initial value from config

925 -- Expected initial value from config

939 let v0 = _inputElementConfig_initialValue cfg

926 let v0 = _inputElementConfig_initialValue cfg

940− c0 = _inputElementConfig_initialChecked cfg

927+ addHydrationStep $ do

941− valuesAtSwitchover = do

942− v <- maybe (pure $ pure v0) (hold v0) (_inputElementConfig_setValue cfg)

943− c <- maybe (pure $ pure c0) (hold c0) (_inputElementConfig_setChecked cfg)

944− pure (v, c)

945− addHydrationStepWithSetup valuesAtSwitchover $ \(switchoverValue', switchoverChecked') -> do

946− switchoverValue <- sample switchoverValue'

947− switchoverChecked <- sample switchoverChecked'

948 domElement <- liftIO $ readIORef domElementRef

928 domElement <- liftIO $ readIORef domElementRef

949 let domInputElement = uncheckedCastTo DOM.HTMLInputElement domElement

929 let domInputElement = uncheckedCastTo DOM.HTMLInputElement domElement

950 getValue = Input.getValue domInputElement

930 getValue = Input.getValue domInputElement

951− -- When the value has been updated by setValue before switchover, we must

931+ -- The browser might have messed with the value, or the user could have

952− -- send an update here to remain in sync. This is because the later

932+ -- altered it before activation, so we set it if it isn't what we expect

953− -- requestDomAction based on the setValue event will not capture events

933+ liftJSM getValue >>= \v0' -> do

954− -- happening before postBuild, because this code runs after switchover.

955− when (v0 /= switchoverValue) $ liftIO $ triggerChangeBySetValue switchoverValue

956− -- The user could have altered the value before switchover. This must be

957− -- triggered after the setValue one in order for the events to be in the

958− -- correct order.

959− liftJSM getValue >>= \realValue -> when (realValue /= switchoverValue) $ liftIO $ triggerChangeByUI realValue

934+ when (v0' /= v0) $ liftIO $ triggerChangeByUI v0'

960 -- Watch for user interaction and trigger event accordingly

935 -- Watch for user interaction and trigger event accordingly

961 requestDomAction_ $ (liftJSM getValue >>= liftIO . triggerChangeByUI) <$ Reflex.select (_element_events e) (WrapArg Input)

936 requestDomAction_ $ (liftJSM getValue >>= liftIO . triggerChangeByUI) <$ Reflex.select (_element_events e) (WrapArg Input)

962 for_ (_inputElementConfig_setValue cfg) $ \eSetValue ->

937 for_ (_inputElementConfig_setValue cfg) $ \eSetValue ->

@@ -970,17 +945,7 @@ inputElementInternal cfg = getHydrationMode >>= \case

970 ]

945 ]

971 liftIO . triggerFocusChange =<< Node.isSameNode (toNode domElement) . fmap toNode =<< Document.getActiveElement doc

946 liftIO . triggerFocusChange =<< Node.isSameNode (toNode domElement) . fmap toNode =<< Document.getActiveElement doc

972 requestDomAction_ $ liftIO . triggerFocusChange <$> focusChange'

947 requestDomAction_ $ liftIO . triggerFocusChange <$> focusChange'

973− -- When the checked state has been updated by setChecked before

948+ Input.setChecked domInputElement $ _inputElementConfig_initialChecked cfg

974− -- switchover, we must send an update here to remain in sync. This is

975− -- because the later requestDomAction based on the setChecked event will not

976− -- capture events happening before postBuild, because this code runs after

977− -- switchover.

978− when (c0 /= switchoverChecked) $ liftIO $ triggerCheckedChangedBySetChecked switchoverChecked

979− -- The user could have clicked the checkbox before switchover, we only

980− -- detect cases where they flipped the state. This must be triggered after

981− -- the setValue one in order for the events to be in the correct order.

982− liftJSM (Input.getChecked domInputElement) >>= \realChecked -> when (realChecked /= switchoverChecked) $

983− liftIO $ triggerCheckedChangedByUI realChecked

984 _ <- liftJSM $ domInputElement `on` Events.click $ do

949 _ <- liftJSM $ domInputElement `on` Events.click $ do

985 liftIO . triggerCheckedChangedByUI =<< Input.getChecked domInputElement

950 liftIO . triggerCheckedChangedByUI =<< Input.getChecked domInputElement

986 for_ (_inputElementConfig_setChecked cfg) $ \eNewchecked ->

951 for_ (_inputElementConfig_setChecked cfg) $ \eNewchecked ->

@@ -993,7 +958,7 @@ inputElementInternal cfg = getHydrationMode >>= \case

993 let getMyFiles xs = fmap catMaybes . mapM (FileList.item xs) . flip take [0..] . fromIntegral =<< FileList.getLength xs

958 let getMyFiles xs = fmap catMaybes . mapM (FileList.item xs) . flip take [0..] . fromIntegral =<< FileList.getLength xs

994 liftIO . triggerFileChange =<< maybe (return []) getMyFiles mfiles

959 liftIO . triggerFileChange =<< maybe (return []) getMyFiles mfiles

995 return ()

960 return ()

996− checked' <- holdDyn c0 $ leftmost

961+ checked' <- holdDyn (_inputElementConfig_initialChecked cfg) $ leftmost

997 [ checkedChangedBySetChecked

962 [ checkedChangedBySetChecked

998 , checkedChangedByUI

963 , checkedChangedByUI

999 ]

964 ]

@@ -1065,21 +1030,14 @@ textAreaElementInternal cfg = getHydrationMode >>= \case

1065 doc <- askDocument

1030 doc <- askDocument

1066 -- Expected initial value from config

1031 -- Expected initial value from config

1067 let v0 = _textAreaElementConfig_initialValue cfg

1032 let v0 = _textAreaElementConfig_initialValue cfg

1068− valueAtSwitchover = maybe (pure $ pure v0) (hold v0) (_textAreaElementConfig_setValue cfg)

1033+ addHydrationStep $ do

1069− addHydrationStepWithSetup valueAtSwitchover $ \switchoverValue' -> do

1070− switchoverValue <- sample switchoverValue'

1071 domElement <- liftIO $ readIORef domElementRef

1034 domElement <- liftIO $ readIORef domElementRef

1072 let domTextAreaElement = uncheckedCastTo DOM.HTMLTextAreaElement domElement

1035 let domTextAreaElement = uncheckedCastTo DOM.HTMLTextAreaElement domElement

1073 getValue = TextArea.getValue domTextAreaElement

1036 getValue = TextArea.getValue domTextAreaElement

1074− -- When the value has been updated by setValue before switchover, we must

1037+ -- The browser might have messed with the value, or the user could have

1075− -- send an update here to remain in sync. This is because the later

1038+ -- altered it before activation, so we set it if it isn't what we expect

1076− -- requestDomAction based on the setValue event will not capture events

1039+ liftJSM getValue >>= \v0' -> do

1077− -- happening before postBuild, because this code runs after switchover.

1078− when (v0 /= switchoverValue) $ liftIO $ triggerChangeBySetValue switchoverValue

1079− -- The user could have altered the value before switchover. This must be

1080− -- triggered after the setValue one in order for the events to be in the

1081− -- correct order.

1082− liftJSM getValue >>= \realValue -> when (realValue /= switchoverValue) $ liftIO $ triggerChangeByUI realValue

1040+ when (v0' /= v0) $ liftIO $ triggerChangeByUI v0'

1083 -- Watch for user interaction and trigger event accordingly

1041 -- Watch for user interaction and trigger event accordingly

1084 requestDomAction_ $ (liftJSM getValue >>= liftIO . triggerChangeByUI) <$ Reflex.select (_element_events e) (WrapArg Input)

1042 requestDomAction_ $ (liftJSM getValue >>= liftIO . triggerChangeByUI) <$ Reflex.select (_element_events e) (WrapArg Input)

1085 for_ (_textAreaElementConfig_setValue cfg) $ \eSetValue ->

1043 for_ (_textAreaElementConfig_setValue cfg) $ \eSetValue ->

@@ -1672,7 +1630,7 @@ instance (Adjustable t m, MonadJSM m, MonadHold t m, MonadFix m, PrimMonad m, Ra

1672

1630

1673{-# INLINABLE traverseDMapWithKeyWithAdjust' #-}

1631{-# INLINABLE traverseDMapWithKeyWithAdjust' #-}

1674traverseDMapWithKeyWithAdjust'

1632traverseDMapWithKeyWithAdjust'

1675− :: forall s t m (k :: * -> *) v v'. (Adjustable t m, MonadHold t m, MonadFix m, MonadJSM m, PrimMonad m, GCompare k, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)

1633+ :: forall s t m (k :: * -> *) v v'. (Adjustable t m, MonadHold t m, MonadFix m, MonadJSM m, PrimMonad m, DMap.GCompare k, RawDocument (DomBuilderSpace (HydrationDomBuilderT s t m)) ~ Document)

1676 => (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))

1634 => (forall a. k a -> v a -> HydrationDomBuilderT s t m (v' a))

1677 -> DMap k v

1635 -> DMap k v

1678 -> Event t (PatchDMap k v)

1636 -> Event t (PatchDMap k v)

@@ -1792,7 +1750,7 @@ hoistTraverseWithKeyWithAdjust

1792 ::

1750 ::

1793 ( Adjustable t m

1751 ( Adjustable t m

1794 , MonadHold t m

1752 , MonadHold t m

1795− , GCompare k

1753+ , DMap.GCompare k

1796 , MonadIO m

1754 , MonadIO m

1797 , MonadJSM m

1755 , MonadJSM m

1798 , PrimMonad m

1756 , PrimMonad m

@@ -1876,14 +1834,14 @@ hoistTraverseWithKeyWithAdjust base mapPatch updateChildUnreadiness applyDomUpda

1876 getHydrationMode >>= \case

1834 getHydrationMode >>= \case

1877 HydrationMode_Hydrating -> addHydrationStepWithSetup (holdIncremental children0 children') $ \children -> do

1835 HydrationMode_Hydrating -> addHydrationStepWithSetup (holdIncremental children0 children') $ \children -> do

1878 dm :: DMap k (Compose (TraverseChild t m (Some k)) v') <- sample $ currentIncremental children

1836 dm :: DMap k (Compose (TraverseChild t m (Some k)) v') <- sample $ currentIncremental children

1879− phs <- sequenceA $ weakenDMapWith (either _traverseChildHydration_delayed (pure . _traverseChildImmediate_placeholder) . _traverseChild_mode . getCompose) dm

1837+ phs <- traverse id $ weakenDMapWith (either _traverseChildHydration_delayed (pure . _traverseChildImmediate_placeholder) . _traverseChild_mode . getCompose) dm

1880 liftIO $ writeIORef placeholders $! phs

1838 liftIO $ writeIORef placeholders $! phs

1881 insertAfterPreviousNode lastPlaceholder

1839 insertAfterPreviousNode lastPlaceholder

1882 HydrationMode_Immediate -> do

1840 HydrationMode_Immediate -> do

1883 let activate i = do

1841 let activate i = do

1884 append $ toNode $ _traverseChildImmediate_fragment i

1842 append $ toNode $ _traverseChildImmediate_fragment i

1885 pure $ _traverseChildImmediate_placeholder i

1843 pure $ _traverseChildImmediate_placeholder i

1886− phs <- sequenceA $ weakenDMapWith (either (error "impossible") activate . _traverseChild_mode . getCompose) children0

1844+ phs <- traverse id $ weakenDMapWith (either (error "impossible") activate . _traverseChild_mode . getCompose) children0

1887 liftIO $ writeIORef placeholders $! phs

1845 liftIO $ writeIORef placeholders $! phs

1888 append $ toNode lastPlaceholder

1846 append $ toNode lastPlaceholder

1889 requestDomAction_ $ ffor children' $ \p -> do

1847 requestDomAction_ $ ffor children' $ \p -> do

@@ -2297,7 +2255,7 @@ defaultDomEventHandler e evt = fmap (Just . EventResult) $ case evt of

2297 Beforecopy -> return ()

2255 Beforecopy -> return ()

2298 Copy -> return ()

2256 Copy -> return ()

2299 Beforepaste -> return ()

2257 Beforepaste -> return ()

2300− Paste -> getPasteData

2258+ Paste -> return ()

2301 Reset -> return ()

2259 Reset -> return ()

2302 Search -> return ()

2260 Search -> return ()

2303 Selectstart -> return ()

2261 Selectstart -> return ()

@@ -2347,7 +2305,7 @@ defaultDomWindowEventHandler w evt = fmap (Just . EventResult) $ case evt of

2347 Beforecopy -> return ()

2305 Beforecopy -> return ()

2348 Copy -> return ()

2306 Copy -> return ()

2349 Beforepaste -> return ()

2307 Beforepaste -> return ()

2350− Paste -> getPasteData

2308+ Paste -> return ()

2351 Reset -> return ()

2309 Reset -> return ()

2352 Search -> return ()

2310 Search -> return ()

2353 Selectstart -> return ()

2311 Selectstart -> return ()

@@ -2624,15 +2582,6 @@ getMouseEventCoords = do

2624 e <- event

2582 e <- event

2625 bisequence (getClientX e, getClientY e)

2583 bisequence (getClientX e, getClientY e)

2626

2584

2627−{-# INLINABLE getPasteData #-}

2628−getPasteData :: EventM e ClipboardEvent (Maybe Text)

2629−getPasteData = do

2630− e <- event

2631− mdt <- ClipboardEvent.getClipboardData e

2632− case mdt of

2633− Nothing -> return Nothing

2634− Just dt -> Just <$> DataTransfer.getData dt ("text" :: Text)

2635−

2636{-# INLINABLE getTouchEvent #-}

2585{-# INLINABLE getTouchEvent #-}

2637getTouchEvent :: EventM e TouchEvent TouchEventResult

2586getTouchEvent :: EventM e TouchEvent TouchEventResult

2638getTouchEvent = do

2587getTouchEvent = do

reflex-dom-core/src/Reflex/Dom/Builder/Static.hs+10−35

@@ -37,7 +37,6 @@ import Data.IntMap (IntMap)

37import qualified Data.IntMap as IntMap

38import qualified Data.Map as Map

39import Data.Map.Misc (applyMap)

40−import Data.Maybe (fromMaybe)

41import Data.Monoid ((<>))

40import Data.Monoid ((<>))

42import qualified Data.Set as Set

41import qualified Data.Set as Set

43import Data.Text (Text)

42import Data.Text (Text)

@@ -274,7 +273,7 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh

274 --TODO: Do not escape quotation marks; see https://stackoverflow.com/questions/25612166/what-characters-must-be-escaped-in-html-5

273 --TODO: Do not escape quotation marks; see https://stackoverflow.com/questions/25612166/what-characters-must-be-escaped-in-html-5

275 shouldEscape <- asks _staticDomBuilderEnv_shouldEscape

274 shouldEscape <- asks _staticDomBuilderEnv_shouldEscape

276 let escape = if shouldEscape then fromHtmlEscapedText else byteString . encodeUtf8

275 let escape = if shouldEscape then fromHtmlEscapedText else byteString . encodeUtf8

277− (modify . (:)) . (\c -> "") =<< case mSetContents of

276+ modify . (:) =<< (\c -> "") <$> case mSetContents of

278 Nothing -> return (pure (escape initialContents))

277 Nothing -> return (pure (escape initialContents))

279 Just setContents -> hold (escape initialContents) $ fmapCheap escape setContents --Only because it doesn't get optimized when profiling is on

278 Just setContents -> hold (escape initialContents) $ fmapCheap escape setContents --Only because it doesn't get optimized when profiling is on

280 return $ CommentNode ()

279 return $ CommentNode ()

@@ -312,32 +311,13 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh

312 return (e, result)

311 return (e, result)

313 {-# INLINABLE inputElement #-}

312 {-# INLINABLE inputElement #-}

314 inputElement cfg = do

313 inputElement cfg = do

315− -- Tweak the config to update the "value" and "checked" attributes appropriately.

316− -- TODO: warn upon overwriting values.

317− let setInitialValue = Map.insert "value" (_inputElementConfig_initialValue cfg)

318− setUpdatedValue updatedAttrs = case _inputElementConfig_setValue cfg of

319− Nothing -> updatedAttrs

320− Just e -> (Map.singleton "value" . Just <$> e) <> updatedAttrs

321− setInitialChecked = case _inputElementConfig_initialChecked cfg of

322− True -> Map.insert "checked" "checked"

323− False -> id

324− setUpdatedChecked updatedAttrs = case _inputElementConfig_setChecked cfg of

325− Nothing -> updatedAttrs

326− Just e -> (Map.singleton "checked" (Just "checked") <$ e) <> updatedAttrs

327− adjustedConfig = _inputElementConfig_elementConfig cfg

328− & elementConfig_initialAttributes %~ setInitialValue . setInitialChecked

329− & elementConfig_modifyAttributes %~ setUpdatedValue . setUpdatedChecked

330− (e, _result) <- element "input" adjustedConfig $ return ()

314+ (e, _result) <- element "input" (cfg ^. inputElementConfig_elementConfig) $ return ()

331− v <- case _inputElementConfig_setValue cfg of

332− Nothing -> pure $ constDyn (cfg ^. inputElementConfig_initialValue)

315+ let v0 = constDyn $ cfg ^. inputElementConfig_initialValue

333− Just ev -> holdDyn (cfg ^. inputElementConfig_initialValue) ev

316+ let c0 = constDyn $ cfg ^. inputElementConfig_initialChecked

334− c <- case _inputElementConfig_setChecked cfg of

335− Nothing -> pure $ constDyn $ _inputElementConfig_initialChecked cfg

336− Just ev -> holdDyn (_inputElementConfig_initialChecked cfg) ev

337 let hasFocus = constDyn False -- TODO should this be coming from initialAtttributes

317 let hasFocus = constDyn False -- TODO should this be coming from initialAtttributes

338 return $ InputElement

318 return $ InputElement

339− { _inputElement_value = v

319+ { _inputElement_value = v0

340− , _inputElement_checked = c

320+ , _inputElement_checked = c0

341 , _inputElement_checkedChange = never

321 , _inputElement_checkedChange = never

342 , _inputElement_input = never

322 , _inputElement_input = never

343 , _inputElement_hasFocus = hasFocus

323 , _inputElement_hasFocus = hasFocus

@@ -347,17 +327,12 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh

347 }

327 }

348 {-# INLINABLE textAreaElement #-}

328 {-# INLINABLE textAreaElement #-}

349 textAreaElement cfg = do

329 textAreaElement cfg = do

330+ --TODO: Support setValue event

350− (e, _domElement) <- element "textarea" (_textAreaElementConfig_elementConfig cfg) $ do

331+ (e, _domElement) <- element "textarea" (cfg ^. textAreaElementConfig_elementConfig) $ return ()

351− -- Set the initial value

352− void $ textNode $ def

353− & textNodeConfig_initialContents .~ _textAreaElementConfig_initialValue cfg

354− & textNodeConfig_setContents .~ fromMaybe never (_textAreaElementConfig_setValue cfg)

355− v <- case _textAreaElementConfig_setValue cfg of

356− Nothing -> pure $ constDyn (cfg ^. textAreaElementConfig_initialValue)

357− Just ev -> holdDyn (cfg ^. textAreaElementConfig_initialValue) ev

332+ let v0 = constDyn $ cfg ^. textAreaElementConfig_initialValue

358 let hasFocus = constDyn False -- TODO should this be coming from initialAtttributes

333 let hasFocus = constDyn False -- TODO should this be coming from initialAtttributes

359 return $ TextAreaElement

334 return $ TextAreaElement

360− { _textAreaElement_value = v

335+ { _textAreaElement_value = v0

361 , _textAreaElement_input = never

336 , _textAreaElement_input = never

362 , _textAreaElement_hasFocus = hasFocus

337 , _textAreaElement_hasFocus = hasFocus

363 , _textAreaElement_element = e

338 , _textAreaElement_element = e

reflex-dom-core/src/Reflex/Dom/Main.hs+7−37

@@ -5,6 +5,7 @@

5{-# LANGUAGE GADTs #-}

6{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE NoMonomorphismRestriction #-}

8+{-# LANGUAGE PatternSynonyms #-}

8{-# LANGUAGE RankNTypes #-}

9{-# LANGUAGE RankNTypes #-}

9{-# LANGUAGE RecursiveDo #-}

10{-# LANGUAGE RecursiveDo #-}

10{-# LANGUAGE ScopedTypeVariables #-}

11{-# LANGUAGE ScopedTypeVariables #-}

@@ -72,14 +73,8 @@ mainHydrationWidgetWithSwitchoverAction = mainHydrationWidgetWithSwitchoverActio

72{-# INLINABLE mainHydrationWidgetWithSwitchoverAction' #-}

73{-# INLINABLE mainHydrationWidgetWithSwitchoverAction' #-}

73-- | Warning: `mainHydrationWidgetWithSwitchoverAction'` is provided only as performance tweak. It is expected to disappear in future releases.

74-- | Warning: `mainHydrationWidgetWithSwitchoverAction'` is provided only as performance tweak. It is expected to disappear in future releases.

74mainHydrationWidgetWithSwitchoverAction' :: JSM () -> HydrationWidget () () -> HydrationWidget () () -> JSM ()

75mainHydrationWidgetWithSwitchoverAction' :: JSM () -> HydrationWidget () () -> HydrationWidget () () -> JSM ()

75−mainHydrationWidgetWithSwitchoverAction' = mainHydrationWidgetWithSwitchoverActionWithFailure' (pure ())

76+mainHydrationWidgetWithSwitchoverAction' switchoverAction head' body = do

76−

77−

78−{-# INLINABLE mainHydrationWidgetWithSwitchoverActionWithFailure' #-}

79−-- | Warning: `mainHydrationWidgetWithSwitchoverActionWithFaiilure'` is provided only as performance tweak. It is expected to disappear in future releases.

80−mainHydrationWidgetWithSwitchoverActionWithFailure' :: IO () -> JSM () -> HydrationWidget () () -> HydrationWidget () () -> JSM ()

81−mainHydrationWidgetWithSwitchoverActionWithFailure' onFailure switchoverAction head' body = do

82− runHydrationWidgetWithHeadAndBodyWithFailure onFailure switchoverAction $ \appendHead appendBody -> do

77+ runHydrationWidgetWithHeadAndBody switchoverAction $ \appendHead appendBody -> do

83 appendHead head'

78 appendHead head'

84 appendBody body

79 appendBody body

@@ -94,21 +89,7 @@ attachHydrationWidget

94 -> PerformEventT DomTimeline DomHost (a, IORef (Maybe (EventTrigger DomTimeline ())))

89 -> PerformEventT DomTimeline DomHost (a, IORef (Maybe (EventTrigger DomTimeline ())))

95 )

90 )

96 -> IO (a, FireCommand DomTimeline DomHost)

91 -> IO (a, FireCommand DomTimeline DomHost)

97−attachHydrationWidget = attachHydrationWidgetWithFailure (pure ())

98−

99−{-# INLINABLE attachHydrationWidgetWithFailure #-}

100−attachHydrationWidgetWithFailure

101− :: IO ()

102− -> JSM ()

103− -> JSContextSingleton ()

104− -> ( Event DomTimeline ()

105− -> IORef HydrationMode

106− -> Maybe (IORef [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])

107− -> EventChannel

108− -> PerformEventT DomTimeline DomHost (a, IORef (Maybe (EventTrigger DomTimeline ())))

109− )

110− -> IO (a, FireCommand DomTimeline DomHost)

111−attachHydrationWidgetWithFailure onFailure switchoverAction jsSing w = do

92+attachHydrationWidget switchoverAction jsSing w = do

112 hydrationMode <- liftIO $ newIORef HydrationMode_Hydrating

93 hydrationMode <- liftIO $ newIORef HydrationMode_Hydrating

113 rootNodesRef <- liftIO $ newIORef []

94 rootNodesRef <- liftIO $ newIORef []

114 events <- newChan

95 events <- newChan

@@ -124,7 +105,7 @@ attachHydrationWidgetWithFailure onFailure switchoverAction jsSing w = do

124 rootNodes <- liftIO $ readIORef rootNodesRef

105 rootNodes <- liftIO $ readIORef rootNodesRef

125 let delayedAction = do

106 let delayedAction = do

126 for_ (reverse rootNodes) $ \(rootNode, runner) -> do

107 for_ (reverse rootNodes) $ \(rootNode, runner) -> do

127− let hydrate = runHydrationRunnerTWithFailure runner onFailure Nothing rootNode events

108+ let hydrate = runHydrationRunnerT runner Nothing rootNode events

128 void $ runWithJSContextSingleton (runPostBuildT hydrate never) jsSing

109 void $ runWithJSContextSingleton (runPostBuildT hydrate never) jsSing

129 liftIO $ writeIORef hydrationMode HydrationMode_Immediate

110 liftIO $ writeIORef hydrationMode HydrationMode_Immediate

130 runWithJSContextSingleton (DOM.liftJSM switchoverAction) jsSing

111 runWithJSContextSingleton (DOM.liftJSM switchoverAction) jsSing

@@ -145,22 +126,11 @@ runHydrationWidgetWithHeadAndBody

145 -> FloatingWidget () ()

126 -> FloatingWidget () ()

146 )

127 )

147 -> JSM ()

128 -> JSM ()

148−runHydrationWidgetWithHeadAndBody = runHydrationWidgetWithHeadAndBodyWithFailure (pure ())

149−

150−{-# INLINABLE runHydrationWidgetWithHeadAndBodyWithFailure #-}

151−runHydrationWidgetWithHeadAndBodyWithFailure

152− :: IO ()

153− -> JSM ()

154− -> ( (forall c. HydrationWidget () c -> FloatingWidget () c) -- "Append to head" --TODO: test invoking this more than once

155− -> (forall c. HydrationWidget () c -> FloatingWidget () c) -- "Append to body" --TODO: test invoking this more than once

156− -> FloatingWidget () ()

157− )

158− -> JSM ()

159−runHydrationWidgetWithHeadAndBodyWithFailure onFailure switchoverAction app = withJSContextSingletonMono $ \jsSing -> do

129+runHydrationWidgetWithHeadAndBody switchoverAction app = withJSContextSingletonMono $ \jsSing -> do

160 globalDoc <- currentDocumentUnchecked

130 globalDoc <- currentDocumentUnchecked

161 headElement <- getHeadUnchecked globalDoc

131 headElement <- getHeadUnchecked globalDoc

162 bodyElement <- getBodyUnchecked globalDoc

132 bodyElement <- getBodyUnchecked globalDoc

163− (events, fc) <- liftIO . attachHydrationWidgetWithFailure onFailure switchoverAction jsSing $ \switchover hydrationMode hydrationResult events -> do

133+ (events, fc) <- liftIO . attachHydrationWidget switchoverAction jsSing $ \switchover hydrationMode hydrationResult events -> do

164 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef

134 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef

165 let hydrateDom :: DOM.Node -> HydrationWidget () c -> FloatingWidget () c

135 let hydrateDom :: DOM.Node -> HydrationWidget () c -> FloatingWidget () c

166 hydrateDom n w = do

136 hydrateDom n w = do

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

@@ -24,7 +24,7 @@ module Reflex.Dom.Prerender

25import Control.Monad.Primitive (PrimMonad(..))

26import Control.Monad.Reader

27−import Control.Monad.Ref (MonadRef(..), MonadAtomicRef(..))

27+import Control.Monad.Ref (MonadRef(..))

28import Data.IORef (IORef, newIORef)

29import Data.Semigroup (Semigroup)

30import Data.Text (Text)

@@ -165,8 +165,6 @@ instance Monad m => MonadRef (UnrunnableT js t m) where

165 newRef _ = unrunnable

166 readRef _ = unrunnable

167 writeRef _ _ = unrunnable

168−instance Monad m => MonadAtomicRef (UnrunnableT js t m) where

169− atomicModifyRef _ _ = unrunnable

170instance Monad m => HasDocument (UnrunnableT js t m) where

168instance Monad m => HasDocument (UnrunnableT js t m) where

171 askDocument = unrunnable

169 askDocument = unrunnable

172instance Monad m => HasJSContext (UnrunnableT js t m) where

170instance Monad m => HasJSContext (UnrunnableT js t m) where

@@ -205,13 +203,12 @@ instance Monad m => MonadReflexCreateTrigger t (UnrunnableT js t m) where

205 newFanEventWithTrigger _ = unrunnable

203 newFanEventWithTrigger _ = unrunnable

206instance Monad m => MonadFix (UnrunnableT js t m) where

204instance Monad m => MonadFix (UnrunnableT js t m) where

207 mfix _ = unrunnable

205 mfix _ = unrunnable

208−instance (Monad m, MonadHold t m) => MonadHold t (UnrunnableT js t m) where

206+instance Monad m => MonadHold t (UnrunnableT js t m) where

209 hold _ _ = unrunnable

207 hold _ _ = unrunnable

210 holdDyn _ _ = unrunnable

208 holdDyn _ _ = unrunnable

211 holdIncremental _ _ = unrunnable

209 holdIncremental _ _ = unrunnable

212 buildDynamic _ _ = unrunnable

210 buildDynamic _ _ = unrunnable

213 headE _ = unrunnable

211 headE _ = unrunnable

214− now = unrunnable

215instance Monad m => MonadSample t (UnrunnableT js t m) where

212instance Monad m => MonadSample t (UnrunnableT js t m) where

216 sample _ = unrunnable

213 sample _ = unrunnable

217instance Monad m => MonadIO (UnrunnableT js t m) where

214instance Monad m => MonadIO (UnrunnableT js t m) where

@@ -229,7 +226,7 @@ instance (Reflex t, Monad m) => DomRenderHook t (UnrunnableT js t m) where

229 withRenderHook _ _ = unrunnable

226 withRenderHook _ _ = unrunnable

230 requestDomAction _ = unrunnable

227 requestDomAction _ = unrunnable

231 requestDomAction_ _ = unrunnable

228 requestDomAction_ _ = unrunnable

232−instance (Reflex t, Monad m, MonadHold t m) => Prerender JS' t (UnrunnableT js t m) where

229+instance (Reflex t, Monad m) => Prerender JS' t (UnrunnableT js t m) where

233 type Client (UnrunnableT js t m) = UnrunnableT js t m

230 type Client (UnrunnableT js t m) = UnrunnableT js t m

234 prerender _ _ = unrunnable

231 prerender _ _ = unrunnable

235

232

reflex-dom-core/src/Reflex/Dom/Widget/Input.hs+4−4

@@ -437,12 +437,9 @@ dropdown k0 options (DropdownConfig setK attrs) = do

437 let xs = fmap (\(ix, (k, v)) -> ((ix, k), ((ix, k), v))) $ zip [0::Int ..] $ Map.toList os

438 in (Map.fromList $ map snd xs, Bimap.fromList $ map fst xs)

439 modifyAttrs <- dynamicAttributesToModifyAttributes attrs

440− postBuild <- getPostBuild

441− let setSelection = attachPromptlyDynWithMaybe (flip Bimap.lookupR) ixKeys $

442− leftmost [setK, k0 <$ postBuild]

443 let cfg = def

440 let cfg = def

444 & selectElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs

441 & selectElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs

445− & selectElementConfig_setValue .~ fmap (T.pack . show) setSelection

442+ & selectElementConfig_setValue .~ fmap (T.pack . show) (attachPromptlyDynWithMaybe (flip Bimap.lookupR) ixKeys setK)

446 (eRaw, _) <- selectElement cfg $ listWithKey indexedOptions $ \(ix, k) v -> do

443 (eRaw, _) <- selectElement cfg $ listWithKey indexedOptions $ \(ix, k) v -> do

447 let optionAttrs = fmap (\dk -> "value" =: T.pack (show ix) <> if dk == k then "selected" =: "selected" else mempty) defaultKey

444 let optionAttrs = fmap (\dk -> "value" =: T.pack (show ix) <> if dk == k then "selected" =: "selected" else mempty) defaultKey

448 elDynAttr "option" optionAttrs $ dynText v

445 elDynAttr "option" optionAttrs $ dynText v

@@ -629,6 +626,9 @@ instance HasAttributes (FileInputConfig t) where

629 type Attrs (FileInputConfig t) = Dynamic t (Map Text Text)

626 type Attrs (FileInputConfig t) = Dynamic t (Map Text Text)

630 attributes = fileInputConfig_attributes

627 attributes = fileInputConfig_attributes

631

628

629+class HasSetValue a where

630+ type SetValue a :: *

631+ setValue :: Lens' a (SetValue a)

632

633instance HasSetValue (TextAreaConfig t) where

634 type SetValue (TextAreaConfig t) = Event t Text

reflex-dom-core/src/Reflex/Dom/Widget/Lazy.hs+1−1

@@ -117,7 +117,7 @@ virtualList heightPx rowPx maxIndex i0 setI keyToIndex items0 itemsUpdate itemBu

117 "overflow" =: "hidden" <>

118 "position" =: "relative"

119 mkRow k = toStyleAttr $ "height" =: (T.pack (show rowPx) <> "px") <>

120− "top" =: (<> "px") (T.pack $ show $ keyToIndex k * rowPx) <>

120+ "top" =: ((<>"px") $ T.pack $ show $ keyToIndex k * rowPx) <>

121 "position" =: "absolute" <>

122 "width" =: "100%"

123 findWindow sizeIncrement windowSize startingPosition =

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

@@ -37,19 +37,19 @@ import qualified GHCJS.DOM.Types as DOM

37-- This function can cause strange scrollbars to appear in some circumstances.

38-- These can be hidden with pseudo selectors, for example, in webkit browsers:

39-- .wrapper *::-webkit-scrollbar { width: 0px; background: transparent; }

40−resizeDetector :: (MonadJSM m, DomBuilder t m, PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, DomBuilderSpace m ~ GhcjsDomSpace, MonadJSM (Performable m), MonadFix m) => m a -> m (Event t (Maybe Double, Maybe Double), a)

40+resizeDetector :: (MonadJSM m, DomBuilder t m, PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, DomBuilderSpace m ~ GhcjsDomSpace, MonadJSM (Performable m), MonadFix m) => m a -> m (Event t (), a)

41resizeDetector = resizeDetectorWithStyle ""

43resizeDetectorWithStyle :: (MonadJSM m, DomBuilder t m, PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, DomBuilderSpace m ~ GhcjsDomSpace, MonadJSM (Performable m), MonadFix m)

44 => Text -- ^ A css style string. Warning: It should not contain the "position" style attribute.

45 -> m a -- ^ The embedded widget

46− -> m (Event t (Maybe Double, Maybe Double), a) -- ^ An 'Event' that fires on resize, and the result of the embedded widget

46+ -> m (Event t (), a) -- ^ An 'Event' that fires on resize, and the result of the embedded widget

47resizeDetectorWithStyle styleString = resizeDetectorWithAttrs ("style" =: styleString)

49resizeDetectorWithAttrs :: (MonadJSM m, DomBuilder t m, PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadHold t m, DomBuilderSpace m ~ GhcjsDomSpace, MonadJSM (Performable m), MonadFix m)

50 => Map Text Text -- ^ A map of attributes. Warning: It should not modify the "position" style attribute.

51 -> m a -- ^ The embedded widget

52− -> m (Event t (Maybe Double, Maybe Double), a) -- ^ An 'Event' that fires on resize, and the result of the embedded widget

52+ -> m (Event t (), a) -- ^ An 'Event' that fires on resize, and the result of the embedded widget

53resizeDetectorWithAttrs attrs w = do

54 let childStyle = "position: absolute; left: 0; top: 0;"

55 containerAttrs = "style" =: "position: absolute; left: 0; top: 0; right: 0; bottom: 0; overflow: scroll; z-index: -1; visibility: hidden;"

@@ -91,4 +91,4 @@ resizeDetectorWithAttrs attrs w = do

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

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

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

94− return (updated dimensions, w')

94+ return (fmapMaybe void resize, w')

reflex-dom-core/test/gc.hs+1−1

@@ -47,7 +47,7 @@ failureLimit = 0

48main :: IO ()

49main = do

50− handle (\(_ :: IOError) -> return ()) $ unshareNetwork -- If we run into an exception with sandboxing, just don't bother

50+ handle (\(_ :: IOError) -> return ()) $ unshareNetork -- If we run into an exception with sandboxing, just don't bother

51 withSandboxedChromeFlags True $ \chromeFlags -> do

52 mainThread <- myThreadId

53 browserProcess <- spawnCommand $ mconcat

reflex-dom-core/test/hlint.hs+1−1

@@ -1,4 +1,4 @@

1−import Language.Haskell.HLint (hlint)

1+import Language.Haskell.HLint3 (hlint)

2import System.Exit (exitFailure, exitSuccess)

4main :: IO ()

reflex-dom-core/test/hydration.hs+41−385

@@ -20,14 +20,6 @@

21{-# OPTIONS_GHC -fno-warn-orphans #-}

23−-- Notice to those working on this test suite:

24−-- It doesn't appear to be possible to use --match to run a particular test, in

25−-- this situation the test may hang before reaching our code. This seems to

26−-- happen when the test is not the first test in the block. As a workaround, you

27−-- can just comment out the other tests. Also, using `xit` will cause the same

28−-- issue. `xit` tests must be the last tests in the session, or the session will

29−-- hang in the following test.

30−

31import Prelude hiding (fail)

23import Prelude hiding (fail)

32import Control.Concurrent

24import Control.Concurrent

33import qualified Control.Concurrent.Async as Async

25import qualified Control.Concurrent.Async as Async

@@ -47,7 +39,6 @@ import Data.Functor.Misc

47import Data.GADT.Compare.TH

39import Data.GADT.Compare.TH

48import Data.GADT.Show.TH

40import Data.GADT.Show.TH

49import Data.IORef (IORef)

41import Data.IORef (IORef)

50−import Data.List (sort)

51import Data.Maybe

42import Data.Maybe

52import Data.Proxy

43import Data.Proxy

53import Data.Text (Text)

44import Data.Text (Text)

@@ -58,7 +49,6 @@ import Network.Socket

58import Network.Wai

49import Network.Wai

59import Network.WebSockets

50import Network.WebSockets

60import Reflex.Dom.Core

51import Reflex.Dom.Core

61−import Reflex.Dom.Widget.Input (dropdown)

62import Reflex.Patch.DMapWithMove

52import Reflex.Patch.DMapWithMove

63import System.Directory

53import System.Directory

64import System.Environment

54import System.Environment

@@ -67,7 +57,7 @@ import System.IO.Silently

67import System.IO.Temp

57import System.IO.Temp

68import System.Process

58import System.Process

69import System.Which (staticWhich)

59import System.Which (staticWhich)

70−import qualified Test.HUnit as HUnit

60+import qualified Test.HUnit as HUnit (assertEqual, assertFailure)

71import qualified Test.Hspec as H

61import qualified Test.Hspec as H

72import qualified Test.Hspec.Core.Spec as H

62import qualified Test.Hspec.Core.Spec as H

73import Test.Hspec (xit)

63import Test.Hspec (xit)

@@ -107,14 +97,11 @@ instance MonadRef WD where

107 writeRef r = WD . writeRef r

97 writeRef r = WD . writeRef r

108

109assertEqual :: (MonadIO m, Eq a, Show a) => String -> a -> a -> m ()

99assertEqual :: (MonadIO m, Eq a, Show a) => String -> a -> a -> m ()

110−assertEqual msg a b = liftIO $ HUnit.assertEqual msg a b

100+assertEqual a b = liftIO . HUnit.assertEqual a b

111

101

112assertFailure :: MonadIO m => String -> m ()

102assertFailure :: MonadIO m => String -> m ()

113assertFailure = liftIO . HUnit.assertFailure

103assertFailure = liftIO . HUnit.assertFailure

114

104

115−assertBool :: (MonadIO m) => String -> Bool -> m ()

116−assertBool msg bool = liftIO $ HUnit.assertBool msg bool

117−

118chromeConfig :: Text -> [Text] -> WD.WDConfig

105chromeConfig :: Text -> [Text] -> WD.WDConfig

119chromeConfig fp flags = WD.useBrowser (WD.chrome { WD.chromeBinary = Just $ T.unpack fp, WD.chromeOptions = T.unpack <$> flags }) WD.defaultConfig

106chromeConfig fp flags = WD.useBrowser (WD.chrome { WD.chromeBinary = Just $ T.unpack fp, WD.chromeOptions = T.unpack <$> flags }) WD.defaultConfig

120

107

@@ -145,7 +132,7 @@ deriving instance MonadFail WD

145

132

146main :: IO ()

133main :: IO ()

147main = do

134main = do

148− unshareNetwork

135+ unshareNetork

149 isHeadless <- (== Nothing) <$> lookupEnv "NO_HEADLESS"

136 isHeadless <- (== Nothing) <$> lookupEnv "NO_HEADLESS"

150 withSandboxedChromeFlags isHeadless $ \chromeFlags -> do

137 withSandboxedChromeFlags isHeadless $ \chromeFlags -> do

151 withSeleniumServer $ \selenium -> do

138 withSeleniumServer $ \selenium -> do

@@ -154,13 +141,13 @@ main = do

154 withDebugging <- isNothing <$> lookupEnv "NO_DEBUG"

141 withDebugging <- isNothing <$> lookupEnv "NO_DEBUG"

155 let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium }

142 let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium }

156 chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags

143 chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags

157− hspec (tests withDebugging wdConfig [(chromeCaps', "chrome")] selenium) `finally` _selenium_stopServer selenium

144+ hspec (tests withDebugging wdConfig [chromeCaps'] selenium) `finally` _selenium_stopServer selenium

158

145

159−tests :: Bool -> WD.WDConfig -> [(Capabilities, String)] -> Selenium -> Spec

146+tests :: Bool -> WD.WDConfig -> [Capabilities] -> Selenium -> Spec

160tests withDebugging wdConfig caps _selenium = do

147tests withDebugging wdConfig caps _selenium = do

161 let putStrLnDebug :: MonadIO m => Text -> m ()

148 let putStrLnDebug :: MonadIO m => Text -> m ()

162 putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m

149 putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m

163− session' t = sessionWith wdConfig t . using caps

150+ session' = sessionWith wdConfig "" . using (map (,"") caps)

164 runWD m = runWDOptions (WdOptions False) $ do

151 runWD m = runWDOptions (WdOptions False) $ do

165 putStrLnDebug "before"

152 putStrLnDebug "before"

166 r <- m

153 r <- m

@@ -169,10 +156,10 @@ tests withDebugging wdConfig caps _selenium = do

169 testWidgetStatic :: WD b -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b

156 testWidgetStatic :: WD b -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b

170 testWidgetStatic = testWidgetStaticDebug withDebugging

157 testWidgetStatic = testWidgetStaticDebug withDebugging

171 testWidget :: WD () -> WD b -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b

158 testWidget :: WD () -> WD b -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b

172− testWidget = testWidgetDebug True withDebugging

159+ testWidget = testWidgetDebug withDebugging

173 testWidget' :: WD a -> (a -> WD b) -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b

160 testWidget' :: WD a -> (a -> WD b) -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> WD b

174− testWidget' = testWidgetDebug' True withDebugging

161+ testWidget' = testWidgetDebug' withDebugging

175− session' "text" $ do

162+ describe "text" $ session' $ do

176 it "works" $ runWD $ do

163 it "works" $ runWD $ do

177 testWidgetStatic (checkBodyText "hello world") $ do

164 testWidgetStatic (checkBodyText "hello world") $ do

178 text "hello world"

165 text "hello world"

@@ -233,7 +220,7 @@ tests withDebugging wdConfig caps _selenium = do

233 click <- button ""

220 click <- button ""

234 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ click

221 void $ textNode $ TextNodeConfig "initial" $ Just $ "after" <$ click

235

222

236− session' "element" $ do

223+ describe "element" $ session' $ do

237 it "works with domEvent Click" $ runWD $ do

224 it "works with domEvent Click" $ runWD $ do

238 clickedRef <- liftIO $ newRef False

225 clickedRef <- liftIO $ newRef False

239 testWidget' (findElemWithRetry $ WD.ByTag "div") WD.click $ do

226 testWidget' (findElemWithRetry $ WD.ByTag "div") WD.click $ do

@@ -297,78 +284,21 @@ tests withDebugging wdConfig caps _selenium = do

297 let click = domEvent Click e

284 let click = domEvent Click e

298 return ()

285 return ()

299

286

300− session' "inputElement" $ do

287+ describe "inputElement" $ do

301− describe "static renderer" $ do

288+ describe "hydration" $ session' $ do

302− it "sets value attribute" $ runWD $ do

303− let checkStatic = do

304− e <- findElemWithRetry $ WD.ByTag "input"

305− WD.attr e "value" `shouldBeWithRetryM` Just "test"

306− pure e

307− checkHydrated e = do

308− WD.attr e "value" `shouldBeWithRetryM` Just "test"

309− testWidget' checkStatic checkHydrated $ void $ inputElement $ def

310− & inputElementConfig_initialValue .~ "test"

311− it "updates value attribute at postBuild" $ runWD $ do

312− let checkStatic = do

313− e <- findElemWithRetry $ WD.ByTag "input"

314− WD.attr e "value" `shouldBeWithRetryM` Just "test-updated"

315− pure e

316− checkHydrated e = do

317− WD.attr e "value" `shouldBeWithRetryM` Just "test-updated"

318− testWidget' checkStatic checkHydrated $ do

319− pb <- getPostBuild

320− _ <- inputElement $ def

321− & inputElementConfig_initialValue .~ "test"

322− & inputElementConfig_setValue .~ ("test-updated" <$ pb)

323− pure ()

324− it "sets checked attr appropriately" $ runWD $ do

325− setCheckedChan <- liftIO newChan

326− let checkStatic = do

327− e <- findElemWithRetry $ WD.ByTag "input"

328− WD.attr e "checked" `shouldBeWithRetryM` Just "true"

329− pure e

330− checkValue e = do

331− WD.attr e "checked" `shouldBeWithRetryM` Just "true"

332− WD.moveToCenter e

333− WD.click e -- Click to uncheck

334− WD.attr e "checked" `shouldBeWithRetryM` Nothing

335− liftIO $ writeChan setCheckedChan True -- Programatically check the checkbox

336− WD.attr e "checked" `shouldBeWithRetryM` Just "true"

337− testWidget' checkStatic checkValue $ do

338− setChecked <- triggerEventWithChan setCheckedChan

339− _ <- inputElement $ def

340− & initialAttributes .~ "type" =: "checkbox"

341− & inputElementConfig_initialChecked .~ True

342− & inputElementConfig_setChecked .~ setChecked

343− pure ()

344− it "sets checked attr appropriately at postbuild" $ runWD $ do

345− let checkStatic = do

346− e <- findElemWithRetry $ WD.ByTag "input"

347− WD.attr e "checked" `shouldBeWithRetryM` Just "true"

348− pure e

349− checkValue e = do

350− WD.attr e "checked" `shouldBeWithRetryM` Just "true"

351− testWidget' checkStatic checkValue $ do

352− pb <- getPostBuild

353− _ <- inputElement $ def

354− & initialAttributes .~ "type" =: "checkbox"

355− & inputElementConfig_initialChecked .~ False

356− & inputElementConfig_setChecked .~ (True <$ pb)

357− pure ()

358− describe "hydration" $ do

359 it "doesn't wipe user input when switching over" $ runWD $ do

289 it "doesn't wipe user input when switching over" $ runWD $ do

360− inputRef <- newRef ("hello " :: Text)

290+ inputRef <- newRef ("" :: Text)

361 testWidget'

291 testWidget'

362 (do

292 (do

363 e <- findElemWithRetry $ WD.ByTag "input"

293 e <- findElemWithRetry $ WD.ByTag "input"

364− WD.sendKeys "world" e

294+ WD.sendKeys "hello world" e

365 pure e)

295 pure e)

366 (\e -> do

296 (\e -> do

367 WD.attr e "value" `shouldBeWithRetryM` Just "hello world"

297 WD.attr e "value" `shouldBeWithRetryM` Just "hello world"

368 WD.click =<< findElemWithRetry (WD.ByTag "button")

298 WD.click =<< findElemWithRetry (WD.ByTag "button")

369 readRef inputRef `shouldBeWithRetryM` "hello world"

299 readRef inputRef `shouldBeWithRetryM` "hello world"

370 ) $ do

300 ) $ do

371− e <- inputElement $ def & inputElementConfig_initialValue .~ "hello "

301+ e <- inputElement def

372 click <- button "save"

302 click <- button "save"

373 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click

303 performEvent_ $ liftIO . writeRef inputRef <$> tag (current (value e)) click

374 it "captures user input after switchover" $ runWD $ do

304 it "captures user input after switchover" $ runWD $ do

@@ -425,49 +355,24 @@ tests withDebugging wdConfig caps _selenium = do

425 checkedByUIRef <- newRef False

355 checkedByUIRef <- newRef False

426 checkedRef <- newRef False

356 checkedRef <- newRef False

427 setCheckedChan <- liftIO newChan

357 setCheckedChan <- liftIO newChan

428− let checkStatic = do

429− e <- findElemWithRetry $ WD.ByTag "input"

430− WD.attr e "checked" `shouldBeWithRetryM` Nothing

431− pure e

432− checkValue e = do

358+ let checkValue = do

433 readRef checkedByUIRef `shouldBeWithRetryM` False

359 readRef checkedByUIRef `shouldBeWithRetryM` False

434 readRef checkedRef `shouldBeWithRetryM` False

360 readRef checkedRef `shouldBeWithRetryM` False

435− WD.attr e "checked" `shouldBeWithRetryM` Nothing

361+ e <- findElemWithRetry $ WD.ByTag "input"

436 WD.moveToCenter e

362 WD.moveToCenter e

437 WD.click e

363 WD.click e

438 readRef checkedByUIRef `shouldBeWithRetryM` True

364 readRef checkedByUIRef `shouldBeWithRetryM` True

439 readRef checkedRef `shouldBeWithRetryM` True

365 readRef checkedRef `shouldBeWithRetryM` True

440− WD.attr e "checked" `shouldBeWithRetryM` Just "true"

441 liftIO $ writeChan setCheckedChan False

366 liftIO $ writeChan setCheckedChan False

442 readRef checkedByUIRef `shouldBeWithRetryM` True

367 readRef checkedByUIRef `shouldBeWithRetryM` True

443 readRef checkedRef `shouldBeWithRetryM` False

368 readRef checkedRef `shouldBeWithRetryM` False

444− WD.attr e "checked" `shouldBeWithRetryM` Nothing

445− testWidget' checkStatic checkValue $ do

369+ testWidget (pure ()) checkValue $ do

446 setChecked <- triggerEventWithChan setCheckedChan

370 setChecked <- triggerEventWithChan setCheckedChan

447 e <- inputElement $ def

371 e <- inputElement $ def

448 & initialAttributes .~ "type" =: "checkbox"

372 & initialAttributes .~ "type" =: "checkbox"

449 & inputElementConfig_setChecked .~ setChecked

373 & inputElementConfig_setChecked .~ setChecked

450 performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e

374 performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e

451 performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)

375 performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)

452− it "respects user updates to checked which happen before hydration" $ runWD $ do

453− checkedByUIRef <- newRef False

454− checkedRef <- newRef False

455− let checkStatic = do

456− e <- findElemWithRetry $ WD.ByTag "input"

457− WD.attr e "checked" `shouldBeWithRetryM` Nothing

458− WD.moveToCenter e

459− WD.click e

460− WD.attr e "checked" `shouldBeWithRetryM` Just "true"

461− pure e

462− checkValue e = do

463− WD.attr e "checked" `shouldBeWithRetryM` Just "true"

464− readRef checkedByUIRef `shouldBeWithRetryM` True

465− readRef checkedRef `shouldBeWithRetryM` True

466− testWidget' checkStatic checkValue $ do

467− e <- inputElement $ def

468− & initialAttributes .~ "type" =: "checkbox"

469− performEvent_ $ liftIO . writeRef checkedByUIRef <$> _inputElement_checkedChange e

470− performEvent_ $ liftIO . writeRef checkedRef <$> updated (_inputElement_checked e)

471 it "captures file uploads" $ runWD $ do

376 it "captures file uploads" $ runWD $ do

472 filesRef :: IORef [Text] <- newRef []

377 filesRef :: IORef [Text] <- newRef []

473 let uploadFile = do

378 let uploadFile = do

@@ -483,117 +388,8 @@ tests withDebugging wdConfig caps _selenium = do

483 prerender_ (pure ()) $ performEvent_ $ ffor (tag (current (_inputElement_files e)) click) $ \fs -> do

388 prerender_ (pure ()) $ performEvent_ $ ffor (tag (current (_inputElement_files e)) click) $ \fs -> do

484 names <- liftJSM $ traverse File.getName fs

389 names <- liftJSM $ traverse File.getName fs

485 liftIO $ writeRef filesRef names

390 liftIO $ writeRef filesRef names

486− it "fires _input event if the user altered the value before hydration" $ runWD $ do

391+

487− input <- newRef ("" :: Text)

488− update <- newRef ("" :: Text)

489− let checkStatic = do

490− e <- findElemWithRetry $ WD.ByTag "input"

491− WD.attr e "value" `shouldBeWithRetryM` Just ""

492− WD.sendKeys "test" e

493− WD.attr e "value" `shouldBeWithRetryM` Just "test"

494− pure e

495− checkHydrated e = do

496− WD.attr e "value" `shouldBeWithRetryM` Just "test"

497− readRef input `shouldBeWithRetryM` "test"

498− readRef update `shouldBeWithRetryM` "test"

499− testWidget' checkStatic checkHydrated $ do

500− e <- inputElement def

501− performEvent_ $ liftIO . writeRef input <$> _inputElement_input e

502− performEvent_ $ liftIO . writeRef update <$> updated (_inputElement_value e)

503− it "does not fire _input event when the value is updated at postBuild" $ runWD $ do

504− input <- newRef (Nothing :: Maybe Text)

505− let checkStatic = do

506− e <- findElemWithRetry $ WD.ByTag "input"

507− WD.attr e "value" `shouldBeWithRetryM` Just "pb"

508− pure e

509− checkHydrated e = do

510− WD.attr e "value" `shouldBeWithRetryM` Just "pb"

511− readRef input `shouldBeWithRetryM` Nothing

512− testWidget' checkStatic checkHydrated $ do

513− pb <- getPostBuild

514− e <- inputElement $ def & inputElementConfig_setValue .~ ("pb" <$ pb)

515− performEvent_ $ liftIO . writeRef input . Just <$> _inputElement_input e

516− it "SSR produces correct DOM based on inputElement values when setValue happens at postBuild" $ runWD $ do

517− let checkBoth = do

518− input <- findElemWithRetry $ WD.ByTag "input"

519− WD.attr input "value" `shouldBeWithRetryM` Just "pb"

520− p <- findElemWithRetry (WD.ByTag "p")

521− shouldContainText "pb" p

522− testWidget checkBoth checkBoth $ do

523− pb <- getPostBuild

524− e <- inputElement $ def & inputElementConfig_setValue .~ ("pb" <$ pb)

525− el "p" $ dynText $ _inputElement_value e

526− it "does not fail when both setValue AND user updated value happen before switchover" $ runWD $ do

527− let checkStatic = do

528− input <- findElemWithRetry $ WD.ByTag "input"

529− h2_value <- findElemWithRetry (WD.ByTag "h2")

530− h3_input <- findElemWithRetry (WD.ByTag "h3")

531− WD.attr input "value" `shouldBeWithRetryM` Just "pb"

532− shouldContainText "pb" h2_value

533− shouldContainText "" h3_input

534− WD.sendKeys "abc" input

535− WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"

536− shouldContainText "pb" h2_value

537− shouldContainText "" h3_input

538− pure (input, h2_value, h3_input)

539− checkHydrated (input, h2_value, h3_input) = do

540− WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"

541− shouldContainText "pbabc" h3_input

542− shouldContainText "pbabc pb" h2_value

543− pure ()

544− testWidget' checkStatic checkHydrated $ do

545− pb <- getPostBuild

546− e <- inputElement $ def & inputElementConfig_setValue .~ ("pb" <$ pb)

547− el "h1" $ dynText $ _inputElement_value e

548− el "h2" $ dynText . fmap T.unwords <=< foldDyn (:) [] $ updated $ _inputElement_value e

549− el "h3" $ dynText . fmap T.unwords <=< foldDyn (:) [] $ _inputElement_input e

550− it "value is correct when both setValue AND user updated value happen before switchover" $ runWD $ do

551− let checkStatic = do

552− input <- findElemWithRetry $ WD.ByTag "input"

553− p <- findElemWithRetry (WD.ByTag "p")

554− WD.attr input "value" `shouldBeWithRetryM` Just "pb"

555− shouldContainText "pb" p

556− WD.sendKeys "abc" input

557− WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"

558− shouldContainText "pb" p -- It won't be updated yet

559− pure (input, p)

560− checkHydrated (input, p) = do

561− WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"

562− shouldContainText "pbabc" p

563− pure ()

564− testWidget' checkStatic checkHydrated $ do

565− pb <- getPostBuild

566− e <- inputElement $ def & inputElementConfig_setValue .~ ("pb" <$ pb)

567− el "p" $ dynText $ _inputElement_value e

568− it "input event and (updated value) fire correctly when both setValue AND user updated value happen before switchover" $ runWD $ do

569− valRef <- newRef ([] :: [Text])

570− inputRef <- newRef ([] :: [Text])

571− let consRef ref a = liftIO $ atomicModifyRef ref $ \as -> (a:as, ())

572− checkStatic = do

573− input <- findElemWithRetry $ WD.ByTag "input"

574− p <- findElemWithRetry (WD.ByTag "p")

575− WD.attr input "value" `shouldBeWithRetryM` Just "pb"

576− shouldContainText "pb" p

577− WD.sendKeys "abc" input

578− WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"

579− shouldContainText "pb" p -- It won't be updated yet

580− readRef inputRef `shouldBeWithRetryM` [] -- Should never fire input ref during SSR

581− readRef valRef `shouldBeWithRetryM` ["pb"]

582− pure (input, p)

583− checkHydrated (input, p) = do

584− readRef inputRef `shouldBeWithRetryM` ["pbabc"]

585− readRef valRef `shouldBeWithRetryM` ["pbabc", "pb"]

586− WD.attr input "value" `shouldBeWithRetryM` Just "pbabc"

587− shouldContainText "pbabc" p

588− pure ()

589− testWidget' checkStatic checkHydrated $ do

590− liftIO $ writeRef valRef []

591− pb <- getPostBuild

592− e <- inputElement $ def & inputElementConfig_setValue .~ ("pb" <$ pb)

593− el "p" $ dynText $ _inputElement_value e

594− performEvent_ $ consRef valRef <$> updated (_inputElement_value e)

595− performEvent_ $ consRef inputRef <$> _inputElement_input e

596− describe "hydration/immediate" $ do

392+ describe "hydration/immediate" $ session' $ do

597 it "captures user input after switchover" $ runWD $ do

393 it "captures user input after switchover" $ runWD $ do

598 inputRef :: IORef Text <- newRef ""

394 inputRef :: IORef Text <- newRef ""

599 let checkValue = do

395 let checkValue = do

@@ -673,31 +469,8 @@ tests withDebugging wdConfig caps _selenium = do

673 names <- liftJSM $ traverse File.getName fs

469 names <- liftJSM $ traverse File.getName fs

674 liftIO $ writeRef filesRef names

470 liftIO $ writeRef filesRef names

675

471

676− session' "textAreaElement" $ do

472+ describe "textAreaElement" $ do

677− describe "static renderer" $ do

678− it "sets value attribute" $ runWD $ do

679− let checkStatic = do

680− e <- findElemWithRetry $ WD.ByTag "textarea"

681− WD.attr e "value" `shouldBeWithRetryM` Just "test"

682− pure e

683− checkHydrated e = do

684− WD.attr e "value" `shouldBeWithRetryM` Just "test"

685− testWidget' checkStatic checkHydrated $ void $ textAreaElement $ def

686− & textAreaElementConfig_initialValue .~ "test"

687− it "updates value attribute at postBuild" $ runWD $ do

688− let checkStatic = do

689− e <- findElemWithRetry $ WD.ByTag "textarea"

690− WD.attr e "value" `shouldBeWithRetryM` Just "test-updated"

691− pure e

692− checkHydrated e = do

693− WD.attr e "value" `shouldBeWithRetryM` Just "test-updated"

694− testWidget' checkStatic checkHydrated $ do

695− pb <- getPostBuild

696− _ <- textAreaElement $ def

697− & textAreaElementConfig_initialValue .~ "test"

698− & textAreaElementConfig_setValue .~ ("test-updated" <$ pb)

699− pure ()

700− describe "hydration" $ do

473+ describe "hydration" $ session' $ do

701 it "doesn't wipe user input when switching over" $ runWD $ do

474 it "doesn't wipe user input when switching over" $ runWD $ do

702 inputRef <- newRef ("" :: Text)

475 inputRef <- newRef ("" :: Text)

703 testWidget'

476 testWidget'

@@ -763,90 +536,8 @@ tests withDebugging wdConfig caps _selenium = do

763 e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }

536 e <- textAreaElement $ def { _textAreaElementConfig_setValue = Just setValue' }

764 performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e

537 performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e

765 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)

538 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)

766− it "fires _input event if the user altered the value before hydration" $ runWD $ do

767− textarea <- newRef ("" :: Text)

768− update <- newRef ("" :: Text)

769− let checkStatic = do

770− e <- findElemWithRetry $ WD.ByTag "textarea"

771− WD.attr e "value" `shouldBeWithRetryM` Just ""

772− WD.sendKeys "test" e

773− WD.attr e "value" `shouldBeWithRetryM` Just "test"

774− pure e

775− checkHydrated e = do

776− WD.attr e "value" `shouldBeWithRetryM` Just "test"

777− readRef textarea `shouldBeWithRetryM` "test"

778− readRef update `shouldBeWithRetryM` "test"

779− testWidget' checkStatic checkHydrated $ do

780− e <- textAreaElement def

781− performEvent_ $ liftIO . writeRef textarea <$> _textAreaElement_input e

782− performEvent_ $ liftIO . writeRef update <$> updated (_textAreaElement_value e)

783− it "does not fire _input event when the value is updated at postBuild" $ runWD $ do

784− textarea <- newRef (Nothing :: Maybe Text)

785− let checkStatic = do

786− e <- findElemWithRetry $ WD.ByTag "textarea"

787− WD.attr e "value" `shouldBeWithRetryM` Just "pb"

788− pure e

789− checkHydrated e = do

790− WD.attr e "value" `shouldBeWithRetryM` Just "pb"

791− readRef textarea `shouldBeWithRetryM` Nothing

792− testWidget' checkStatic checkHydrated $ do

793− pb <- getPostBuild

794− e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb)

795− performEvent_ $ liftIO . writeRef textarea . Just <$> _textAreaElement_input e

796− it "SSR produces correct DOM based on textAreaElement values when setValue happens at postBuild" $ runWD $ do

797− let checkBoth = do

798− textarea <- findElemWithRetry $ WD.ByTag "textarea"

799− WD.attr textarea "value" `shouldBeWithRetryM` Just "pb"

800− p <- findElemWithRetry (WD.ByTag "p")

801− shouldContainText "pb" p

802− testWidget checkBoth checkBoth $ do

803− pb <- getPostBuild

804− e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb)

805− el "p" $ dynText $ _textAreaElement_value e

806− it "does not fail when both setValue AND user updated value happen before switchover" $ runWD $ do

807− let checkStatic = do

808− textarea <- findElemWithRetry $ WD.ByTag "textarea"

809− h2_value <- findElemWithRetry (WD.ByTag "h2")

810− h3_input <- findElemWithRetry (WD.ByTag "h3")

811− WD.attr textarea "value" `shouldBeWithRetryM` Just "pb"

812− shouldContainText "pb" h2_value

813− shouldContainText "" h3_input

814− WD.sendKeys "abc" textarea

815− WD.attr textarea "value" `shouldBeWithRetryM` Just "pbabc"

816− shouldContainText "pb" h2_value

817− shouldContainText "" h3_input

818− pure (textarea, h2_value, h3_input)

819− checkHydrated (textarea, h2_value, h3_input) = do

820− WD.attr textarea "value" `shouldBeWithRetryM` Just "pbabc"

821− shouldContainText "pbabc" h3_input

822− shouldContainText "pbabc pb" h2_value

823− pure ()

824− testWidget' checkStatic checkHydrated $ do

825− pb <- getPostBuild

826− e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb)

827− el "h1" $ dynText $ _textAreaElement_value e

828− el "h2" $ dynText . fmap T.unwords <=< foldDyn (:) [] $ updated $ _textAreaElement_value e

829− el "h3" $ dynText . fmap T.unwords <=< foldDyn (:) [] $ _textAreaElement_input e

830− it "value is correct when both setValue AND user updated value happen before switchover" $ runWD $ do

831− let checkStatic = do

832− textarea <- findElemWithRetry $ WD.ByTag "textarea"

833− p <- findElemWithRetry (WD.ByTag "p")

834− WD.attr textarea "value" `shouldBeWithRetryM` Just "pb"

835− shouldContainText "pb" p

836− WD.sendKeys "abc" textarea

837− WD.attr textarea "value" `shouldBeWithRetryM` Just "pbabc"

838− shouldContainText "pb" p -- It won't be updated yet

839− pure (textarea, p)

840− checkHydrated (textarea, p) = do

841− WD.attr textarea "value" `shouldBeWithRetryM` Just "pbabc"

842− shouldContainText "pbabc" p

843− pure ()

844− testWidget' checkStatic checkHydrated $ do

845− pb <- getPostBuild

846− e <- textAreaElement $ def & textAreaElementConfig_setValue .~ ("pb" <$ pb)

847− el "p" $ dynText $ _textAreaElement_value e

848

539

849− describe "hydration/immediate" $ do

540+ describe "hydration/immediate" $ session' $ do

850 it "captures user input after switchover" $ runWD $ do

541 it "captures user input after switchover" $ runWD $ do

851 inputRef :: IORef Text <- newRef ""

542 inputRef :: IORef Text <- newRef ""

852 let checkValue = do

543 let checkValue = do

@@ -888,13 +579,13 @@ tests withDebugging wdConfig caps _selenium = do

888 performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e

579 performEvent_ $ liftIO . writeRef valueByUIRef <$> _textAreaElement_input e

889 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)

580 performEvent_ $ liftIO . writeRef valueRef <$> updated (value e)

890

581

891− session' "selectElement" $ do

582+ describe "selectElement" $ do

892 let options :: DomBuilder t m => m ()

583 let options :: DomBuilder t m => m ()

893 options = do

584 options = do

894 elAttr "option" ("value" =: "one" <> "id" =: "one") $ text "one"

585 elAttr "option" ("value" =: "one" <> "id" =: "one") $ text "one"

895 elAttr "option" ("value" =: "two" <> "id" =: "two") $ text "two"

586 elAttr "option" ("value" =: "two" <> "id" =: "two") $ text "two"

896 elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three"

587 elAttr "option" ("value" =: "three" <> "id" =: "three") $ text "three"

897− describe "hydration" $ do

588+ describe "hydration" $ session' $ do

898 it "sets initial value correctly" $ runWD $ do

589 it "sets initial value correctly" $ runWD $ do

899 inputRef <- newRef ("" :: Text)

590 inputRef <- newRef ("" :: Text)

900 let setup = do

591 let setup = do

@@ -968,7 +659,7 @@ tests withDebugging wdConfig caps _selenium = do

968 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e

659 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e

969 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)

660 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)

970

661

971− describe "hydration/immediate" $ do

662+ describe "hydration/immediate" $ session' $ do

972 it "captures user input after switchover" $ runWD $ do

663 it "captures user input after switchover" $ runWD $ do

973 inputRef :: IORef Text <- newRef ""

664 inputRef :: IORef Text <- newRef ""

974 let checkValue = do

665 let checkValue = do

@@ -1014,7 +705,7 @@ tests withDebugging wdConfig caps _selenium = do

1014 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e

705 performEvent_ $ liftIO . writeRef valueByUIRef <$> _selectElement_change e

1015 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)

706 performEvent_ $ liftIO . writeRef valueRef <$> updated (_selectElement_value e)

1016

707

1017− session' "prerender" $ do

708+ describe "prerender" $ session' $ do

1018 it "works in simple case" $ runWD $ do

709 it "works in simple case" $ runWD $ do

1019 testWidget (checkBodyText "One") (checkBodyText "Two") $ do

710 testWidget (checkBodyText "One") (checkBodyText "Two") $ do

1020 prerender_ (text "One") (text "Two")

711 prerender_ (text "One") (text "Two")

@@ -1083,7 +774,7 @@ tests withDebugging wdConfig caps _selenium = do

1083 prerender_ (pure ()) (liftIO $ trigger "Client")

774 prerender_ (pure ()) (liftIO $ trigger "Client")

1084 textNode $ TextNodeConfig "Initial" $ Just e

775 textNode $ TextNodeConfig "Initial" $ Just e

1085

776

1086− session' "namespaces" $ do

777+ describe "namespaces" $ session' $ do

1087 it "dyn can be nested in namespaced widget" $ runWD $ do

778 it "dyn can be nested in namespaced widget" $ runWD $ do

1088 testWidget (pure ()) (checkTextInTag "svg" "one") $ do

779 testWidget (pure ()) (checkTextInTag "svg" "one") $ do

1089 let svgRootCfg = def

780 let svgRootCfg = def

@@ -1092,7 +783,7 @@ tests withDebugging wdConfig caps _selenium = do

1092 void $ element "svg" svgRootCfg $ do

783 void $ element "svg" svgRootCfg $ do

1093 dyn_ $ text "one" <$ pure ()

784 dyn_ $ text "one" <$ pure ()

1094

785

1095− session' "runWithReplace" $ do

786+ describe "runWithReplace" $ session' $ do

1096 it "works" $ runWD $ do

787 it "works" $ runWD $ do

1097 replaceChan :: Chan Text <- liftIO newChan

788 replaceChan :: Chan Text <- liftIO newChan

1098 let setup = findElemWithRetry $ WD.ByTag "div"

789 let setup = findElemWithRetry $ WD.ByTag "div"

@@ -1266,9 +957,7 @@ tests withDebugging wdConfig caps _selenium = do

1266 _ <- runWithReplace (text "inner1" *> comment "replace-end-0") $ text "inner2" <$ replace

957 _ <- runWithReplace (text "inner1" *> comment "replace-end-0") $ text "inner2" <$ replace

1267 text "|after"

958 text "|after"

1268 void $ runWithReplace blank $ el "p" blank <$ replace -- Signal tag for end of test

959 void $ runWithReplace blank $ el "p" blank <$ replace -- Signal tag for end of test

1269− -- TODO This test actually causes a hydration failure, but it wasn't

1270− -- previously detected, so I've marked it pending

1271− xit "ignores missing ending bracketing comments" $ runWD $ do

960+ it "ignores missing ending bracketing comments" $ runWD $ do

1272 replaceChan :: Chan () <- liftIO newChan

961 replaceChan :: Chan () <- liftIO newChan

1273 let

962 let

1274 preSwitchover = do

963 preSwitchover = do

@@ -1290,7 +979,7 @@ tests withDebugging wdConfig caps _selenium = do

1290 _ <- runWithReplace (text "inner1") $ el "p" (text "inner2") <$ replace

979 _ <- runWithReplace (text "inner1") $ el "p" (text "inner2") <$ replace

1291 text "|after"

980 text "|after"

1292

981

1293− session' "traverseDMapWithKeyWithAdjust" $ do

982+ describe "traverseDMapWithKeyWithAdjust" $ session' $ do

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

1295 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do

984 widget k (Identity v) = elAttr "li" ("id" =: textKey k) $ do

1296 elClass "span" "key" $ text $ textKey k

985 elClass "span" "key" $ text $ textKey k

@@ -1393,7 +1082,7 @@ tests withDebugging wdConfig caps _selenium = do

1393 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]

1082 (dmap, _evt) <- traverseDMapWithKeyWithAdjust widget keyMap $ leftmost [postBuildPatch <$ pb, replace]

1394 liftIO $ dmap `H.shouldBe` keyMap

1083 liftIO $ dmap `H.shouldBe` keyMap

1395

1084

1396− session' "traverseIntMapWithKeyWithAdjust" $ do

1085+ describe "traverseIntMapWithKeyWithAdjust" $ session' $ do

1397 let textKeyInt k = "key" <> T.pack (show k)

1086 let textKeyInt k = "key" <> T.pack (show k)

1398 intMap = IntMap.fromList

1087 intMap = IntMap.fromList

1399 [ (1, "one")

1088 [ (1, "one")

@@ -1500,7 +1189,7 @@ tests withDebugging wdConfig caps _selenium = do

1500 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]

1189 (dmap, _evt) <- traverseIntMapWithKeyWithAdjust widget intMap $ leftmost [postBuildPatch <$ pb, replace]

1501 liftIO $ dmap `H.shouldBe` intMap

1190 liftIO $ dmap `H.shouldBe` intMap

1502

1191

1503− session' "traverseDMapWithKeyWithAdjustWithMove" $ do

1192+ describe "traverseDMapWithKeyWithAdjustWithMove" $ session' $ do

1504 let widget :: DomBuilder t m => Key2 a -> Identity a -> m (Identity a)

1193 let widget :: DomBuilder t m => Key2 a -> Identity a -> m (Identity a)

1505 widget k (Identity v) = elAttr "li" ("id" =: textKey2 k) $ do

1194 widget k (Identity v) = elAttr "li" ("id" =: textKey2 k) $ do

1506 elClass "span" "key" $ text $ textKey2 k

1195 elClass "span" "key" $ text $ textKey2 k

@@ -1580,8 +1269,8 @@ tests withDebugging wdConfig caps _selenium = do

1580 (dmap, _evt) <- traverseDMapWithKeyWithAdjustWithMove widget initMap =<< triggerEventWithChan chan

1269 (dmap, _evt) <- traverseDMapWithKeyWithAdjustWithMove widget initMap =<< triggerEventWithChan chan

1581 liftIO $ assertEqual "DMap" initMap dmap

1270 liftIO $ assertEqual "DMap" initMap dmap

1582

1271

1583− session' "hydrating invalid HTML" $ do

1272+ describe "hydrating invalid HTML" $ session' $ do

1584− xit "can hydrate list in paragraph" $ runWD $ do

1273+ it "can hydrate list in paragraph" $ runWD $ do

1585 let preSwitchover = do

1274 let preSwitchover = do

1586 checkBodyText "before\ninner\nafter"

1275 checkBodyText "before\ninner\nafter"

1587 -- Two tags should be present

1276 -- Two tags should be present

@@ -1598,8 +1287,7 @@ tests withDebugging wdConfig caps _selenium = do

1598 shouldContainText "before\ninner\nafter" p1

1287 shouldContainText "before\ninner\nafter" p1

1599 elementShouldBeRemoved ol

1288 elementShouldBeRemoved ol

1600 elementShouldBeRemoved p2

1289 elementShouldBeRemoved p2

1601− -- Don't fail fatally when hydration encounters the invalid DOM

1602− testWidgetDebug' False withDebugging preSwitchover check $ do

1290+ testWidget' preSwitchover check $ do

1603 -- This is deliberately invalid HTML, the browser will interpret it as

1291 -- This is deliberately invalid HTML, the browser will interpret it as

1604 -- before<ol>inner</ol>after

1292 -- before<ol>inner</ol>after

1605 el "p" $ do

1293 el "p" $ do

@@ -1607,29 +1295,6 @@ tests withDebugging wdConfig caps _selenium = do

1607 el "ol" $ text "inner"

1295 el "ol" $ text "inner"

1608 text "after"

1296 text "after"

1609

1297

1610− -- TODO: This test presupposes the exact set of labels that "dropdown" places in the "value" fields to distinguish options.

1611− -- This dependence on internal implementation details is undesirable in a test case, but seems fairly tricky to avoid.

1612− -- It seems expedient for the time being to expect this test case to be updated, should those implementation details ever change.

1613− session' "dropdown" $ do

1614− let doTest expectedOpts (initialValue :: Text) = do

1615− let doCheck = do

1616− es <- findElemsWithRetry $ WD.ByTag "option"

1617− opts <- mapM fetchElement es

1618− assertEqual "missing/extra/incorrect option element(s)" expectedOpts (sort opts)

1619− testWidget doCheck doCheck $ do

1620− void $ dropdown initialValue (constDyn (("aa" :: Text) =: "aaa" <> "bb" =: "bbb")) def

1621− fetchElement e = do

1622− val <- WD.attr e "value"

1623− sel <- WD.attr e "selected"

1624− return (fromMaybe "" val, isJust sel)

1625− -- The "aa" test case is important, but a good test implementation probably needs to avoid selenium, because HTML parsers will insert a "selected" attribute on the first "option" tag if no selected attributes are present; thus as written, this erroneously succeeds on the old implementation (but properly implemented, should fail)

1626− -- Thus, it would appear that we do actually need a HTML5 or maybe XML parser for this test suite.

1627− xit "statically renders initial values (on aa)" $ runWD $ do

1628− doTest [("0",True),("1",False)] "aa"

1629− -- These tests are currently marked "pending" (by using "xit" instead of "it") because this test has a high chance of non-deterministically failing, which is a problem elsewhere in this test suite as well

1630− xit "statically renders initial values (on bb)" $ runWD $ do

1631− doTest [("0",False),("1",True)] "bb"

1632−

1633data Selenium = Selenium

1298data Selenium = Selenium

1634 { _selenium_portNumber :: PortNumber

1299 { _selenium_portNumber :: PortNumber

1635 , _selenium_stopServer :: IO ()

1300 , _selenium_stopServer :: IO ()

@@ -1697,9 +1362,6 @@ checkTextInId i expected = do

1697findElemWithRetry :: Selector -> WD WD.Element

1362findElemWithRetry :: Selector -> WD WD.Element

1698findElemWithRetry = withRetry . WD.findElem

1363findElemWithRetry = withRetry . WD.findElem

1699

1364

1700−findElemsWithRetry :: Selector -> WD [WD.Element]

1701−findElemsWithRetry = withRetry . WD.findElems

1702−

1703getBody :: WD WD.Element

1365getBody :: WD WD.Element

1704getBody = WD.findElem $ WD.ByTag "body"

1366getBody = WD.findElem $ WD.ByTag "body"

1705

1367

@@ -1725,12 +1387,11 @@ testWidgetStaticDebug

1725 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())

1387 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())

1726 -- ^ Widget we are testing

1388 -- ^ Widget we are testing

1727 -> WD b

1389 -> WD b

1728−testWidgetStaticDebug withDebugging w = testWidgetDebug True withDebugging (void w) w

1390+testWidgetStaticDebug withDebugging w = testWidgetDebug withDebugging (void w) w

1729

1391

1730-- | TODO: do something about JSExceptions not causing tests to fail

1392-- | TODO: do something about JSExceptions not causing tests to fail

1731testWidgetDebug

1393testWidgetDebug

1732 :: Bool

1394 :: Bool

1733− -> Bool

1734 -> WD ()

1395 -> WD ()

1735 -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)

1396 -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)

1736 -> WD b

1397 -> WD b

@@ -1738,16 +1399,12 @@ testWidgetDebug

1738 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())

1399 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())

1739 -- ^ Widget we are testing

1400 -- ^ Widget we are testing

1740 -> WD b

1401 -> WD b

1741−testWidgetDebug hardFailure withDebugging beforeJS afterSwitchover =

1402+testWidgetDebug withDebugging beforeJS afterSwitchover =

1742− testWidgetDebug' hardFailure withDebugging beforeJS (const afterSwitchover)

1403+ testWidgetDebug' withDebugging beforeJS (const afterSwitchover)

1743−

1744−data HydrationFailedException = HydrationFailedException deriving Show

1745−instance Exception HydrationFailedException

1746

1404

1747-- | TODO: do something about JSExceptions not causing tests to fail

1405-- | TODO: do something about JSExceptions not causing tests to fail

1748testWidgetDebug'

1406testWidgetDebug'

1749 :: Bool

1407 :: Bool

1750− -> Bool

1751 -> WD a

1408 -> WD a

1752 -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)

1409 -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)

1753 -> (a -> WD b)

1410 -> (a -> WD b)

@@ -1755,7 +1412,7 @@ testWidgetDebug'

1755 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())

1412 -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())

1756 -- ^ Widget we are testing (contents of body)

1413 -- ^ Widget we are testing (contents of body)

1757 -> WD b

1414 -> WD b

1758−testWidgetDebug' hardFailure withDebugging beforeJS afterSwitchover bodyWidget = do

1415+testWidgetDebug' withDebugging beforeJS afterSwitchover bodyWidget = do

1759 let putStrLnDebug :: MonadIO m => Text -> m ()

1416 let putStrLnDebug :: MonadIO m => Text -> m ()

1760 putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m

1417 putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m

1761 staticApp = do

1418 staticApp = do

@@ -1767,7 +1424,6 @@ testWidgetDebug' hardFailure withDebugging beforeJS afterSwitchover bodyWidget =

1767 ((), html) <- liftIO $ renderStatic $ runHydratableT staticApp

1424 ((), html) <- liftIO $ renderStatic $ runHydratableT staticApp

1768 putStrLnDebug "rendered static"

1425 putStrLnDebug "rendered static"

1769 waitBeforeJS <- liftIO newEmptyMVar -- Empty until JS should be run

1426 waitBeforeJS <- liftIO newEmptyMVar -- Empty until JS should be run

1770− onFailure <- if hardFailure then (`throwTo` HydrationFailedException) <$> liftIO myThreadId else pure $ pure ()

1771 waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover

1427 waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover

1772 let entryPoint = do

1428 let entryPoint = do

1773 putStrLnDebug "taking waitBeforeJS"

1429 putStrLnDebug "taking waitBeforeJS"

@@ -1779,7 +1435,7 @@ testWidgetDebug' hardFailure withDebugging beforeJS afterSwitchover bodyWidget =

1779 liftIO $ putMVar waitUntilSwitchover ()

1435 liftIO $ putMVar waitUntilSwitchover ()

1780 putStrLnDebug "put waitUntilSwitchover"

1436 putStrLnDebug "put waitUntilSwitchover"

1781 putStrLnDebug "running mainHydrationWidgetWithSwitchoverAction"

1437 putStrLnDebug "running mainHydrationWidgetWithSwitchoverAction"

1782− mainHydrationWidgetWithSwitchoverActionWithFailure' onFailure switchOverAction blank bodyWidget

1438+ mainHydrationWidgetWithSwitchoverAction switchOverAction blank bodyWidget

1783 putStrLnDebug "syncPoint after mainHydrationWidgetWithSwitchoverAction"

1439 putStrLnDebug "syncPoint after mainHydrationWidgetWithSwitchoverAction"

1784 syncPoint

1440 syncPoint

1785 application <- liftIO $ jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse -> do

1441 application <- liftIO $ jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse -> do

reflex-dom-test-selenium/CHANGELOG.mddeleted−5

@@ -1,5 +0,0 @@

1−# Revision history for reflex-dom-core-selenium

2−

3−## 0.1.0.0 -- YYYY-mm-dd

4−

5−* First version. Released on an unsuspecting world.

reflex-dom-test-selenium/LICENSEdeleted−12

@@ -1,12 +0,0 @@

3−

4−Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

5−

6−1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.

7−

9−

10−3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.

11−

reflex-dom-test-selenium/Setup.hsdeleted−2

@@ -1,2 +0,0 @@

1−import Distribution.Simple

2−main = defaultMain

reflex-dom-test-selenium/add-overrides.nixdeleted−20

@@ -1,20 +0,0 @@

1−{ nixpkgs }: testPackage:

2− nixpkgs.haskell.lib.overrideCabal testPackage

3− (drv: {

4−

5− # The headless browser run as part of the tests will exit without this

6− preBuild = ''

7− export HOME="$PWD"

8− '';

9−

10− testSystemDepends = with nixpkgs; (drv.testSystemDepends or []) ++ [

11− selenium-server-standalone which

12− chromium

13− nixpkgs.iproute

14− ];

15−

16− # The headless browser run as part of gc tests would hang/crash without this

17− preCheck = ''

18− export FONTCONFIG_PATH=${nixpkgs.fontconfig.out}/etc/fonts

19− '';

20− })

reflex-dom-test-selenium/reflex-dom-test-selenium.cabaldeleted−41

@@ -1,41 +0,0 @@

1−cabal-version: 1.24

2−Name: reflex-dom-test-selenium

3−Version: 0.0.0.1

4−Synopsis: Testing framework for selenium tests

5−Description:

6−License: BSD3

7−License-file: LICENSE

8−Author: Ryan Trinkle

9−Maintainer: ryan.trinkle@gmail.com

10−Stability: Experimental

11−Category: FRP, Web, GUI, HTML, Javascript, Reactive, Reactivity, User Interfaces, User-interface

12−Build-type: Simple

13−

14−library

15− hs-source-dirs: src

16− build-depends:

17− async,

18− base >= 4.7 && < 4.15,

19− bytestring == 0.10.*,

20− chrome-test-utils,

21− exceptions,

22− hspec-core,

23− hspec-webdriver >= 1.2.1,

24− http-types,

25− jsaddle >= 0.9.0.0 && < 0.10,

26− jsaddle-warp,

27− network,

28− process,

29− reflex-dom-core,

30− silently,

31− text == 1.2.*,

32− wai,

33− warp,

34− webdriver,

35− websockets

36−

37− exposed-modules:

38− Reflex.Dom.Test.Selenium

39−

40− default-language: Haskell98

41− ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans -fspecialise-aggressively

reflex-dom-test-selenium/src/Reflex/Dom/Test/Selenium.hsdeleted−249

@@ -1,249 +0,0 @@

1−{-# LANGUAGE ConstraintKinds #-}

2−{-# LANGUAGE FlexibleContexts #-}

3−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4−{-# LANGUAGE OverloadedStrings #-}

5−{-# LANGUAGE RankNTypes #-}

6−{-# LANGUAGE ScopedTypeVariables #-}

7−{-# LANGUAGE StandaloneDeriving #-}

8−{-# LANGUAGE TemplateHaskell #-}

9−

10−{-# OPTIONS_GHC -fno-warn-orphans #-}

11−

12−-- | Utilities for testing reflex-dom widgets with Selenium.

13−--

14−-- Any uses of the 'testWidget' functions will start a jsaddle warp server and

15−-- serve the given widget in an otherwise empty page. Webdriver commands can run

16−-- on the statically rendered page, and on the hydrated page.

17−module Reflex.Dom.Test.Selenium

18− ( TestWidget

19− , TestWidgetConfig (..)

20− , testWidget, testWidget', testWidgetStatic, testWidgetHydrated

21− , withSeleniumSpec

22− , embedSpec

23− , SeleniumSetupConfig (..)

24− ) where

25−

26−import Control.Concurrent (threadDelay, newEmptyMVar, takeMVar, putMVar)

27−import Control.Exception (throwIO)

28−import Control.Monad (when)

29−import Control.Monad.Catch (MonadMask, handle)

30−import Control.Monad.Fix (MonadFix)

31−import Control.Monad.IO.Class (MonadIO, liftIO)

32−import Data.Text (Text)

33−import Language.Javascript.JSaddle

34−import Language.Javascript.JSaddle.Warp

35−import Network.HTTP.Types (status200)

36−import Network.Socket (PortNumber)

37−import Network.Wai (responseLBS)

38−import Network.WebSockets (defaultConnectionOptions)

39−import Reflex.Dom.Core

40−import System.IO (stderr)

41−import System.IO.Silently (hSilence)

42−import System.Process (std_in, std_out, std_err, createProcess, proc, StdStream (..), terminateProcess)

43−import Test.Hspec.WebDriver (Spec, SpecWith, WdTestSession, sessionWith, using)

44−import Test.Util.ChromeFlags

45−import Test.Util.UnshareNetwork

46−import Test.WebDriver (WD)

47−

48−import qualified Control.Concurrent.Async as Async

49−import qualified Data.ByteString.Lazy as LBS

50−import qualified Data.Text as T

51−import qualified Data.Text.Encoding as TE

52−import qualified Network.Wai.Handler.Warp as Warp

53−import qualified Test.Hspec.Core.Spec as Hspec

54−import qualified Test.WebDriver as WD

55−import qualified Test.WebDriver.Capabilities as WD

56−

57−deriving instance MonadMask WD

58−

59−data SeleniumSetupConfig = SeleniumSetupConfig

60− { _seleniumSetupConfig_chromiumPath :: FilePath

61− -- ^ Path to the chromium executable

62− , _seleniumSetupConfig_headless :: Bool

63− -- ^ True means that the browser is invoked in headless mode, False means that

64− -- the user can see the interaction happening on the browser (useful for debugging).

65− , _seleniumSetupConfig_seleniumPort :: PortNumber

66− -- ^ The port number used by selenium

67− }

68−

69−-- | Setup a selenium server and use it to run some hspec tests.

70−--

71−-- withSeleniumSpec config $ \runSession -> hspec $ do

72−-- describe "tests using webdriver session" $ runSession $ do

73−-- webdriver tests here

74−withSeleniumSpec :: SeleniumSetupConfig -> ((forall multi. SpecWith (WdTestSession multi) -> Spec) -> IO a) -> IO a

75−withSeleniumSpec config runSpec = do

76− liftIO $ handle (\(_ :: IOError) -> return ()) $ unshareNetork -- If we run into an exception with sandboxing, just don't bother

77− withSandboxedChromeFlags (_seleniumSetupConfig_headless config) $ \chromeFlags -> do

78− withSeleniumServer (_seleniumSetupConfig_seleniumPort config) $ do

79− let browserPath = T.strip $ T.pack $ _seleniumSetupConfig_chromiumPath config

80− when (T.null browserPath) $ fail "No browser found"

81− let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _seleniumSetupConfig_seleniumPort config }

82− chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags

83− runSpec $ sessionWith wdConfig "" . using [(chromeCaps', "chrome")]

84−

85−startSeleniumServer :: PortNumber -> IO (IO ())

86−startSeleniumServer port = do

87− (_,_,_,ph) <- createProcess $ (proc "selenium-server" ["-port", show port])

88− { std_in = NoStream

89− , std_out = NoStream

90− , std_err = NoStream

91− }

92− return $ terminateProcess ph

93−

94−withSeleniumServer :: PortNumber -> IO a -> IO a

95−withSeleniumServer port f = bracket (startSeleniumServer port) id $ \_ -> do

96− threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on

97− f

98−

99−chromeConfig :: Text -> [Text] -> WD.WDConfig

100−chromeConfig fp flags =

101− WD.useBrowser

102− (WD.chrome { WD.chromeBinary = Just $ T.unpack fp, WD.chromeOptions = T.unpack <$> flags })

103− WD.defaultConfig

104−

105−--------------------------------------------------------------------------------

106−-- Function to test widgets

107−--------------------------------------------------------------------------------

108−

109−-- | The environment in which your widgets can be tested

110−type TestWidget js t m =

111− (DomBuilder t m, MonadHold t m, PostBuild t m

112− , Prerender js t m, PerformEvent t m, TriggerEvent t m

113− , MonadFix m, MonadIO (Performable m), MonadIO m)

114−

115−-- | Configuration of individual tests

116−data TestWidgetConfig = TestWidgetConfig

117− { _testWidgetConfig_debug :: Bool

118− -- ^ If this flag is set to True, during the test we will emit debug messages

119− , _testWidgetConfig_headWidget :: (forall m js. TestWidget js (SpiderTimeline Global) m => m ())

120− -- ^ We can add widgets here that will be included in the head of the page

121− -- (useful for example to include external js libraries in the tests)

122− , _testWidgetConfig_jsaddlePort :: PortNumber

123− -- ^ Port used by the jsaddle server

124− }

125−

126−-- | Test a widget by running some webdriver commands before and after

127−-- hydration.

128−testWidget

129− :: TestWidgetConfig

130− -> WD a

131− -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)

132− -> WD b

133− -- ^ Webdriver commands to run after hydration switchover

134− -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())

135− -- ^ Widget we are testing (contents of body)

136− -> WD b

137−testWidget cfg before after widget = testWidget' cfg before (const after) widget

138−

139−-- | Test a widget by running some webdriver commands before hydration (on the

140−-- statically rendered page).

141−testWidgetStatic

142− :: TestWidgetConfig

143− -> WD a

144− -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)

145− -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())

146− -- ^ Widget we are testing (contents of body)

147− -> WD a

148−testWidgetStatic cfg before widget = testWidget' cfg before pure widget

149−

150−-- | Test a widget by running some webdriver commands after hydration.

151−testWidgetHydrated

152− :: TestWidgetConfig

153− -> WD b

154− -- ^ Webdriver commands to run after hydration switchover

155− -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())

156− -- ^ Widget we are testing (contents of body)

157− -> WD b

158−testWidgetHydrated cfg after widget = testWidget' cfg (pure ()) (const after) widget

159−

160−-- | Test a widget by running some webdriver commands before and after

161−-- hydration. Like 'testWidget', but you can use the result of the webdriver

162−-- commands from before hydration in the post hydration test.

163−testWidget'

164− :: TestWidgetConfig

165− -> WD a

166− -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)

167− -> (a -> WD b)

168− -- ^ Webdriver commands to run after hydration switchover

169− -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())

170− -- ^ Widget we are testing (contents of body)

171− -> WD b

172−testWidget' (TestWidgetConfig withDebugging headWidget jsaddlePort) beforeJS afterSwitchover bodyWidget = do

173− let putStrLnDebug :: MonadIO m => Text -> m ()

174− putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m

175− staticApp = do

176− el "head" $ headWidget

177− el "body" $ do

178− bodyWidget

179− el "script" $ text $ TE.decodeUtf8 $ LBS.toStrict $ jsaddleJs False

180− putStrLnDebug "rendering static"

181− ((), html) <- liftIO $ renderStatic $ runHydratableT staticApp

182− putStrLnDebug "rendered static"

183− waitBeforeJS <- liftIO newEmptyMVar -- Empty until JS should be run

184− waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover

185− let entryPoint = do

186− putStrLnDebug "taking waitBeforeJS"

187− liftIO $ takeMVar waitBeforeJS

188− let switchOverAction = do

189− putStrLnDebug "switchover syncPoint"

190− syncPoint

191− putStrLnDebug "putting waitUntilSwitchover"

192− liftIO $ putMVar waitUntilSwitchover ()

193− putStrLnDebug "put waitUntilSwitchover"

194− putStrLnDebug "running mainHydrationWidgetWithSwitchoverAction"

195− mainHydrationWidgetWithSwitchoverAction switchOverAction blank bodyWidget

196− putStrLnDebug "syncPoint after mainHydrationWidgetWithSwitchoverAction"

197− syncPoint

198− application <- liftIO $ jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse -> do

199− putStrLnDebug "sending response"

200− r <- sendResponse $ responseLBS status200 [] $ "<!doctype html>\n" <> LBS.fromStrict html

201− putStrLnDebug "sent response"

202− return r

203− waitJSaddle <- liftIO newEmptyMVar

204− let settings = foldr ($) Warp.defaultSettings

205− [ Warp.setPort $ fromIntegral $ toInteger jsaddlePort

206− , Warp.setBeforeMainLoop $ do

207− putStrLnDebug "putting waitJSaddle"

208− putMVar waitJSaddle ()

209− putStrLnDebug "put waitJSaddle"

210− ]

211− -- hSilence to get rid of ConnectionClosed logs

212− silenceIfNotDebugging = if withDebugging then id else hSilence [stderr]

213− jsaddleWarp = silenceIfNotDebugging $ Warp.runSettings settings application

214− withAsync' jsaddleWarp $ do

215− putStrLnDebug "taking waitJSaddle"

216− liftIO $ takeMVar waitJSaddle

217− putStrLnDebug "opening page"

218− WD.openPage $ "http://localhost:" <> show jsaddlePort

219− putStrLnDebug "running beforeJS"

220− a <- beforeJS

221− putStrLnDebug "putting waitBeforeJS"

222− liftIO $ putMVar waitBeforeJS ()

223− putStrLnDebug "taking waitUntilSwitchover"

224− liftIO $ takeMVar waitUntilSwitchover

225− putStrLnDebug "running afterSwitchover"

226− afterSwitchover a

227−

228−--------------------------------------------------------------------------------

229−-- Utilities

230−--------------------------------------------------------------------------------

231−

232−-- | Embed a different spec type by evaluating it directly.

233−embedSpec :: (Hspec.Example a, MonadIO m) => Hspec.Arg a -> a -> m ()

234−embedSpec arg spec = liftIO $ do

235− Hspec.Result _info status <- Hspec.evaluateExample

236− spec

237− Hspec.defaultParams

238− (\actionWith -> actionWith arg)

239− (\_ -> pure ())

240− case status of

241− Hspec.Success -> pure ()

242− Hspec.Pending _ _ -> pure () -- should not happen

243− failure -> throwIO failure

244−

245−withAsync' :: (MonadIO m, MonadMask m) => IO a -> m b -> m b

246−withAsync' f g = bracket

247− (liftIO $ Async.async f)

248− (liftIO . Async.uninterruptibleCancel)

249− (const g)

reflex-dom/ChangeLog.md+1−17

@@ -1,23 +1,7 @@

1# Revision history for reflex-dom

3−## 0.6.1.0-r1

3+## Unreleased

5−* Loosen reflex-dom-core version bounds

6−

7−## 0.6.1.0

8−

9−* Update for new dependent-map and dependent-sum (after the "some" package split)

10−

11−## 0.6.0.0

12−

13−* ([#379](https://github.com/reflex-frp/reflex-dom/pull/379)) Re-export all modules from `reflex-dom-core`. The newly re-exported modules are:

14− * `Foreign.JavaScript.Utils`

15− * `Reflex.Dom.Builder.Hydratable`

16− * `Reflex.Dom.Modals.Class`

17− * `Reflex.Dom.Prerender`

18− * `Reflex.Dom.Time`

19− * `Reflex.Dom.WebSocket.Query`

20− * `Reflex.Dom.Xhr.FormData`

21* ([#366](https://github.com/reflex-frp/reflex-dom/pull/366)) Bump bounds for `reflex` to include 0.7.

5* ([#366](https://github.com/reflex-frp/reflex-dom/pull/366)) Bump bounds for `reflex` to include 0.7.

23## 0.5.3

7## 0.5.3

reflex-dom/LICENSE+1−1

@@ -1,4 +1,4 @@

4Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:

reflex-dom/benchmark.hs+1−2

@@ -15,9 +15,8 @@ import qualified Data.Text as T

15import Reflex.Dom

16import System.Random

17import qualified Data.Map as Map

18−import Data.Dependent.Map (DMap (..))

18+import Data.Dependent.Map (DMap (..), DSum (..))

19import qualified Data.Dependent.Map as DMap

20−import Data.Dependent.Sum (DSum (..))

21import Data.Functor.Misc

20import Data.Functor.Misc

22import Data.Functor.Identity

21import Data.Functor.Identity

23import Data.Functor.Compose

22import Data.Functor.Compose

reflex-dom/reflex-dom.cabal+22−68

@@ -1,20 +1,10 @@

1−cabal-version: 1.24

2Name: reflex-dom

1Name: reflex-dom

3−Version: 0.6.1.0

2+Version: 0.5.3

4Synopsis: Functional Reactive Web Apps with Reflex

3Synopsis: Functional Reactive Web Apps with Reflex

5Description:

4Description:

6− Web applications without callbacks or side-effects.

5+ Reflex-DOM is a Functional Reactive web framework based on the Reflex FRP engine.

7− Reflex-DOM brings the power of functional reactive programming (FRP) to the web.

8− Build HTML and other Document Object Model (DOM) data with a pure functional interface.

9 .

6 .

10− Reflex-DOM is a Functional Reactive web framework based on the Reflex FRP engine: <https://reflex-frp.org/>.

11− .

12− The @reflex-dom@ package is a small wrapper around the @reflex-dom-core@ package. It pulls in the

13− correct set of dependencies for each target platform (GHCJS, WebKitGTK, WASM, mobile, etc.).

14− Libraries should depend on @reflex-dom-core@ and executables will usually depend on @reflex-dom@.

15− All of @reflex-dom-core@'s modules are re-exported by @reflex-dom@.

16− .

17− For Hackage documentation, please see: <https://hackage.haskell.org/package/reflex-dom-core>.

7+ For hackage documentation, please see: <https://hackage.haskell.org/package/reflex-dom-core>.

18License: BSD3

8License: BSD3

19License-file: LICENSE

9License-file: LICENSE

20Author: Ryan Trinkle

10Author: Ryan Trinkle

@@ -22,6 +12,7 @@ Maintainer: ryan.trinkle@gmail.com

22Stability: Experimental

12Stability: Experimental

23Category: FRP, Web, GUI, HTML, Javascript, Reactive, Reactivity, User Interfaces, User-interface

13Category: FRP, Web, GUI, HTML, Javascript, Reactive, Reactivity, User Interfaces, User-interface

24Build-type: Simple

14Build-type: Simple

15+cabal-version: >=1.24

25extra-source-files:

16extra-source-files:

26 java/org/reflexfrp/reflexdom/MainWidget.java

17 java/org/reflexfrp/reflexdom/MainWidget.java

27 ChangeLog.md

18 ChangeLog.md

@@ -50,67 +41,60 @@ flag build-examples

50 default: False

41 default: False

51 manual: True

42 manual: True

53−flag wasm32

54− description: Build for wasm32 architecture

55− default: False

56− manual: True

57−

58library

44library

59 hs-source-dirs: src

45 hs-source-dirs: src

60 if os(android)

46 if os(android)

61 hs-source-dirs: src-android

47 hs-source-dirs: src-android

62 other-modules: Reflex.Dom.Android.MainWidget

48 other-modules: Reflex.Dom.Android.MainWidget

63 build-depends:

49 build-depends:

64− aeson >= 1.4 && < 1.6,

50+ aeson,

65 android-activity == 0.1.*,

51 android-activity == 0.1.*,

66 data-default == 0.7.*,

52 data-default == 0.7.*,

67− jsaddle >= 0.9.6 && < 0.10

53+ jsaddle

68 c-sources: cbits/MainWidget.c

54 c-sources: cbits/MainWidget.c

69 include-dirs: cbits/include

55 include-dirs: cbits/include

70 install-includes: MainWidget.h

56 install-includes: MainWidget.h

71 cpp-options: -DANDROID

57 cpp-options: -DANDROID

72 build-tools: hsc2hs

58 build-tools: hsc2hs

73 build-depends:

59 build-depends:

74− base >= 4.7 && < 4.15,

60+ base >= 4.7 && < 4.13,

75 bytestring == 0.10.*,

61 bytestring == 0.10.*,

76− reflex >= 0.8 && < 0.9,

62+ reflex >= 0.6.2 && < 0.8,

77− reflex-dom-core >= 0.6.1.0 && <0.7,

63+ reflex-dom-core >=0.5.2 && < 0.6,

78 text == 1.2.*

64 text == 1.2.*

79 if !impl(ghcjs)

65 if !impl(ghcjs)

80 if flag(use-warp) && (os(linux) || os(osx))

66 if flag(use-warp) && (os(linux) || os(osx))

81 build-depends:

67 build-depends:

82− jsaddle >= 0.9.6 && < 0.10,

68+ jsaddle,

83− jsaddle-warp >= 0.9.6 && < 0.10

69+ jsaddle-warp

84 else

70 else

85 if os(osx) || os(ios)

71 if os(osx) || os(ios)

86 build-depends:

72 build-depends:

87 data-default == 0.7.*,

73 data-default == 0.7.*,

88− jsaddle >= 0.9.6 && < 0.10,

74+ jsaddle,

89− jsaddle-wkwebview >= 0.9.6 && < 0.10

75+ jsaddle-wkwebview

90 else

76 else

91− if flag(wasm32)

77+ if arch(wasm32)

92 build-depends:

78 build-depends:

93− jsaddle >= 0.9.6 && < 0.10,

79+ jsaddle,

94− jsaddle-wasm >= 0.1 && < 0.2

80+ jsaddle-wasm

95 else

81 else

96 if flag(webkit2gtk)

82 if flag(webkit2gtk)

97 build-depends:

83 build-depends:

98− jsaddle-webkit2gtk >= 0.9.6 && < 0.10

84+ jsaddle-webkit2gtk

99 else

85 else

100 if !os(android)

86 if !os(android)

101 build-depends:

87 build-depends:

102− jsaddle-webkit2gtk >= 0.9.6 && < 0.10

88+ jsaddle-webkit2gtk

103

104 exposed-modules:

90 exposed-modules:

105 Reflex.Dom

91 Reflex.Dom

106 Reflex.Dom.Internal

92 Reflex.Dom.Internal

107 reexported-modules:

93 reexported-modules:

108− Foreign.JavaScript.Orphans

94+ Foreign.JavaScript.TH

109− , Foreign.JavaScript.TH

110− , Foreign.JavaScript.Utils

95+ , Foreign.JavaScript.Orphans

111 , Reflex.Dom.Builder.Class

96 , Reflex.Dom.Builder.Class

112 , Reflex.Dom.Builder.Class.Events

97 , Reflex.Dom.Builder.Class.Events

113− , Reflex.Dom.Builder.Hydratable

114 , Reflex.Dom.Builder.Immediate

98 , Reflex.Dom.Builder.Immediate

115 , Reflex.Dom.Builder.InputDisabled

99 , Reflex.Dom.Builder.InputDisabled

116 , Reflex.Dom.Builder.Static

100 , Reflex.Dom.Builder.Static

@@ -118,19 +102,14 @@ library

118 , Reflex.Dom.Core

102 , Reflex.Dom.Core

119 , Reflex.Dom.Location

103 , Reflex.Dom.Location

120 , Reflex.Dom.Main

104 , Reflex.Dom.Main

121− , Reflex.Dom.Modals.Class

122 , Reflex.Dom.Old

105 , Reflex.Dom.Old

123− , Reflex.Dom.Prerender

124− , Reflex.Dom.Time

125 , Reflex.Dom.WebSocket

106 , Reflex.Dom.WebSocket

126− , Reflex.Dom.WebSocket.Query

127 , Reflex.Dom.Widget

107 , Reflex.Dom.Widget

128 , Reflex.Dom.Widget.Basic

108 , Reflex.Dom.Widget.Basic

129 , Reflex.Dom.Widget.Input

109 , Reflex.Dom.Widget.Input

130 , Reflex.Dom.Widget.Lazy

110 , Reflex.Dom.Widget.Lazy

131 , Reflex.Dom.Widget.Resize

111 , Reflex.Dom.Widget.Resize

132 , Reflex.Dom.Xhr

112 , Reflex.Dom.Xhr

133− , Reflex.Dom.Xhr.FormData

134 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans

113 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans

135 if flag(expose-all-unfoldings)

114 if flag(expose-all-unfoldings)

136 ghc-options: -fexpose-all-unfoldings

115 ghc-options: -fexpose-all-unfoldings

@@ -162,19 +141,7 @@ executable sortableList

162 default-language: Haskell2010

141 default-language: Haskell2010

163

142

164executable benchmark

143executable benchmark

165− build-depends: base

144+ build-depends: base, reflex, reflex-dom, text, prim-uniq, dependent-map, containers, transformers, mtl, ghcjs-dom, ghc-prim, random, dependent-sum

166− , containers

167− , dependent-map

168− , dependent-sum

169− , ghc-prim

170− , ghcjs-dom

171− , mtl

172− , prim-uniq

173− , random

174− , reflex

175− , reflex-dom

176− , text

177− , transformers

178 hs-source-dirs: .

145 hs-source-dirs: .

179 main-is: benchmark.hs

146 main-is: benchmark.hs

180 ghc-options: -O2 -fspecialise-aggressively

147 ghc-options: -O2 -fspecialise-aggressively

@@ -183,20 +150,7 @@ executable benchmark

183 default-language: Haskell2010

150 default-language: Haskell2010

184

151

185executable krausest

152executable krausest

186− build-depends: base

153+ build-depends: base, reflex, reflex-dom, text, prim-uniq, dependent-map, containers, transformers, mtl, ghcjs-dom, ghc-prim, random, dependent-sum, vector

187− , containers

188− , dependent-map

189− , dependent-sum

190− , ghc-prim

191− , ghcjs-dom

192− , mtl

193− , prim-uniq

194− , random

195− , reflex

196− , reflex-dom

197− , text

198− , transformers

199− , vector

200 hs-source-dirs: benchmarks

154 hs-source-dirs: benchmarks

201 main-is: krausest.hs

155 main-is: krausest.hs

202 ghc-options: -O2 -fspecialise-aggressively

156 ghc-options: -O2 -fspecialise-aggressively

release.nix+4−13

@@ -1,14 +1,12 @@

1{ reflex-platform-fun ? import ./dep/reflex-platform

2−, supportedSystems ? ["x86_64-linux" "x86_64-darwin"]

3}:

2}:

5let

4let

6 native-reflex-platform = reflex-platform-fun {};

5 native-reflex-platform = reflex-platform-fun {};

7 inherit (native-reflex-platform.nixpkgs) lib;

6 inherit (native-reflex-platform.nixpkgs) lib;

7+ systems = ["x86_64-linux" "x86_64-darwin"];

9− tests = system: import ./test { pkgs = (reflex-platform-fun { inherit system; }).nixpkgs; };

10−

11− perPlatform = lib.genAttrs supportedSystems (system: let

9+ perPlatform = lib.genAttrs systems (system: let

12 reflex-platform = reflex-platform-fun { inherit system; };

10 reflex-platform = reflex-platform-fun { inherit system; };

13 compilers = [

11 compilers = [

14 "ghc"

12 "ghc"

@@ -27,22 +25,15 @@ let

27 (self: super: {

25 (self: super: {

28 _dep = super._dep // {

26 _dep = super._dep // {

29 reflex-dom = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [

27 reflex-dom = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [

28+ "release.nix"

30 ".git"

29 ".git"

31 "dist"

30 "dist"

32− "dist-newstyle"

33− ]) && !(builtins.elem path [

34− ./CONTRIBUTING.md

35− ./FAQ.md

36− ./Quickref.md

37− ./README.md

38− ./release.nix

39− ./test

40 ])) ./.;

31 ])) ./.;

41 };

32 };

42 })

33 })

43 ];

34 ];

44 };

35 };

45− all = tests system // {

36+ all = {

46 inherit (reflex-platform.${ghc})

37 inherit (reflex-platform.${ghc})

47 reflex-dom-core

38 reflex-dom-core

48 reflex-dom

39 reflex-dom

test/default.nixdeleted−10

@@ -1,10 +0,0 @@

1−{ pkgs ? (import ../dep/reflex-platform {}).nixpkgs }:

2−{

3− test-reflex-dom-reexports = pkgs.runCommand "test-reflex-dom-reexports" {} (

4− let

5− ghc = pkgs.haskellPackages.ghcWithPackages (p: [p.Cabal]);

6− in ''

7− ${ghc}/bin/runhaskell ${./reflex-dom-reexports.hs} ${../reflex-dom/reflex-dom.cabal} ${../reflex-dom-core/reflex-dom-core.cabal}

8− touch "$out"

9− '');

10−}

test/prebuild.hsnew file+127

@@ -0,0 +1,127 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE ScopedTypeVariables #-}

4+{-# LANGUAGE TypeFamilies #-}

5+{-# LANGUAGE LambdaCase #-}

6+{-# LANGUAGE FlexibleInstances #-}

7+{-# LANGUAGE MultiParamTypeClasses #-}

8+import Control.Monad

9+import Control.Monad.Identity

10+import Control.Monad.Trans

11+import Reflex.Dom

12+import qualified Data.Text as T

13+import Control.Concurrent

14+

15+import Control.Monad.State.Strict

16+import Data.Functor.Misc

17+import Data.Monoid

18+import Data.Word

19+import qualified Data.Map as Map

20+import qualified Data.Dependent.Map as DMap

21+import Data.Dependent.Sum

22+import qualified Reflex.Patch.DMapWithMove as PatchDMapWithMove

23+

24+main :: IO ()

25+main = mainWidget w

26+

27+w :: forall t m. (MonadWidget t m, DomRenderHook t m, MountableDomBuilder t m) => m ()

28+w = do

29+ let slow :: forall m'. (MonadWidget t m', DomRenderHook t m') => m' ()

30+ {-

31+ performEventChain = do

32+ postBuild <- delay 0 =<< getPostBuild

33+ rec let maxN = 10000

34+ n = leftmost [0 <$ postBuild, ffilter (<=maxN) $ succ <$> n']

35+ n' <- performEvent $ return <$> n

36+ pausedUntil $ ffilter (==maxN) n'

37+ _ <- widgetHold (text "Starting") $ text . T.pack . show <$> n

38+ return ()

39+ -}

40+-- {- Many dyns

41+ slow = elAttr "div" ("style" =: "position:relative;width:256px;height:256px") $ go maxDepth

42+ where maxDepth = 6 :: Int

43+ go 0 = blank

44+ go n = void $ dyn $ pure $ do

45+ let bgcolor = "rgba(0,0,0," <> T.pack (show (1 - (fromIntegral n / fromIntegral maxDepth) :: Double)) <> ")"

46+ s pos = pos <> ";position:absolute;border:1px solid white;background-color:" <> bgcolor

47+ elAttr "div" ("style" =: s "left:0;right:50%;top:0;bottom:50%") $ go $ pred n

48+ elAttr "div" ("style" =: s "left:50%;right:0;top:0;bottom:50%") $ go $ pred n

49+ elAttr "div" ("style" =: s "left:50%;right:0;top:50%;bottom:0") $ go $ pred n

50+ elAttr "div" ("style" =: s "left:0;right:50%;top:50%;bottom:0") $ go $ pred n

51+-- -}

52+ {- Many elDynAttrs

53+ slow = do

54+ let size = 64

55+ replicateM_ size $ elAttr "div" ("style" =: ("height:4px;width:" <> T.pack (show (size*4)) <> "px;line-height:0;background-color:gray")) $ do

56+ replicateM_ size $ elDynAttr "div" (pure $ "style" =: "display:inline-block;width:4px;height:4px;background-color:black") blank

57+ -}

58+ {- Many dynTexts

59+ slow = el "table" $ do

60+ let size = 64

61+ replicateM_ size $ el "tr" $ do

62+ replicateM_ size $ el "td" $ do

63+ dynText $ pure "."

64+ -}

65+ {- Many simultaneous performEvents

66+ slow = do

67+ postBuild <- getPostBuild

68+ replicateM_ ((2 :: Int) ^ (14 :: Int)) $ performEvent_ $ return () <$ postBuild

69+ done <- performEvent $ return () <$ postBuild

70+ _ <- widgetHold (text "Doing performEvent") $ text "Done" <$ done

71+ return ()

72+ -}

73+ {-

74+ slow = do

75+ postBuild <- getPostBuild

76+ postBuild' <- performEvent . (return () <$) =<< performEvent . (return () <$) =<< getPostBuild

77+ let f x = Map.fromList [(n, x) | n <- [1 :: Int .. 4096]]

78+ listHoldWithKey (f False) (f (Just True) <$ postBuild') $ \k -> \case

79+ False -> do

80+ text "X "

81+ notReadyUntil =<< getPostBuild

82+ True -> do

83+ text ". "

84+ return ()

85+ -}

86+ {-

87+ slow = do

88+ let f :: forall a. EitherTag () () a -> Const2 () () a -> m' (Const2 () () a)

89+ f _ (Const2 ()) = do

90+ notReadyUntil =<< delay 0.5 =<< getPostBuild

91+ text "Done"

92+ return $ Const2 ()

93+ postBuild <- getPostBuild

94+ traverseDMapWithKeyWithAdjustWithMove f (DMap.singleton LeftTag $ Const2 ()) $ (PatchDMapWithMove.moveDMapKey LeftTag RightTag) <$ postBuild

95+ return ()

96+ -}

97+ {-

98+ slow = do

99+ let h x = do

100+ liftIO $ putStrLn "render hook"

101+ result <- x

102+ liftIO $ putStrLn "render hook done"

103+ return result

104+ f :: forall a. Const2 () () a -> Identity a -> m' (Identity a)

105+ f (Const2 ()) (Identity ()) = do

106+ liftIO $ putStrLn "f"

107+ widgetHold notReady . (blank <$) =<< delay 0.1 =<< getPostBuild

108+ liftIO $ putStrLn "f done"

109+ return $ Identity ()

110+ withRenderHook h $ do

111+ postBuild <- getPostBuild

112+ _ <- traverseDMapWithKeyWithAdjust f mempty $ PatchDMap (DMap.singleton (Const2 () :: Const2 () () ()) (ComposeMaybe $ Just $ Identity ())) <$ postBuild

113+ return ()

114+ -}

115+ el "div" $ do

116+ draw <- button "Draw"

117+ widgetHold blank $ ffor draw $ \_ -> do

118+ _ <- untilReady (text "Loading...") slow

119+ return ()

120+ return ()

121+

122+#ifdef EXPERIMENTAL_DEPENDENT_SUM_INSTANCES

123+instance {-# INCOHERENT #-} (Show (f a), Show (f b)) => ShowTag (EitherTag a b) f where

124+ showTagToShow e _ = case e of

125+ LeftTag -> id

126+ RightTag -> id

127+#endif

test/reflex-dom-reexports.hsdeleted−72

@@ -1,72 +0,0 @@

1−-- This tests that reflex-dom re-exports all of reflex-dom-core's modules.

2−-- Without this test they easily drift.

3−module Main where

4−

5−import Control.Monad (when)

6−import Data.List (intercalate)

7−import Data.Maybe (fromMaybe, isNothing, mapMaybe)

8−import qualified Data.Set as Set

9−import Distribution.Types.PackageName (mkPackageName)

10−import Distribution.Compiler (CompilerFlavor (GHC))

11−import Distribution.ModuleName (ModuleName, components)

12−import Distribution.PackageDescription.Parsec (parseGenericPackageDescription)

13−import qualified Distribution.Parsec.Common as Dist

14−import Distribution.Parsec.ParseResult (runParseResult)

15−import qualified Distribution.System as Dist

16−import Distribution.Types.BuildInfo (buildable, defaultExtensions, defaultLanguage, hsSourceDirs, options)

17−import Distribution.Types.CondTree (simplifyCondTree)

18−import Distribution.Types.GenericPackageDescription (ConfVar (Arch, Impl, OS), condLibrary)

19−import Distribution.Types.Library (exposedModules, libBuildInfo, reexportedModules)

20−import Distribution.Types.ModuleReexport (ModuleReexport, moduleReexportOriginalName, moduleReexportOriginalPackage)

21−import Distribution.Utils.Generic (toUTF8BS, readUTF8File)

22−import System.Environment (getArgs)

23−import qualified System.Info

24−

25−main :: IO ()

26−main = do

27− [reflexDomFile, reflexDomCoreFile] <- getArgs

28− (_, reflexDomReexports) <- parseCabalExports reflexDomFile

29− (reflexDomCoreExports', _) <- parseCabalExports reflexDomCoreFile

30−

31− let

32− reflexDomCoreExports = Set.fromList reflexDomCoreExports'

33− reflexDomCorePackageName = mkPackageName "reflex-dom-core"

34− reflexDomReexportsFromCore

35− = Set.fromList

36− $ mapMaybe (\x -> if let origPackage = moduleReexportOriginalPackage x

37− in isNothing origPackage || origPackage == Just reflexDomCorePackageName

38− then Just $ moduleReexportOriginalName x

39− else Nothing

40− )

41− reflexDomReexports

42−

43− when (reflexDomCoreExports /= reflexDomReexportsFromCore) $ do

44− error $ intercalate "\n\t"

45− $ "reflex-dom does not re-export the following modules from reflex-dom-core:"

46− : map

47− (intercalate "." . components)

48− (Set.toAscList $ reflexDomCoreExports `Set.difference` reflexDomReexportsFromCore)

49−

50− putStrLn "Test passed."

51−

52−parseCabalExports :: FilePath -> IO ([ModuleName], [ModuleReexport])

53−parseCabalExports file = do

54− contents <- readUTF8File file

55− let

56− (warnings, result) = runParseResult $ parseGenericPackageDescription $ toUTF8BS contents

57− osConfVar = case System.Info.os of

58− "linux" -> Just Dist.Linux

59− "darwin" -> Just Dist.OSX

60− _ -> error "Unrecognized System.Info.os"

61− archConfVar = Just Dist.X86_64

62− evalConfVar v = Right $ case v of

63− OS osVar -> Just osVar == osConfVar

64− Arch archVar -> Just archVar == archConfVar

65− Impl GHC _ -> True

66− _ -> False

67− pure $ case condLibrary <$> result of

68− Right (Just condLib) ->

69− let (_, lib) = simplifyCondTree evalConfVar condLib

70− in (exposedModules lib, reexportedModules lib)

71− Right Nothing -> error $ "Haskell package has no library component: " <> file

72− Left (_, errors) -> error $ "Failed to parse " <> file <> ":\n" <> unlines (map show errors)