8d034f2..develop · reflex-dom

.github/workflows/haskell.ymlnew file+47

since splitsnapshots

unifiedsplit

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

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

LICENSEnew file+12

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

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)

2

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

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)

4

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

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.

6

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

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

8−

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

10

8

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

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

12

10

13### Additional resources

11### Additional resources

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

15−

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

17

12

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)

19

20### Hacking

21

cabal.project+10−1

@@ -1 +1,10 @@

1+packages:

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

2+ reflex-dom-core/

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-nogtknew file+14

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

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.

3

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.4

2+Version: 0.5

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

6

7−unshareNetork :: IO ()

7+unshareNetwork :: IO ()

8−unshareNetork = do

8+unshareNetwork = do

9 uid <- getEffectiveUserID

10 unshare [User, Network]

11 writeUserMappings Nothing [UserMapping 0 uid 1]

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

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

1# DO NOT HAND-EDIT THIS FILE

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

2+import (import ./thunk.nix)

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+4−3

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

1{

2 "owner": "reflex-frp",

3 "repo": "reflex-platform",

4− "branch": "master",

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

5− "rev": "510b990d0b11f0626afbec5fe8575b5b2395391b",

5+ "private": false,

6− "sha256": "09cmahsbxr0963wq171c7j139iyzz49hramr4v9nsf684wcwkngv"

6+ "rev": "fd5acecb50474f795734db9fb924cc3b2fd2b508",

7+ "sha256": "0wsdd67g42klsf9n3pxb3pndjdz36nzf8gp7pfm8j6nyyy2qribk"

7}

8}

dep/reflex-platform/thunk.nixnew file+9

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

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+19

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

1# Revision history for reflex-dom-core

2

3+## 0.6.2.1

4+

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+

3## 0.6.0.0

22## 0.6.0.0

4

23

