69fc82c · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Merge branch 'ts-hydration' of github.com:reflex-frp/reflex-dom into ts-hydration

69fc82cTom Smalley8 years ago

reflex-dom-core/default.nix+18−15

compare with develop

unifiedsplit

@@ -1,13 +1,14 @@

1−{ mkDerivation, ghc, aeson, base, bifunctors, bimap, blaze-builder

1+{ mkDerivation, aeson, base, bifunctors, bimap, blaze-builder

2−, bytestring, constraints, containers, contravariant, data-default

2+, bytestring, constraints, constraints-extras, containers

3+, contravariant, data-default, dependent-map, dependent-sum

3−, dependent-map, dependent-sum, dependent-sum-template, directory

4+, dependent-sum-template, directory, exception-transformers

4−, exception-transformers, exceptions, ghcjs-dom, hlint, hspec

5+, exceptions, filepath, ghcjs-dom, hlint, hspec, http-types, HUnit

5−, http-types, HUnit, jsaddle, jsaddle-warp, keycode, lens

6+, jsaddle, jsaddle-warp, keycode, lens, linux-namespaces

6−, linux-namespaces, monad-control, mtl, network-uri, primitive

7+, monad-control, mtl, network, network-uri, primitive, process

7−, process, random, ref-tf, reflex, semigroups, silently, stdenv

8+, random, ref-tf, reflex, semigroups, silently, stdenv, stm

8−, stm, template-haskell, temporary, text, these, transformers, unix

9+, template-haskell, temporary, text, these, transformers, unix, wai

9−, wai, wai-websockets, warp, webdriver, websockets, zenc

10+, wai-websockets, warp, webdriver, websockets, zenc

10−, iproute, chromium, hashable, selenium-server-standalone

11+, ghc, iproute, chromium, hashable, selenium-server-standalone, which

11}:

12}:

12let addGcTestDepends = drv: if stdenv.system != "x86_64-linux" then drv else drv // {

13let addGcTestDepends = drv: if stdenv.system != "x86_64-linux" then drv else drv // {

13 testHaskellDepends = (drv.testHaskellDepends or []) ++ [ temporary jsaddle-warp process linux-namespaces ];

14 testHaskellDepends = (drv.testHaskellDepends or []) ++ [ temporary jsaddle-warp process linux-namespaces ];

