develop..f7fa362 · reflex-dom

git.iko.soy/reflex-dom

20 files changed+88−918

unifiedsplit

.github/workflows/haskell.yml−47 cabal.project+1−10 cabal.project-nogtk−14 reflex-dom-core/ChangeLog.md−8 reflex-dom-core/reflex-dom-core.cabal+7−19 reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+1−2 reflex-dom-core/src/Reflex/Dom/Builder/Immediate.hs+17−55 reflex-dom-core/src/Reflex/Dom/Builder/Static.hs+10−35 reflex-dom-core/src/Reflex/Dom/Main.hs+7−37 reflex-dom-core/src/Reflex/Dom/Widget/Lazy.hs+1−1 reflex-dom-core/test/hlint.hs+1−1 reflex-dom-core/test/hydration.hs+39−352 reflex-dom-test-selenium/CHANGELOG.md−5 reflex-dom-test-selenium/LICENSE−12 reflex-dom-test-selenium/Setup.hs−2 reflex-dom-test-selenium/add-overrides.nix−20 reflex-dom-test-selenium/reflex-dom-test-selenium.cabal−41 reflex-dom-test-selenium/src/Reflex/Dom/Test/Selenium.hs−249 reflex-dom/ChangeLog.md−4 reflex-dom/reflex-dom.cabal+4−4

.github/workflows/haskell.ymldeleted−47

@@ -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

cabal.project+1−10

@@ -1,10 +1 @@

1−packages:

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

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

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

reflex-dom-core/ChangeLog.md−8

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

11# Revision history for reflex-dom-core

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−

113## 0.6.1.0

124

135* Bump version bounds

reflex-dom-core/reflex-dom-core.cabal+7−19

@@ -1,6 +1,6 @@

11cabal-version: 1.24

22Name: reflex-dom-core

3−Version: 0.6.2.1

3+Version: 0.6.1.0

44Synopsis: Functional Reactive Web Apps with Reflex

55Description:

66 Web applications without callbacks or side-effects.

@@ -54,21 +54,11 @@ flag split-these

5454 manual: False

5555 default: True

5656

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−

6757library

6858 hs-source-dirs: src

6959 build-depends:

70− aeson >= 0.8 && < 1.6,

71− base >= 4.7 && < 4.15,

60+ aeson >= 0.8 && < 1.5,

61+ base >= 4.7 && < 4.14,

7262 bifunctors >= 4.2 && < 6,

7363 bimap >= 0.3 && < 0.5,

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

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

169159 if flag(use-template-haskell)

170160 build-depends:

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

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

162+ template-haskell >= 2.12.0 && < 2.16

173163 other-extensions: TemplateHaskell

174164 cpp-options: -DUSE_TEMPLATE_HASKELL

175165 other-modules:

176166 Reflex.Dom.Builder.Class.TH

177167

178168test-suite hlint

179− build-depends:

180− base,

181− hlint >= 2.0 && < 4.0

169+ build-depends: base, hlint

182170 hs-source-dirs: test

183171 main-is: hlint.hs

184172 type: exitcode-stdio-1.0

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

230218 main-is: hydration.hs

231219 type: exitcode-stdio-1.0

232220 default-language: Haskell98

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

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

234222 buildable: False

235223

236224-- broken test on base 4.11 & ghc 8.4.3

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

250238 main-is: gc.hs

251239 type: exitcode-stdio-1.0

252240 default-language: Haskell98

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

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

254242 buildable: False

255243

256244source-repository head

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

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