5* ([#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`.

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`.

reflex-dom-core/LICENSE+1−1

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

2All rights reserved.

3

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+29−13

@@ -1,8 +1,12 @@

1cabal-version: 1.24

2Name: reflex-dom-core

3−Version: 0.6.0.0

3+Version: 0.6.2.1

4Synopsis: Functional Reactive Web Apps with Reflex

5Description:

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+ .

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

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

7 .

11 .

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

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

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

50 manual: False

54 manual: False

51 default: True

55 default: True

52

56

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+

53library

67library

54 hs-source-dirs: src

68 hs-source-dirs: src

55 build-depends:

69 build-depends:

56− aeson >= 0.8 && < 1.5,

70+ aeson >= 0.8 && < 1.6,

57− base >= 4.7 && < 4.14,

71+ base >= 4.7 && < 4.15,

58 bifunctors >= 4.2 && < 6,

72 bifunctors >= 4.2 && < 6,

59− bimap >= 0.3 && < 0.4,

73+ bimap >= 0.3 && < 0.5,

60 blaze-builder >= 0.4.1 && < 0.5,

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

61 bytestring == 0.10.*,

75 bytestring == 0.10.*,

62 case-insensitive < 1.3,

76 case-insensitive < 1.3,

63 containers >= 0.6 && < 0.7,

77 containers >= 0.6 && < 0.7,

64− constraints >= 0.9 && < 0.12,

78+ constraints >= 0.9 && < 0.13,

65 contravariant >= 1.4 && < 1.6,

79 contravariant >= 1.4 && < 1.6,

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

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

67− dependent-map >= 0.3 && < 0.4,

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

68− dependent-sum >= 0.6 && < 0.7,

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

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

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

70 directory >= 1.2 && < 1.4,

84 directory >= 1.2 && < 1.4,

71 exception-transformers == 0.4.*,

85 exception-transformers == 0.4.*,

@@ -79,7 +93,7 @@ library

79 primitive >= 0.5 && < 0.8,

93 primitive >= 0.5 && < 0.8,

80 random >= 1.1 && < 1.2,

94 random >= 1.1 && < 1.2,

81 ref-tf == 0.4.*,

95 ref-tf == 0.4.*,

82− reflex >= 0.6.2 && < 0.8,

96+ reflex >= 0.8 && < 0.9,

83 semigroups >= 0.16 && < 0.20,

97 semigroups >= 0.16 && < 0.20,

84 stm >= 2.4 && < 2.6,

98 stm >= 2.4 && < 2.6,

85 text == 1.2.*,

99 text == 1.2.*,

@@ -100,7 +114,7 @@ library

100 if flag(split-these)

114 if flag(split-these)

101 build-depends:

115 build-depends:

102 semialign >= 1 && < 1.2,

116 semialign >= 1 && < 1.2,

103− these >= 1 && < 1.1

117+ these >= 1 && < 1.2

104 else

118 else

105 build-depends:

119 build-depends:

106 these >= 0.4 && < 0.9

120 these >= 0.4 && < 0.9

@@ -155,14 +169,16 @@ library

155 if flag(use-template-haskell)

169 if flag(use-template-haskell)

156 build-depends:

170 build-depends:

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

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

158− template-haskell >= 2.12.0 && < 2.16

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

159 other-extensions: TemplateHaskell

173 other-extensions: TemplateHaskell

160 cpp-options: -DUSE_TEMPLATE_HASKELL

174 cpp-options: -DUSE_TEMPLATE_HASKELL

161 other-modules:

175 other-modules:

162 Reflex.Dom.Builder.Class.TH

176 Reflex.Dom.Builder.Class.TH

163

177

164test-suite hlint

178test-suite hlint

165− build-depends: base, hlint

179+ build-depends:

180+ base,

181+ hlint >= 2.0 && < 4.0

166 hs-source-dirs: test

182 hs-source-dirs: test

167 main-is: hlint.hs

183 main-is: hlint.hs

168 type: exitcode-stdio-1.0

184 type: exitcode-stdio-1.0

@@ -214,7 +230,7 @@ test-suite hydration

214 main-is: hydration.hs

230 main-is: hydration.hs

215 type: exitcode-stdio-1.0

231 type: exitcode-stdio-1.0

216 default-language: Haskell98

232 default-language: Haskell98

217− if !os(linux) || !arch(x86_64) || flag(profile-reflex)

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

218 buildable: False

234 buildable: False

219

235

220-- broken test on base 4.11 & ghc 8.4.3

236-- broken test on base 4.11 & ghc 8.4.3

@@ -234,7 +250,7 @@ test-suite gc

234 main-is: gc.hs

250 main-is: gc.hs

235 type: exitcode-stdio-1.0

251 type: exitcode-stdio-1.0

236 default-language: Haskell98

252 default-language: Haskell98

237− if !os(linux) || !arch(x86_64)

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

238 buildable: False

254 buildable: False

239

255

240source-repository head

256source-repository head

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

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

9{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

11{-# LANGUAGE ImpredicativeTypes #-}

12+#else

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

12#endif

14#endif

13{-# LANGUAGE LambdaCase #-}

15{-# LANGUAGE LambdaCase #-}

14{-# LANGUAGE OverloadedStrings #-}

16{-# LANGUAGE OverloadedStrings #-}

15{-# LANGUAGE PolyKinds #-}

17{-# LANGUAGE PolyKinds #-}

16−{-# LANGUAGE Rank2Types #-}

17{-# LANGUAGE RecursiveDo #-}

18{-# LANGUAGE RecursiveDo #-}

18{-# LANGUAGE ScopedTypeVariables #-}

19{-# LANGUAGE ScopedTypeVariables #-}

19{-# LANGUAGE StandaloneDeriving #-}

20{-# LANGUAGE StandaloneDeriving #-}

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

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

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

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

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

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

747instance 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/Immediate.hs+16−7

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

2{-# LANGUAGE CPP #-}

3{-# LANGUAGE ConstraintKinds #-}

4{-# LANGUAGE DataKinds #-}

5−{-# LANGUAGE DeriveFunctor #-}

6{-# LANGUAGE DeriveTraversable #-}

5{-# LANGUAGE DeriveTraversable #-}

7{-# LANGUAGE EmptyDataDecls #-}

6{-# LANGUAGE EmptyDataDecls #-}

8{-# LANGUAGE FlexibleContexts #-}

7{-# LANGUAGE FlexibleContexts #-}

@@ -11,7 +10,6 @@

11{-# LANGUAGE GeneralizedNewtypeDeriving #-}

10{-# LANGUAGE GeneralizedNewtypeDeriving #-}

12{-# LANGUAGE LambdaCase #-}

11{-# LANGUAGE LambdaCase #-}

13{-# LANGUAGE MultiParamTypeClasses #-}

12{-# LANGUAGE MultiParamTypeClasses #-}

14−{-# LANGUAGE MultiWayIf #-}

15{-# LANGUAGE OverloadedStrings #-}

13{-# LANGUAGE OverloadedStrings #-}

16{-# LANGUAGE PatternGuards #-}

14{-# LANGUAGE PatternGuards #-}

17{-# LANGUAGE PolyKinds #-}

15{-# LANGUAGE PolyKinds #-}

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

50 , HydrationMode (..)

48 , HydrationMode (..)

51 , HydrationRunnerT (..)

49 , HydrationRunnerT (..)

52 , runHydrationRunnerT

50 , runHydrationRunnerT

51+ , runHydrationRunnerTWithFailure

53 , ImmediateDomBuilderT

52 , ImmediateDomBuilderT

54 , runHydrationDomBuilderT

53 , runHydrationDomBuilderT

55 , getHydrationMode

54 , getHydrationMode

@@ -136,11 +135,13 @@ import Data.Functor.Compose

136import Data.Functor.Constant

135import Data.Functor.Constant

137import Data.Functor.Misc

136import Data.Functor.Misc

138import Data.Functor.Product

137import Data.Functor.Product

138+import Data.GADT.Compare (GCompare)

139import Data.IORef

140import Data.IntMap.Strict (IntMap)

141import Data.Maybe

142import Data.Monoid ((<>))

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

144+import Data.GADT.Compare (GCompare)

144import Data.String (IsString)

145import Data.String (IsString)

145import Data.Text (Text)

146import Data.Text (Text)

146import Foreign.JavaScript.Internal.Utils

147import Foreign.JavaScript.Internal.Utils

@@ -291,15 +292,23 @@ localRunner (HydrationRunnerT m) s parent = do

291

292

292{-# INLINABLE runHydrationRunnerT #-}

293{-# INLINABLE runHydrationRunnerT #-}

293runHydrationRunnerT

294runHydrationRunnerT

295+ :: (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

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

298+

299+{-# INLINABLE runHydrationRunnerTWithFailure #-}

300+runHydrationRunnerTWithFailure

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

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

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

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

296−runHydrationRunnerT (HydrationRunnerT m) onFailure s parent events = flip runDomRenderHookT events $ flip runReaderT parent $ do

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

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

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

298 traverse_ removeSubsequentNodes $ _hydrationState_previousNode s'

305 traverse_ removeSubsequentNodes $ _hydrationState_previousNode s'

299 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."

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."

300 when (_hydrationState_failed s') $ liftIO onFailure

307 when (_hydrationState_failed s') $ liftIO onFailure

301 pure a

308 pure a

302

309

310+

311+

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

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

304 {-# INLINABLE newEventWithTrigger #-}

313 {-# INLINABLE newEventWithTrigger #-}

305 newEventWithTrigger = lift . newEventWithTrigger

314 newEventWithTrigger = lift . newEventWithTrigger

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

1663

1672

1664{-# INLINABLE traverseDMapWithKeyWithAdjust' #-}

1673{-# INLINABLE traverseDMapWithKeyWithAdjust' #-}

1665traverseDMapWithKeyWithAdjust'

1674traverseDMapWithKeyWithAdjust'

1666− :: 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)

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)

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

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

1668 -> DMap k v

1677 -> DMap k v

1669 -> Event t (PatchDMap k v)

1678 -> Event t (PatchDMap k v)

@@ -1783,7 +1792,7 @@ hoistTraverseWithKeyWithAdjust

1783 ::

1792 ::

1784 ( Adjustable t m

1793 ( Adjustable t m

1785 , MonadHold t m

1794 , MonadHold t m

1786− , DMap.GCompare k

1795+ , GCompare k

1787 , MonadIO m

1796 , MonadIO m

1788 , MonadJSM m

1797 , MonadJSM m

1789 , PrimMonad m

1798 , PrimMonad m

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

1867 getHydrationMode >>= \case

1876 getHydrationMode >>= \case

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

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

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

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

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

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

1871 liftIO $ writeIORef placeholders $! phs

1880 liftIO $ writeIORef placeholders $! phs

1872 insertAfterPreviousNode lastPlaceholder

1881 insertAfterPreviousNode lastPlaceholder

1873 HydrationMode_Immediate -> do

1882 HydrationMode_Immediate -> do

1874 let activate i = do

1883 let activate i = do

1875 append $ toNode $ _traverseChildImmediate_fragment i

1884 append $ toNode $ _traverseChildImmediate_fragment i

1876 pure $ _traverseChildImmediate_placeholder i

1885 pure $ _traverseChildImmediate_placeholder i

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

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

1878 liftIO $ writeIORef placeholders $! phs

1887 liftIO $ writeIORef placeholders $! phs

1879 append $ toNode lastPlaceholder

1888 append $ toNode lastPlaceholder

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

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

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

@@ -274,7 +274,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

275 shouldEscape <- asks _staticDomBuilderEnv_shouldEscape

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

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

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

278 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

280 return $ CommentNode ()

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

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)

327+ adjustedConfig = _inputElementConfig_elementConfig cfg

328 & elementConfig_initialAttributes %~ setInitialValue . setInitialChecked

329 & elementConfig_modifyAttributes %~ setUpdatedValue . setUpdatedChecked

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

reflex-dom-core/src/Reflex/Dom/Main.hs+38−10

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

5{-# LANGUAGE GADTs #-}

6{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE NoMonomorphismRestriction #-}

8−{-# LANGUAGE PatternSynonyms #-}

9{-# LANGUAGE RankNTypes #-}

8{-# LANGUAGE RankNTypes #-}

10{-# LANGUAGE RecursiveDo #-}

9{-# LANGUAGE RecursiveDo #-}

11{-# LANGUAGE ScopedTypeVariables #-}

10{-# LANGUAGE ScopedTypeVariables #-}

@@ -64,22 +63,41 @@ mainHydrationWidgetWithHead = mainHydrationWidgetWithHead'

64{-# INLINABLE mainHydrationWidgetWithHead' #-}

63{-# INLINABLE mainHydrationWidgetWithHead' #-}

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

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

66mainHydrationWidgetWithHead' :: HydrationWidget () () -> HydrationWidget () () -> JSM ()

65mainHydrationWidgetWithHead' :: HydrationWidget () () -> HydrationWidget () () -> JSM ()

67−mainHydrationWidgetWithHead' = mainHydrationWidgetWithSwitchoverAction' (pure ()) (pure ())

66+mainHydrationWidgetWithHead' = mainHydrationWidgetWithSwitchoverAction' (pure ())

68

67

69{-# INLINE mainHydrationWidgetWithSwitchoverAction #-}

68{-# INLINE mainHydrationWidgetWithSwitchoverAction #-}

70−mainHydrationWidgetWithSwitchoverAction :: IO () -> JSM () -> (forall x. HydrationWidget x ()) -> (forall x. HydrationWidget x ()) -> JSM ()

69+mainHydrationWidgetWithSwitchoverAction :: JSM () -> (forall x. HydrationWidget x ()) -> (forall x. HydrationWidget x ()) -> JSM ()

71mainHydrationWidgetWithSwitchoverAction = mainHydrationWidgetWithSwitchoverAction'

70mainHydrationWidgetWithSwitchoverAction = mainHydrationWidgetWithSwitchoverAction'

72

71

73{-# INLINABLE mainHydrationWidgetWithSwitchoverAction' #-}

72{-# INLINABLE mainHydrationWidgetWithSwitchoverAction' #-}

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

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

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

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

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

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

76−mainHydrationWidgetWithSwitchoverAction' onFailure switchoverAction head' body = do

81+mainHydrationWidgetWithSwitchoverActionWithFailure' onFailure switchoverAction head' body = do

77− runHydrationWidgetWithHeadAndBody onFailure switchoverAction $ \appendHead appendBody -> do

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

78 appendHead head'

83 appendHead head'

79 appendBody body

84 appendBody body

80

85

81{-# INLINABLE attachHydrationWidget #-}

86{-# INLINABLE attachHydrationWidget #-}

82attachHydrationWidget

87attachHydrationWidget

88+ :: JSM ()

89+ -> JSContextSingleton ()

90+ -> ( Event DomTimeline ()

91+ -> IORef HydrationMode

92+ -> Maybe (IORef [(Node, HydrationRunnerT DomTimeline (DomCoreWidget ()) ())])

93+ -> EventChannel

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

95+ )

96+ -> IO (a, FireCommand DomTimeline DomHost)

97+attachHydrationWidget = attachHydrationWidgetWithFailure (pure ())

98+

99+{-# INLINABLE attachHydrationWidgetWithFailure #-}

100+attachHydrationWidgetWithFailure

83 :: IO ()

101 :: IO ()

84 -> JSM ()

102 -> JSM ()

85 -> JSContextSingleton ()

103 -> JSContextSingleton ()

@@ -90,7 +108,7 @@ attachHydrationWidget

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

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

91 )

109 )

92 -> IO (a, FireCommand DomTimeline DomHost)

110 -> IO (a, FireCommand DomTimeline DomHost)

93−attachHydrationWidget onFailure switchoverAction jsSing w = do

111+attachHydrationWidgetWithFailure onFailure switchoverAction jsSing w = do

94 hydrationMode <- liftIO $ newIORef HydrationMode_Hydrating

112 hydrationMode <- liftIO $ newIORef HydrationMode_Hydrating

95 rootNodesRef <- liftIO $ newIORef []

113 rootNodesRef <- liftIO $ newIORef []

96 events <- newChan

114 events <- newChan

@@ -106,7 +124,7 @@ attachHydrationWidget onFailure switchoverAction jsSing w = do

106 rootNodes <- liftIO $ readIORef rootNodesRef

124 rootNodes <- liftIO $ readIORef rootNodesRef

107 let delayedAction = do

125 let delayedAction = do

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

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

109− let hydrate = runHydrationRunnerT runner onFailure Nothing rootNode events

127+ let hydrate = runHydrationRunnerTWithFailure runner onFailure Nothing rootNode events

110 void $ runWithJSContextSingleton (runPostBuildT hydrate never) jsSing

128 void $ runWithJSContextSingleton (runPostBuildT hydrate never) jsSing

111 liftIO $ writeIORef hydrationMode HydrationMode_Immediate

129 liftIO $ writeIORef hydrationMode HydrationMode_Immediate

112 runWithJSContextSingleton (DOM.liftJSM switchoverAction) jsSing

130 runWithJSContextSingleton (DOM.liftJSM switchoverAction) jsSing

@@ -121,6 +139,16 @@ type DomCoreWidget x = PostBuildT DomTimeline (WithJSContextSingleton x (Perform

121

139

122{-# INLINABLE runHydrationWidgetWithHeadAndBody #-}

140{-# INLINABLE runHydrationWidgetWithHeadAndBody #-}

123runHydrationWidgetWithHeadAndBody

141runHydrationWidgetWithHeadAndBody

142+ :: JSM ()

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

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

145+ -> FloatingWidget () ()

146+ )

147+ -> JSM ()

148+runHydrationWidgetWithHeadAndBody = runHydrationWidgetWithHeadAndBodyWithFailure (pure ())

149+

150+{-# INLINABLE runHydrationWidgetWithHeadAndBodyWithFailure #-}

151+runHydrationWidgetWithHeadAndBodyWithFailure

124 :: IO ()

152 :: IO ()

125 -> JSM ()

153 -> JSM ()

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

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

@@ -128,11 +156,11 @@ runHydrationWidgetWithHeadAndBody

128 -> FloatingWidget () ()

156 -> FloatingWidget () ()

129 )

157 )

130 -> JSM ()

158 -> JSM ()

131−runHydrationWidgetWithHeadAndBody onFailure switchoverAction app = withJSContextSingletonMono $ \jsSing -> do

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

132 globalDoc <- currentDocumentUnchecked

160 globalDoc <- currentDocumentUnchecked

133 headElement <- getHeadUnchecked globalDoc

161 headElement <- getHeadUnchecked globalDoc

134 bodyElement <- getBodyUnchecked globalDoc

162 bodyElement <- getBodyUnchecked globalDoc

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

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

136 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef

164 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef

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

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

138 hydrateDom n w = do

166 hydrateDom n w = do

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

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

24

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

26import Control.Monad.Reader

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

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

28import Data.IORef (IORef, newIORef)

29import Data.Semigroup (Semigroup)

30import Data.Text (Text)

@@ -165,6 +165,8 @@ 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

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

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

169 askDocument = unrunnable

171 askDocument = unrunnable

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

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

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

203 newFanEventWithTrigger _ = unrunnable

205 newFanEventWithTrigger _ = unrunnable

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

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

205 mfix _ = unrunnable

207 mfix _ = unrunnable

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

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

207 hold _ _ = unrunnable

209 hold _ _ = unrunnable

208 holdDyn _ _ = unrunnable

210 holdDyn _ _ = unrunnable

209 holdIncremental _ _ = unrunnable

211 holdIncremental _ _ = unrunnable

210 buildDynamic _ _ = unrunnable

212 buildDynamic _ _ = unrunnable

211 headE _ = unrunnable

213 headE _ = unrunnable

214+ now = unrunnable

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

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

213 sample _ = unrunnable

216 sample _ = unrunnable

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

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

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

226 withRenderHook _ _ = unrunnable

229 withRenderHook _ _ = unrunnable

227 requestDomAction _ = unrunnable

230 requestDomAction _ = unrunnable

228 requestDomAction_ _ = unrunnable

231 requestDomAction_ _ = unrunnable

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

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

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

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

231 prerender _ _ = unrunnable

234 prerender _ _ = unrunnable

232

235

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

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

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

630 attributes = fileInputConfig_attributes

631

632−class HasSetValue a where

633− type SetValue a :: *

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

635

632

636instance HasSetValue (TextAreaConfig t) where

633instance HasSetValue (TextAreaConfig t) where

637 type SetValue (TextAreaConfig t) = Event t Text

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/Xhr/Foreign.hs+2−2

@@ -15,7 +15,7 @@ import Data.Text (Text)

15import Data.ByteString (ByteString)

16import Foreign.JavaScript.Utils (bsFromMutableArrayBuffer, bsToArrayBuffer)

17import GHCJS.DOM.Enums

18−import GHCJS.DOM.EventM (EventM, on)

18+import GHCJS.DOM.EventM (EventM, on, onSync)

19import GHCJS.DOM.EventTarget (dispatchEvent)

20import GHCJS.DOM.Types (MonadJSM, ToJSString, FormData, Document, Blob (..), ArrayBuffer (..), JSVal, JSM, IsEvent, XMLHttpRequestProgressEvent, ProgressEvent, Event, XMLHttpRequestUpload, FromJSString, ArrayBufferView (..), liftJSM, castTo)

21import GHCJS.DOM.XMLHttpRequest

@@ -114,7 +114,7 @@ xmlHttpRequestOntimeout :: XMLHttpRequest -> EventM XMLHttpRequest ProgressEvent

114xmlHttpRequestOntimeout = (`on` timeout)

115

116xmlHttpRequestOnreadystatechange :: XMLHttpRequest -> EventM XMLHttpRequest Event () -> JSM (JSM ())

117−xmlHttpRequestOnreadystatechange = (`on` readyStateChange)

117+xmlHttpRequestOnreadystatechange = (`onSync` readyStateChange)

118

119xmlHttpRequestSetTimeout :: MonadJSM m => XMLHttpRequest -> Word -> m ()

120xmlHttpRequestSetTimeout = setTimeout

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

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

47

48main :: IO ()

49main = do

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

50+ handle (\(_ :: IOError) -> return ()) $ unshareNetwork -- 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.HLint3 (hlint)

1+import Language.Haskell.HLint (hlint)

2import System.Exit (exitFailure, exitSuccess)

3

4main :: IO ()

reflex-dom-core/test/hydration.hs+36−29

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

20

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

22

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+

23import Prelude hiding (fail)

31import Prelude hiding (fail)

24import Control.Concurrent

32import Control.Concurrent

25import qualified Control.Concurrent.Async as Async

33import qualified Control.Concurrent.Async as Async

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

137

145

138main :: IO ()

146main :: IO ()

139main = do

147main = do

140− unshareNetork

148+ unshareNetwork

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

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

142 withSandboxedChromeFlags isHeadless $ \chromeFlags -> do

150 withSandboxedChromeFlags isHeadless $ \chromeFlags -> do

143 withSeleniumServer $ \selenium -> do

151 withSeleniumServer $ \selenium -> do

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

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

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

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

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

148 chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags

156 chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags

149− hspec (tests withDebugging wdConfig [chromeCaps'] selenium) `finally` _selenium_stopServer selenium

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

150

158

151−tests :: Bool -> WD.WDConfig -> [Capabilities] -> Selenium -> Spec

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

152tests withDebugging wdConfig caps _selenium = do

160tests withDebugging wdConfig caps _selenium = do

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

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

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

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

155− session' = sessionWith wdConfig "" . using (map (,"") caps)

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

156 runWD m = runWDOptions (WdOptions False) $ do

164 runWD m = runWDOptions (WdOptions False) $ do

157 putStrLnDebug "before"

165 putStrLnDebug "before"

158 r <- m

166 r <- m

@@ -164,7 +172,7 @@ tests withDebugging wdConfig caps _selenium = do

164 testWidget = testWidgetDebug True withDebugging

172 testWidget = testWidgetDebug True withDebugging

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

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

166 testWidget' = testWidgetDebug' True withDebugging

174 testWidget' = testWidgetDebug' True withDebugging

167− describe "text" $ session' $ do

175+ session' "text" $ do

168 it "works" $ runWD $ do

176 it "works" $ runWD $ do

169 testWidgetStatic (checkBodyText "hello world") $ do

177 testWidgetStatic (checkBodyText "hello world") $ do

170 text "hello world"

178 text "hello world"

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

225 click <- button ""

233 click <- button ""

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

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

227

235

228− describe "element" $ session' $ do

236+ session' "element" $ do

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

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

230 clickedRef <- liftIO $ newRef False

238 clickedRef <- liftIO $ newRef False

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

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

@@ -289,8 +297,8 @@ tests withDebugging wdConfig caps _selenium = do

289 let click = domEvent Click e

297 let click = domEvent Click e

290 return ()

298 return ()

291

299

292− describe "inputElement" $ do

300+ session' "inputElement" $ do

293− describe "static renderer" $ session' $ do

301+ describe "static renderer" $ do

294 it "sets value attribute" $ runWD $ do

302 it "sets value attribute" $ runWD $ do

295 let checkStatic = do

303 let checkStatic = do

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

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

@@ -347,7 +355,7 @@ tests withDebugging wdConfig caps _selenium = do

347 & inputElementConfig_initialChecked .~ False

355 & inputElementConfig_initialChecked .~ False

348 & inputElementConfig_setChecked .~ (True <$ pb)

356 & inputElementConfig_setChecked .~ (True <$ pb)

349 pure ()

357 pure ()

350− describe "hydration" $ session' $ do

358+ describe "hydration" $ do

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

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

352 inputRef <- newRef ("hello " :: Text)

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

353 testWidget'

361 testWidget'

@@ -585,8 +593,7 @@ tests withDebugging wdConfig caps _selenium = do

585 el "p" $ dynText $ _inputElement_value e

593 el "p" $ dynText $ _inputElement_value e

586 performEvent_ $ consRef valRef <$> updated (_inputElement_value e)

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

587 performEvent_ $ consRef inputRef <$> _inputElement_input e

595 performEvent_ $ consRef inputRef <$> _inputElement_input e

588−

589− describe "hydration/immediate" $ session' $ do

596+ describe "hydration/immediate" $ do

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

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

591 inputRef :: IORef Text <- newRef ""

598 inputRef :: IORef Text <- newRef ""

592 let checkValue = do

599 let checkValue = do

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

666 names <- liftJSM $ traverse File.getName fs

673 names <- liftJSM $ traverse File.getName fs

667 liftIO $ writeRef filesRef names

674 liftIO $ writeRef filesRef names

668

675

669− describe "textAreaElement" $ do

676+ session' "textAreaElement" $ do

670− describe "static renderer" $ session' $ do

677+ describe "static renderer" $ do

671 it "sets value attribute" $ runWD $ do

678 it "sets value attribute" $ runWD $ do

672 let checkStatic = do

679 let checkStatic = do

673 e <- findElemWithRetry $ WD.ByTag "textarea"

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

@@ -690,7 +697,7 @@ tests withDebugging wdConfig caps _selenium = do

690 & textAreaElementConfig_initialValue .~ "test"

697 & textAreaElementConfig_initialValue .~ "test"

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

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

692 pure ()

699 pure ()

693− describe "hydration" $ session' $ do

700+ describe "hydration" $ do

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

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

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

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

696 testWidget'

703 testWidget'

@@ -839,7 +846,7 @@ tests withDebugging wdConfig caps _selenium = do

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

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

840 el "p" $ dynText $ _textAreaElement_value e

847 el "p" $ dynText $ _textAreaElement_value e

841

848

842− describe "hydration/immediate" $ session' $ do

849+ describe "hydration/immediate" $ do

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

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

844 inputRef :: IORef Text <- newRef ""

851 inputRef :: IORef Text <- newRef ""

845 let checkValue = do

852 let checkValue = do

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

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

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

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

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

883

890

884− describe "selectElement" $ do

891+ session' "selectElement" $ do

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

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

886 options = do

893 options = do

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

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

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

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

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

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

890− describe "hydration" $ session' $ do

897+ describe "hydration" $ do

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

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

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

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

893 let setup = do

900 let setup = do

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

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

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

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

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

963

970

964− describe "hydration/immediate" $ session' $ do

971+ describe "hydration/immediate" $ do

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

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

966 inputRef :: IORef Text <- newRef ""

973 inputRef :: IORef Text <- newRef ""

967 let checkValue = do

974 let checkValue = do

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

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

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

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

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

1009

1016

1010− describe "prerender" $ session' $ do

1017+ session' "prerender" $ do

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

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

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

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

1013 prerender_ (text "One") (text "Two")

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

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

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

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

1077 textNode $ TextNodeConfig "Initial" $ Just e

1084 textNode $ TextNodeConfig "Initial" $ Just e

1078

1085

1079− describe "namespaces" $ session' $ do

1086+ session' "namespaces" $ do

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

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

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

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

1082 let svgRootCfg = def

1089 let svgRootCfg = def

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

1085 void $ element "svg" svgRootCfg $ do

1092 void $ element "svg" svgRootCfg $ do

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

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

1087

1094

1088− describe "runWithReplace" $ session' $ do

1095+ session' "runWithReplace" $ do

1089 it "works" $ runWD $ do

1096 it "works" $ runWD $ do

1090 replaceChan :: Chan Text <- liftIO newChan

1097 replaceChan :: Chan Text <- liftIO newChan

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

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

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

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

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

1284 text "|after"

1291 text "|after"

1285

1292

1286− describe "traverseDMapWithKeyWithAdjust" $ session' $ do

1293+ session' "traverseDMapWithKeyWithAdjust" $ do

1287 let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a)

1294 let widget :: DomBuilder t m => DKey a -> Identity a -> m (Identity a)

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

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

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

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

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

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

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

1387 liftIO $ dmap `H.shouldBe` keyMap

1394 liftIO $ dmap `H.shouldBe` keyMap

1388

1395

1389− describe "traverseIntMapWithKeyWithAdjust" $ session' $ do

1396+ session' "traverseIntMapWithKeyWithAdjust" $ do

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

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

1391 intMap = IntMap.fromList

1398 intMap = IntMap.fromList

1392 [ (1, "one")

1399 [ (1, "one")

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

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

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

1494 liftIO $ dmap `H.shouldBe` intMap

1501 liftIO $ dmap `H.shouldBe` intMap

1495

1502

1496− describe "traverseDMapWithKeyWithAdjustWithMove" $ session' $ do

1503+ session' "traverseDMapWithKeyWithAdjustWithMove" $ do

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

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

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

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

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

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

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

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

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

1574 liftIO $ assertEqual "DMap" initMap dmap

1581 liftIO $ assertEqual "DMap" initMap dmap

1575

1582

1576− describe "hydrating invalid HTML" $ session' $ do

1583+ session' "hydrating invalid HTML" $ do

1577− it "can hydrate list in paragraph" $ runWD $ do

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

1578 let preSwitchover = do

1585 let preSwitchover = do

1579 checkBodyText "before\ninner\nafter"

1586 checkBodyText "before\ninner\nafter"

1580 -- Two <p> tags should be present

1587 -- Two <p> tags should be present

@@ -1603,7 +1610,7 @@ tests withDebugging wdConfig caps _selenium = do

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

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

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

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

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

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

1606− describe "dropdown" $ session' $ do

1613+ session' "dropdown" $ do

1607 let doTest expectedOpts (initialValue :: Text) = do

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

1608 let doCheck = do

1615 let doCheck = do

1609 es <- findElemsWithRetry $ WD.ByTag "option"

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

@@ -1760,7 +1767,7 @@ testWidgetDebug' hardFailure withDebugging beforeJS afterSwitchover bodyWidget =

1760 ((), html) <- liftIO $ renderStatic $ runHydratableT staticApp

1767 ((), html) <- liftIO $ renderStatic $ runHydratableT staticApp

1761 putStrLnDebug "rendered static"

1768 putStrLnDebug "rendered static"

1762 waitBeforeJS <- liftIO newEmptyMVar -- Empty until JS should be run

1769 waitBeforeJS <- liftIO newEmptyMVar -- Empty until JS should be run

1763− onFailure <- if hardFailure then (\tid -> throwTo tid HydrationFailedException) <$> liftIO myThreadId else pure $ pure ()

1770+ onFailure <- if hardFailure then (`throwTo` HydrationFailedException) <$> liftIO myThreadId else pure $ pure ()

1764 waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover

1771 waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover

1765 let entryPoint = do

1772 let entryPoint = do

1766 putStrLnDebug "taking waitBeforeJS"

1773 putStrLnDebug "taking waitBeforeJS"

@@ -1772,7 +1779,7 @@ testWidgetDebug' hardFailure withDebugging beforeJS afterSwitchover bodyWidget =

1772 liftIO $ putMVar waitUntilSwitchover ()

1779 liftIO $ putMVar waitUntilSwitchover ()

1773 putStrLnDebug "put waitUntilSwitchover"

1780 putStrLnDebug "put waitUntilSwitchover"

1774 putStrLnDebug "running mainHydrationWidgetWithSwitchoverAction"

1781 putStrLnDebug "running mainHydrationWidgetWithSwitchoverAction"

1775− mainHydrationWidgetWithSwitchoverAction onFailure switchOverAction blank bodyWidget

1782+ mainHydrationWidgetWithSwitchoverActionWithFailure' onFailure switchOverAction blank bodyWidget

1776 putStrLnDebug "syncPoint after mainHydrationWidgetWithSwitchoverAction"

1783 putStrLnDebug "syncPoint after mainHydrationWidgetWithSwitchoverAction"

1777 syncPoint

1784 syncPoint

1778 application <- liftIO $ jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse -> do

1785 application <- liftIO $ jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse -> do

reflex-dom-test-selenium/CHANGELOG.mdnew file+5

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

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/LICENSEnew file+12

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

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.

reflex-dom-test-selenium/Setup.hsnew file+2

@@ -0,0 +1,2 @@

1+import Distribution.Simple

2+main = defaultMain

reflex-dom-test-selenium/add-overrides.nixnew file+20

@@ -0,0 +1,20 @@

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.cabalnew file+41

@@ -0,0 +1,41 @@

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.hsnew file+249

@@ -0,0 +1,249 @@

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+8

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

1# Revision history for reflex-dom

2

3+## 0.6.1.0-r1

4+

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+

3## 0.6.0.0

11## 0.6.0.0

4

12

5* ([#379](https://github.com/reflex-frp/reflex-dom/pull/379)) Re-export all modules from `reflex-dom-core`. The newly re-exported modules are:

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:

reflex-dom/LICENSE+1−1

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

3

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

reflex-dom/reflex-dom.cabal+9−5

@@ -1,8 +1,12 @@

1cabal-version: 1.24

2Name: reflex-dom

3−Version: 0.6.0.0

3+Version: 0.6.1.0

4Synopsis: Functional Reactive Web Apps with Reflex

5Description:

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+ .

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

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

7 .

11 .

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

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

@@ -57,7 +61,7 @@ library

57 hs-source-dirs: src-android

61 hs-source-dirs: src-android

58 other-modules: Reflex.Dom.Android.MainWidget

62 other-modules: Reflex.Dom.Android.MainWidget

59 build-depends:

63 build-depends:

60− aeson >= 1.4 && < 1.5,

64+ aeson >= 1.4 && < 1.6,

61 android-activity == 0.1.*,

65 android-activity == 0.1.*,

62 data-default == 0.7.*,

66 data-default == 0.7.*,

63 jsaddle >= 0.9.6 && < 0.10

67 jsaddle >= 0.9.6 && < 0.10

@@ -67,10 +71,10 @@ library

67 cpp-options: -DANDROID

71 cpp-options: -DANDROID

68 build-tools: hsc2hs

72 build-tools: hsc2hs

69 build-depends:

73 build-depends:

70− base >= 4.7 && < 4.14,

74+ base >= 4.7 && < 4.15,

71 bytestring == 0.10.*,

75 bytestring == 0.10.*,

72− reflex >= 0.6.2 && < 0.8,

76+ reflex >= 0.8 && < 0.9,

73− reflex-dom-core == 0.6.0.0,

77+ reflex-dom-core >= 0.6.1.0 && <0.7,

74 text == 1.2.*

78 text == 1.2.*

75 if !impl(ghcjs)

79 if !impl(ghcjs)

76 if flag(use-warp) && (os(linux) || os(osx))

80 if flag(use-warp) && (os(linux) || os(osx))

test/prebuild.hsdeleted−127

@@ -1,127 +0,0 @@

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