@@ -39,12 +40,14 @@ in mkDerivation (addGcTestDepends {

39 # Show some output while running tests, so we might notice what's wrong

40 # Show some output while running tests, so we might notice what's wrong

40 testTarget = "--show-details=streaming";

41 testTarget = "--show-details=streaming";

42− testSystemDepends = [ selenium-server-standalone ];

43+ testSystemDepends = [ selenium-server-standalone which ];

43 testHaskellDepends = [

44 testHaskellDepends = [

44− aeson base bytestring containers exceptions ghcjs-dom hlint hspec

45+ aeson base bytestring constraints constraints-extras containers

46+ dependent-map dependent-sum dependent-sum-template directory

47+ exceptions filepath ghcjs-dom hlint hspec http-types HUnit jsaddle

45− http-types HUnit jsaddle jsaddle-warp linux-namespaces process

48+ jsaddle-warp lens linux-namespaces network process random reflex

46− random reflex silently temporary text unix wai wai-websockets warp

49+ silently temporary text unix wai wai-websockets warp webdriver

47− webdriver websockets

50+ websockets

48 ];

51 ];

49 description = "Functional Reactive Web Apps with Reflex";

52 description = "Functional Reactive Web Apps with Reflex";

50 license = stdenv.lib.licenses.bsd3;

53 license = stdenv.lib.licenses.bsd3;

reflex-dom-core/reflex-dom-core.cabal+2−1

@@ -171,8 +171,9 @@ test-suite hydration

171 , jsaddle

172 , jsaddle-warp

173 , lens

174+ , network

174 , random

175 , random

175− , reflex == 0.5.*

176+ , reflex

176 , reflex-dom-core

177 , reflex-dom-core

177 , process

178 , process

178 , silently

179 , silently

reflex-dom-core/test/hydration.hs+42−12

@@ -34,6 +34,7 @@ import Data.Text (Text)

34import Language.Javascript.JSaddle (syncPoint, liftJSM)

35import Language.Javascript.JSaddle.Warp

36import Network.HTTP.Types (status200)

37+import Network.Socket

37import Network.Wai

38import Network.Wai

38import Network.WebSockets

39import Network.WebSockets

39import Reflex.Dom.Builder.Immediate (GhcjsDomSpace)

40import Reflex.Dom.Builder.Immediate (GhcjsDomSpace)

@@ -45,7 +46,7 @@ import System.IO.Temp

45import System.Process

46import System.Process

46import System.Timeout

47import System.Timeout

47import Test.HUnit (assertEqual, assertFailure)

48import Test.HUnit (assertEqual, assertFailure)

48−import Test.Hspec (hspec, it, describe, beforeAll, shouldBe)

49+import Test.Hspec (Spec, parallel, hspec, it, describe, shouldBe)

49import Test.WebDriver (WD)

50import Test.WebDriver (WD)

51import qualified Data.ByteString.Lazy as LBS

52import qualified Data.ByteString.Lazy as LBS

@@ -60,8 +61,8 @@ import qualified Test.WebDriver as WD

60testTimeLimit :: Int

61testTimeLimit :: Int

61testTimeLimit = 5 * 1000 * 1000

62testTimeLimit = 5 * 1000 * 1000

63−chromeConfig :: WD.WDConfig

64+chromeConfig :: Text -> WD.WDConfig

64−chromeConfig = WD.useBrowser (WD.chrome { WD.chromeBinary = Just "/run/current-system/sw/bin/chromium", WD.chromeOptions = ["--headless"]}) WD.defaultConfig

65+chromeConfig fp = WD.useBrowser (WD.chrome { WD.chromeBinary = Just $ T.unpack fp, WD.chromeOptions = ["--headless"] }) WD.defaultConfig

66keyMap :: DMap DKey Identity

67keyMap :: DMap DKey Identity

67keyMap = DMap.fromList

68keyMap = DMap.fromList

@@ -105,8 +106,11 @@ instance EqTag DKey Identity where

105 eqTagged Key_Bool Key_Bool = (==)

106 eqTagged Key_Bool Key_Bool = (==)

106

107

107main :: IO ()

108main :: IO ()

108−main = hspec $ beforeAll startSeleniumServer $ do

109+main = withSeleniumServer $ \selenium ->

110+ hspec (parallel (tests selenium)) `finally` _selenium_stopServer selenium

109

111

112+tests :: Selenium -> Spec

113+tests _selenium = do

110 describe "text" $ do

114 describe "text" $ do

111 it "works" $ do

115 it "works" $ do

112 testWidgetStatic (checkBodyText "hello world") $ do

116 testWidgetStatic (checkBodyText "hello world") $ do

@@ -1003,15 +1007,29 @@ main = hspec $ beforeAll startSeleniumServer $ do

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

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

1004 liftIO $ dmap `shouldBe` keyMap

1008 liftIO $ dmap `shouldBe` keyMap

1005

1009

1010+data Selenium = Selenium

1011+ { _selenium_portNumber :: PortNumber

1012+ , _selenium_stopServer :: IO ()

1013+ }

1014+

1006−startSeleniumServer :: IO ()

1015+startSeleniumServer :: PortNumber -> IO (IO ())

1007−startSeleniumServer = do

1016+startSeleniumServer port = do

1008− (_,_,_,ph) <- createProcess $ (proc "selenium-server" [])

1017+ (_,_,_,ph) <- createProcess $ (proc "selenium-server" ["-port", show port])

1009 { std_in = NoStream

1018 { std_in = NoStream

1010 , std_out = NoStream

1019 , std_out = NoStream

1011 , std_err = NoStream

1020 , std_err = NoStream

1012 }

1021 }

1013− _ <- forkIO $ print =<< waitForProcess ph

1022+ return $ terminateProcess ph

1023+

1024+withSeleniumServer :: (Selenium -> IO ()) -> IO ()

1025+withSeleniumServer f = do

1026+ let port = 4444 -- TODO port <- getFreePort

1027+ stopServer <- startSeleniumServer port

1014 threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on

1028 threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on

1029+ f $ Selenium

1030+ { _selenium_portNumber = port

1031+ , _selenium_stopServer = stopServer

1032+ }

1015

1033

1016triggerEventWithChan :: (Reflex t, TriggerEvent t m, Prerender t m) => Chan a -> m (Event t a)

1034triggerEventWithChan :: (Reflex t, TriggerEvent t m, Prerender t m) => Chan a -> m (Event t a)

1017triggerEventWithChan chan = do

1035triggerEventWithChan chan = do

@@ -1088,13 +1106,14 @@ testWidget' beforeJS afterSwitchover bodyWidget = maybe (error "test timed out")

1088 mainHydrationWidgetWithSwitchoverAction (putMVar waitUntilSwitchover ()) (pure ()) $ bodyWidget

1106 mainHydrationWidgetWithSwitchoverAction (putMVar waitUntilSwitchover ()) (pure ()) $ bodyWidget

1089 syncPoint

1107 syncPoint

1090 application <- jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse -> sendResponse $ responseLBS status200 [] $ "<!doctype html>\n" <> LBS.fromStrict html

1108 application <- jsaddleOr defaultConnectionOptions entryPoint $ \_ sendResponse -> sendResponse $ responseLBS status200 [] $ "<!doctype html>\n" <> LBS.fromStrict html

1091− --port <- randomRIO (3000, 50000)

1109+ port <- getFreePort

1092− let port = 3911 -- TODO

1093− let settings = Warp.setPort port Warp.defaultSettings

1110+ let settings = Warp.setPort (fromIntegral $ toInteger port) Warp.defaultSettings

1094 -- hSilence to get rid of ConnectionClosed logs

1111 -- hSilence to get rid of ConnectionClosed logs

1095 jsaddleWarp = forkIO $ hSilence [stderr] $ Warp.runSettings settings application

1112 jsaddleWarp = forkIO $ hSilence [stderr] $ Warp.runSettings settings application

1096 bracket jsaddleWarp killThread $ \_ -> do

1113 bracket jsaddleWarp killThread $ \_ -> do

1114+ browserPath <- T.strip . T.pack <$> readProcess "which" [ "chromium" ] ""

1115+ when (T.null browserPath) $ fail "No browser was found"

1097− WD.runSession chromeConfig . WD.finallyClose $ do

1116+ WD.runSession (chromeConfig browserPath) . WD.finallyClose $ do

1098 WD.openPage $ "http://localhost:" <> show port

1117 WD.openPage $ "http://localhost:" <> show port

1099 a <- beforeJS

1118 a <- beforeJS

1100 liftIO $ putMVar waitBeforeJS ()

1119 liftIO $ putMVar waitBeforeJS ()

@@ -1102,6 +1121,17 @@ testWidget' beforeJS afterSwitchover bodyWidget = maybe (error "test timed out")

1102 liftIO $ threadDelay 100000 -- wait a bit

1121 liftIO $ threadDelay 100000 -- wait a bit

1103 afterSwitchover a

1122 afterSwitchover a

1104

1123

1124+-- TODO: Should this be part of more widely used module?

1125+getFreePort :: MonadIO m => m PortNumber

1126+getFreePort = liftIO $ withSocketsDo $ do

1127+ addr:_ <- getAddrInfo (Just defaultHints) (Just "127.0.0.1") (Just "0")

1128+ bracket (open addr) close socketPort

1129+ where

1130+ open addr = do

1131+ sock <- socket (addrFamily addr) (addrSocketType addr) (addrProtocol addr)

1132+ bind sock (addrAddress addr)

1133+ return sock

1134+

1105testWidgetDebug :: (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> IO ()

1135testWidgetDebug :: (forall m js. TestWidget js (SpiderTimeline Global) m => m ()) -> IO ()

1106testWidgetDebug bodyWidget = do

1136testWidgetDebug bodyWidget = do

1107 let staticApp = do

1137 let staticApp = do