99{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

1111{-# LANGUAGE ImpredicativeTypes #-}

12−#else

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

1412#endif

1513{-# LANGUAGE LambdaCase #-}

1614{-# LANGUAGE OverloadedStrings #-}

1715{-# LANGUAGE PolyKinds #-}

16+{-# LANGUAGE Rank2Types #-}

1817{-# LANGUAGE RecursiveDo #-}

1918{-# LANGUAGE ScopedTypeVariables #-}

2019{-# LANGUAGE StandaloneDeriving #-}

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

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

22{-# LANGUAGE CPP #-}

33{-# LANGUAGE ConstraintKinds #-}

44{-# LANGUAGE DataKinds #-}

5+{-# LANGUAGE DeriveFunctor #-}

56{-# LANGUAGE DeriveTraversable #-}

67{-# LANGUAGE EmptyDataDecls #-}

78{-# LANGUAGE FlexibleContexts #-}

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

4849 , HydrationMode (..)

4950 , HydrationRunnerT (..)

5051 , runHydrationRunnerT

51− , runHydrationRunnerTWithFailure

5252 , ImmediateDomBuilderT

5353 , runHydrationDomBuilderT

5454 , getHydrationMode

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

294294runHydrationRunnerT

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

296296 => 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

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

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

305299 traverse_ removeSubsequentNodes $ _hydrationState_previousNode s'

306300 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

308301 pure a

309302

310−

311−

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

313304 {-# INLINABLE newEventWithTrigger #-}

314305 newEventWithTrigger = lift . newEventWithTrigger

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

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

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

334325{-# INLINABLE addHydrationStepWithSetup #-}

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

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

336327addHydrationStepWithSetup setup f = getHydrationMode >>= \case

337328 HydrationMode_Immediate -> pure ()

338329 HydrationMode_Hydrating -> do

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

937928 doc <- askDocument

938929 -- Expected initial value from config

939930 let v0 = _inputElementConfig_initialValue cfg

940− c0 = _inputElementConfig_initialChecked cfg

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'

931+ addHydrationStep $ do

948932 domElement <- liftIO $ readIORef domElementRef

949933 let domInputElement = uncheckedCastTo DOM.HTMLInputElement domElement

950934 getValue = Input.getValue domInputElement

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

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

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

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

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

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

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

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

960939 -- Watch for user interaction and trigger event accordingly

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

962941 for_ (_inputElementConfig_setValue cfg) $ \eSetValue ->

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

970949 ]

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

972951 requestDomAction_ $ liftIO . triggerFocusChange <$> focusChange'

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

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

952+ Input.setChecked domInputElement $ _inputElementConfig_initialChecked cfg

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

985954 liftIO . triggerCheckedChangedByUI =<< Input.getChecked domInputElement

986955 for_ (_inputElementConfig_setChecked cfg) $ \eNewchecked ->

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

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

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

995964 return ()

996− checked' <- holdDyn c0 $ leftmost

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

997966 [ checkedChangedBySetChecked

998967 , checkedChangedByUI

999968 ]

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

10651034 doc <- askDocument

10661035 -- Expected initial value from config

10671036 let v0 = _textAreaElementConfig_initialValue cfg

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

1069− addHydrationStepWithSetup valueAtSwitchover $ \switchoverValue' -> do

1070− switchoverValue <- sample switchoverValue'

1037+ addHydrationStep $ do

10711038 domElement <- liftIO $ readIORef domElementRef

10721039 let domTextAreaElement = uncheckedCastTo DOM.HTMLTextAreaElement domElement

10731040 getValue = TextArea.getValue domTextAreaElement

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

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

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

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

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

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

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

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

10831045 -- Watch for user interaction and trigger event accordingly

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

10851047 for_ (_textAreaElementConfig_setValue cfg) $ \eSetValue ->

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

18761838 getHydrationMode >>= \case

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

18781840 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

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

18801842 liftIO $ writeIORef placeholders $! phs

18811843 insertAfterPreviousNode lastPlaceholder

18821844 HydrationMode_Immediate -> do

18831845 let activate i = do

18841846 append $ toNode $ _traverseChildImmediate_fragment i

18851847 pure $ _traverseChildImmediate_placeholder i

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

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

18871849 liftIO $ writeIORef placeholders $! phs

18881850 append $ toNode lastPlaceholder

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

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

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

3737import qualified Data.IntMap as IntMap

3838import qualified Data.Map as Map

3939import Data.Map.Misc (applyMap)

40−import Data.Maybe (fromMaybe)

4140import Data.Monoid ((<>))

4241import qualified Data.Set as Set

4342import Data.Text (Text)

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

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

275274 shouldEscape <- asks _staticDomBuilderEnv_shouldEscape

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

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

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

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

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

280279 return $ CommentNode ()

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

312311 return (e, result)

313312 {-# INLINABLE inputElement #-}

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

331− v <- case _inputElementConfig_setValue cfg of

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

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

334− c <- case _inputElementConfig_setChecked cfg of

335− Nothing -> pure $ constDyn $ _inputElementConfig_initialChecked cfg

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

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

315+ let v0 = constDyn $ cfg ^. inputElementConfig_initialValue

316+ let c0 = constDyn $ cfg ^. inputElementConfig_initialChecked

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

338318 return $ InputElement

339− { _inputElement_value = v

340− , _inputElement_checked = c

319+ { _inputElement_value = v0

320+ , _inputElement_checked = c0

341321 , _inputElement_checkedChange = never

342322 , _inputElement_input = never

343323 , _inputElement_hasFocus = hasFocus

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

347327 }

348328 {-# INLINABLE textAreaElement #-}

349329 textAreaElement cfg = do

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

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

330+ --TODO: Support setValue event

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

332+ let v0 = constDyn $ cfg ^. textAreaElementConfig_initialValue

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

359334 return $ TextAreaElement

360− { _textAreaElement_value = v

335+ { _textAreaElement_value = v0

361336 , _textAreaElement_input = never

362337 , _textAreaElement_hasFocus = hasFocus

363338 , _textAreaElement_element = e

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

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

55{-# LANGUAGE GADTs #-}

66{-# LANGUAGE MultiParamTypeClasses #-}

77{-# LANGUAGE NoMonomorphismRestriction #-}

8+{-# LANGUAGE PatternSynonyms #-}

89{-# LANGUAGE RankNTypes #-}

910{-# LANGUAGE RecursiveDo #-}

1011{-# LANGUAGE ScopedTypeVariables #-}

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

7273{-# INLINABLE mainHydrationWidgetWithSwitchoverAction' #-}

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

7475mainHydrationWidgetWithSwitchoverAction' :: 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 ()

81−mainHydrationWidgetWithSwitchoverActionWithFailure' onFailure switchoverAction head' body = do

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

76+mainHydrationWidgetWithSwitchoverAction' switchoverAction head' body = do

77+ runHydrationWidgetWithHeadAndBody switchoverAction $ \appendHead appendBody -> do

8378 appendHead head'

8479 appendBody body

8580

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

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

9590 )

9691 -> 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

11293 hydrationMode <- liftIO $ newIORef HydrationMode_Hydrating

11394 rootNodesRef <- liftIO $ newIORef []

11495 events <- newChan

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

124105 rootNodes <- liftIO $ readIORef rootNodesRef

125106 let delayedAction = do

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

127− let hydrate = runHydrationRunnerTWithFailure runner onFailure Nothing rootNode events

108+ let hydrate = runHydrationRunnerT runner Nothing rootNode events

128109 void $ runWithJSContextSingleton (runPostBuildT hydrate never) jsSing

129110 liftIO $ writeIORef hydrationMode HydrationMode_Immediate

130111 runWithJSContextSingleton (DOM.liftJSM switchoverAction) jsSing

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

145126 -> FloatingWidget () ()

146127 )

147128 -> 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

160130 globalDoc <- currentDocumentUnchecked

161131 headElement <- getHeadUnchecked globalDoc

162132 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

164134 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef

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

166136 hydrateDom n w = do

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

117117 "overflow" =: "hidden" <>

118118 "position" =: "relative"

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

121121 "position" =: "absolute" <>

122122 "width" =: "100%"

123123 findWindow sizeIncrement windowSize startingPosition =

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

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

1−import Language.Haskell.HLint (hlint)

1+import Language.Haskell.HLint3 (hlint)

22import System.Exit (exitFailure, exitSuccess)

44main :: IO ()

reflex-dom-core/test/hydration.hs+39−352

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

2020

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

2222

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−

3123import Prelude hiding (fail)

3224import Control.Concurrent

3325import qualified Control.Concurrent.Async as Async

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

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

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

156148 chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags

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

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

158150

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

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

160152tests withDebugging wdConfig caps _selenium = do

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

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

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

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

164156 runWD m = runWDOptions (WdOptions False) $ do

165157 putStrLnDebug "before"

166158 r <- m

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

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

170162 testWidgetStatic = testWidgetStaticDebug withDebugging

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

172− testWidget = testWidgetDebug True withDebugging

164+ testWidget = testWidgetDebug withDebugging

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

174− testWidget' = testWidgetDebug' True withDebugging

175− session' "text" $ do

166+ testWidget' = testWidgetDebug' withDebugging

167+ describe "text" $ session' $ do

176168 it "works" $ runWD $ do

177169 testWidgetStatic (checkBodyText "hello world") $ do

178170 text "hello world"

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

233225 click <- button ""

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

235227

236− session' "element" $ do

228+ describe "element" $ session' $ do

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

238230 clickedRef <- liftIO $ newRef False

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

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

297289 let click = domEvent Click e

298290 return ()

299291

300− session' "inputElement" $ do

301− describe "static renderer" $ 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

292+ describe "inputElement" $ do

293+ describe "hydration" $ session' $ do

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

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

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

361296 testWidget'

362297 (do

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

364− WD.sendKeys "world" e

299+ WD.sendKeys "hello world" e

365300 pure e)

366301 (\e -> do

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

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

369304 readRef inputRef `shouldBeWithRetryM` "hello world"

370305 ) $ do

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

306+ e <- inputElement def

372307 click <- button "save"

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

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

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

425360 checkedByUIRef <- newRef False

426361 checkedRef <- newRef False

427362 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

363+ let checkValue = do

433364 readRef checkedByUIRef `shouldBeWithRetryM` False

434365 readRef checkedRef `shouldBeWithRetryM` False

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

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

436367 WD.moveToCenter e

437368 WD.click e

438369 readRef checkedByUIRef `shouldBeWithRetryM` True

439370 readRef checkedRef `shouldBeWithRetryM` True

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

441371 liftIO $ writeChan setCheckedChan False

442372 readRef checkedByUIRef `shouldBeWithRetryM` True

443373 readRef checkedRef `shouldBeWithRetryM` False

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

445− testWidget' checkStatic checkValue $ do

374+ testWidget (pure ()) checkValue $ do

446375 setChecked <- triggerEventWithChan setCheckedChan

447376 e <- inputElement $ def

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

449378 & inputElementConfig_setChecked .~ setChecked

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

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

471381 it "captures file uploads" $ runWD $ do

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

473383 let uploadFile = do

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

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

484394 names <- liftJSM $ traverse File.getName fs

485395 liftIO $ writeRef filesRef names

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

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

396+

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

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

598399 inputRef :: IORef Text <- newRef ""

599400 let checkValue = do

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

673474 names <- liftJSM $ traverse File.getName fs

674475 liftIO $ writeRef filesRef names

675476

676− session' "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

477+ describe "textAreaElement" $ do

478+ describe "hydration" $ session' $ do

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

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

703481 testWidget'

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

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

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

765543 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

848544

849− describe "hydration/immediate" $ do

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

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

851547 inputRef :: IORef Text <- newRef ""

852548 let checkValue = do

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

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

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

890586

891− session' "selectElement" $ do

587+ describe "selectElement" $ do

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

893589 options = do

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

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

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

897− describe "hydration" $ do

593+ describe "hydration" $ session' $ do

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

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

900596 let setup = do

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

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

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

970666

971− describe "hydration/immediate" $ do

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

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

973669 inputRef :: IORef Text <- newRef ""

974670 let checkValue = do

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

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

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

1016712

1017− session' "prerender" $ do

713+ describe "prerender" $ session' $ do

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

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

1020716 prerender_ (text "One") (text "Two")

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

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

1084780 textNode $ TextNodeConfig "Initial" $ Just e

1085781

1086− session' "namespaces" $ do

782+ describe "namespaces" $ session' $ do

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

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

1089785 let svgRootCfg = def

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

1092788 void $ element "svg" svgRootCfg $ do

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

1094790

1095− session' "runWithReplace" $ do

791+ describe "runWithReplace" $ session' $ do

1096792 it "works" $ runWD $ do

1097793 replaceChan :: Chan Text <- liftIO newChan

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

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

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

1267963 text "|after"

1268964 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

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

1272966 replaceChan :: Chan () <- liftIO newChan

1273967 let

1274968 preSwitchover = do

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

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

1291985 text "|after"

1292986

1293− session' "traverseDMapWithKeyWithAdjust" $ do

987+ describe "traverseDMapWithKeyWithAdjust" $ session' $ do

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

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

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

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

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

13941088 liftIO $ dmap `H.shouldBe` keyMap

13951089

1396− session' "traverseIntMapWithKeyWithAdjust" $ do

1090+ describe "traverseIntMapWithKeyWithAdjust" $ session' $ do

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

13981092 intMap = IntMap.fromList

13991093 [ (1, "one")

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

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

15011195 liftIO $ dmap `H.shouldBe` intMap

15021196

1503− session' "traverseDMapWithKeyWithAdjustWithMove" $ do

1197+ describe "traverseDMapWithKeyWithAdjustWithMove" $ session' $ do

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

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

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

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

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

15811275 liftIO $ assertEqual "DMap" initMap dmap

15821276

1583− session' "hydrating invalid HTML" $ do

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

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

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

15851279 let preSwitchover = do

15861280 checkBodyText "before\ninner\nafter"

15871281 -- Two tags should be present

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

15981292 shouldContainText "before\ninner\nafter" p1

15991293 elementShouldBeRemoved ol

16001294 elementShouldBeRemoved p2

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

1602− testWidgetDebug' False withDebugging preSwitchover check $ do

1295+ testWidget' preSwitchover check $ do

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

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

16051298 el "p" $ do

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

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

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

16121305 -- 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

1306+ describe "dropdown" $ session' $ do

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

16151308 let doCheck = do

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

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

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

17261419 -- ^ Widget we are testing

17271420 -> WD b

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

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

17291422

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

17311424testWidgetDebug

17321425 :: Bool

1733− -> Bool

17341426 -> WD ()

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

17361428 -> WD b

@@ -1738,16 +1430,12 @@ testWidgetDebug

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

17391431 -- ^ Widget we are testing

17401432 -> WD b

1741−testWidgetDebug hardFailure withDebugging beforeJS afterSwitchover =

1742− testWidgetDebug' hardFailure withDebugging beforeJS (const afterSwitchover)

1743−

1744−data HydrationFailedException = HydrationFailedException deriving Show

1745−instance Exception HydrationFailedException

1433+testWidgetDebug withDebugging beforeJS afterSwitchover =

1434+ testWidgetDebug' withDebugging beforeJS (const afterSwitchover)

17461435

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

17481437testWidgetDebug'

17491438 :: Bool

1750− -> Bool

17511439 -> WD a

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

17531441 -> (a -> WD b)

@@ -1755,7 +1443,7 @@ testWidgetDebug'

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

17561444 -- ^ Widget we are testing (contents of body)

17571445 -> WD b

1758−testWidgetDebug' hardFailure withDebugging beforeJS afterSwitchover bodyWidget = do

1446+testWidgetDebug' withDebugging beforeJS afterSwitchover bodyWidget = do

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

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

17611449 staticApp = do

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

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

17681456 putStrLnDebug "rendered static"

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

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

17711458 waitUntilSwitchover <- liftIO newEmptyMVar -- Empty until switchover

17721459 let entryPoint = do

17731460 putStrLnDebug "taking waitBeforeJS"

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

17791466 liftIO $ putMVar waitUntilSwitchover ()

17801467 putStrLnDebug "put waitUntilSwitchover"

17811468 putStrLnDebug "running mainHydrationWidgetWithSwitchoverAction"

1782− mainHydrationWidgetWithSwitchoverActionWithFailure' onFailure switchOverAction blank bodyWidget

1469+ mainHydrationWidgetWithSwitchoverAction switchOverAction blank bodyWidget

17831470 putStrLnDebug "syncPoint after mainHydrationWidgetWithSwitchoverAction"

17841471 syncPoint

17851472 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−

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

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

11# Revision history for reflex-dom

3−## 0.6.1.0-r1

4−

5−* Loosen reflex-dom-core version bounds

6−

73## 0.6.1.0

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

reflex-dom/reflex-dom.cabal+4−4

@@ -1,6 +1,6 @@

11cabal-version: 1.24

22Name: reflex-dom

3−Version: 0.6.1.0

3+Version: 0.6.0.0

44Synopsis: Functional Reactive Web Apps with Reflex

55Description:

66 Web applications without callbacks or side-effects.

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

6161 hs-source-dirs: src-android

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

6363 build-depends:

64− aeson >= 1.4 && < 1.6,

64+ aeson >= 1.4 && < 1.5,

6565 android-activity == 0.1.*,

6666 data-default == 0.7.*,

6767 jsaddle >= 0.9.6 && < 0.10

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

7171 cpp-options: -DANDROID

7272 build-tools: hsc2hs

7373 build-depends:

74− base >= 4.7 && < 4.15,

74+ base >= 4.7 && < 4.14,

7575 bytestring == 0.10.*,

7676 reflex >= 0.8 && < 0.9,

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

77+ reflex-dom-core == 0.6.1.0,

7878 text == 1.2.*

7979 if !impl(ghcjs)

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