Cleanup selenium testing library

- Move to Reflex.Dom.Test.Selenium, screenshots are not part of this library.
- Fix the nested hspec issue in the main function
- Add utility function for embedding different spec types
- More configurable stuff

cabal.project

@@ -1 +1 @@
-packages: reflex-dom-core, reflex-dom, reflex-dom-test-selenium
+packages: chrome-test-utils, reflex-dom-core, reflex-dom, reflex-dom-test-selenium

reflex-dom-test-selenium/reflex-dom-test-selenium.cabal

@@ -19,22 +19,23 @@ library
     bytestring == 0.10.*,
     chrome-test-utils,
     exceptions,
+    hspec-core,
+    hspec-webdriver >= 1.2.1,
+    http-types,
     jsaddle >= 0.9.0.0 && < 0.10,
     jsaddle-warp,
-    http-types,
     network,
-    reflex-dom-core,
     process,
+    reflex-dom-core,
     silently,
+    text == 1.2.*,
     wai,
     warp,
-    text == 1.2.*,
-    websockets,
-    hspec-webdriver,
-    webdriver
+    webdriver,
+    websockets
 
   exposed-modules:
-    Reflex.Dom.Test.Screenshot
+    Reflex.Dom.Test.Selenium
 
   default-language: Haskell98
   ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans -fspecialise-aggressively

reflex-dom-test-selenium/src/Reflex/Dom/Test/Selenium.hs

@@ -9,16 +9,24 @@
 
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-module Reflex.Dom.Test.Screenshot
+-- | Utilities for testing reflex-dom widgets with Selenium.
+--
+-- Any uses of the 'testWidget' functions will start a jsaddle warp server and
+-- serve the given widget in an otherwise empty page. Webdriver commands can run
+-- on the statically rendered page, and on the hydrated page.
+module Reflex.Dom.Test.Selenium
   ( TestWidget
   , TestWidgetConfig (..)
   , testWidget, testWidget', testWidgetStatic, testWidgetHydrated
-  , testWithSelenium
+  , withSeleniumSpec
+  , embedSpec
+  , SeleniumSetupConfig (..)
   ) where
 
 import Control.Concurrent (threadDelay, newEmptyMVar, takeMVar, putMVar)
-import Control.Monad (when, void)
-import Control.Monad.Catch (MonadMask, handle, finally)
+import Control.Exception (throwIO)
+import Control.Monad (when)
+import Control.Monad.Catch (MonadMask, handle)
 import Control.Monad.Fix (MonadFix)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Text (Text)
@@ -32,50 +40,48 @@ import Reflex.Dom.Core
 import System.IO (stderr)
 import System.IO.Silently (hSilence)
 import System.Process (std_in, std_out, std_err, createProcess, proc, StdStream (..), terminateProcess)
-import qualified Data.Text as T
-
-import qualified Control.Concurrent.Async as Async
-import qualified Data.Text.Encoding as TE
-import qualified Data.ByteString.Lazy as LBS
-import qualified Network.Wai.Handler.Warp as Warp
-
-import Test.Hspec.WebDriver (SpecWith, WdTestSession, hspec, sessionWith, using)
+import Test.Hspec.WebDriver (Spec, SpecWith, WdTestSession, sessionWith, using)
 import Test.Util.ChromeFlags
 import Test.Util.UnshareNetwork
 import Test.WebDriver (WD)
+
+import qualified Control.Concurrent.Async as Async
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as TE
+import qualified Network.Wai.Handler.Warp as Warp
+import qualified Test.Hspec.Core.Spec as Hspec
 import qualified Test.WebDriver as WD
 import qualified Test.WebDriver.Capabilities as WD
 
 deriving instance MonadMask WD
 
-testWithSelenium
-  :: FilePath
+data SeleniumSetupConfig = SeleniumSetupConfig
+  { _seleniumSetupConfig_chromiumPath :: FilePath
   -- ^ Path to the chromium executable
-  -> Bool
+  , _seleniumSetupConfig_headless :: Bool
   -- ^ True means that the browser is invoked in headless mode, False means that
   -- the user can see the interaction happening on the browser (useful for debugging).
-  -> SpecWith (WdTestSession a)
-  -- ^ The tests we want to write in the selenium session
-  -> IO ()
-testWithSelenium chromium isHeadless actualTests = do
-  handle (\(_ :: IOError) -> return ()) $ unshareNetork -- If we run into an exception with sandboxing, just don't bother
-  withSandboxedChromeFlags isHeadless $ \chromeFlags -> do
-    withSeleniumServer $ \selenium -> do
-      let browserPath = T.strip $ T.pack chromium
-      when (T.null browserPath) $ fail "No browser found"
-      let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium }
-          chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags
-      hspec (sessionWith wdConfig "" . using [(chromeCaps', "")] $ actualTests) `finally` _selenium_stopServer selenium
-
-seleniumPort, jsaddlePort :: PortNumber
-seleniumPort = 8000
-jsaddlePort = 8001
-
-data Selenium = Selenium
-  { _selenium_portNumber :: PortNumber
-  , _selenium_stopServer :: IO ()
+  , _seleniumSetupConfig_seleniumPort :: PortNumber
+  -- ^ The port number used by selenium
   }
 
+-- | Setup a selenium server and use it to run some hspec tests.
+--
+-- withSeleniumSpec config $ \runSession -> hspec $ do
+--  describe "tests using webdriver session" $ runSession $ do
+--    webdriver tests here
+withSeleniumSpec :: SeleniumSetupConfig -> ((forall multi. SpecWith (WdTestSession multi) -> Spec) -> IO a) -> IO a
+withSeleniumSpec config runSpec = do
+  liftIO $ handle (\(_ :: IOError) -> return ()) $ unshareNetork -- If we run into an exception with sandboxing, just don't bother
+  withSandboxedChromeFlags (_seleniumSetupConfig_headless config) $ \chromeFlags -> do
+    withSeleniumServer (_seleniumSetupConfig_seleniumPort config) $ do
+      let browserPath = T.strip $ T.pack $ _seleniumSetupConfig_chromiumPath config
+      when (T.null browserPath) $ fail "No browser found"
+      let wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _seleniumSetupConfig_seleniumPort config }
+          chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags
+      runSpec $ sessionWith wdConfig "" . using [(chromeCaps', "chrome")]
+
 startSeleniumServer :: PortNumber -> IO (IO ())
 startSeleniumServer port = do
   (_,_,_,ph) <- createProcess $ (proc "selenium-server" ["-port", show port])
@@ -85,14 +91,10 @@ startSeleniumServer port = do
     }
   return $ terminateProcess ph
 
-withSeleniumServer :: (Selenium -> IO ()) -> IO ()
-withSeleniumServer f = do
-  stopServer <- startSeleniumServer seleniumPort
+withSeleniumServer :: PortNumber -> IO a -> IO a
+withSeleniumServer port f = bracket (startSeleniumServer port) id $ \_ -> do
   threadDelay $ 1000 * 1000 * 2 -- TODO poll or wait on a a signal to block on
-  f $ Selenium
-    { _selenium_portNumber = seleniumPort
-    , _selenium_stopServer = stopServer
-    }
+  f
 
 chromeConfig :: Text -> [Text] -> WD.WDConfig
 chromeConfig fp flags =
@@ -104,20 +106,25 @@ chromeConfig fp flags =
 -- Function to test widgets
 --------------------------------------------------------------------------------
 
+-- | The environment in which your widgets can be tested
 type TestWidget js t m =
   (DomBuilder t m, MonadHold t m, PostBuild t m
   , Prerender js t m, PerformEvent t m, TriggerEvent t m
   , MonadFix m, MonadIO (Performable m), MonadIO m)
 
+-- | Configuration of individual tests
 data TestWidgetConfig = TestWidgetConfig
-  { testWidgetConfig_debug :: Bool
+  { _testWidgetConfig_debug :: Bool
   -- ^ If this flag is set to True, during the test we will emit debug messages
-  --   giving insight on our progress in the hydratation progress
-  , testWidgetConfig_headWidget :: (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
+  , _testWidgetConfig_headWidget :: (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
   -- ^ We can add widgets here that will be included in the head of the page
   --   (useful for example to include external js libraries in the tests)
+  , _testWidgetConfig_jsaddlePort :: PortNumber
+  -- ^ Port used by the jsaddle server
   }
 
+-- | Test a widget by running some webdriver commands before and after
+-- hydration.
 testWidget
   :: TestWidgetConfig
   -> WD a
@@ -129,15 +136,18 @@ testWidget
   -> WD b
 testWidget cfg before after widget = testWidget' cfg before (const after) widget
 
+-- | Test a widget by running some webdriver commands before hydration (on the
+-- statically rendered page).
 testWidgetStatic
   :: TestWidgetConfig
-  -> WD ()
+  -> WD a
   -- ^ Webdriver commands to run before the JS runs (i.e. on the statically rendered page)
   -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
   -- ^ Widget we are testing (contents of body)
-  -> WD ()
-testWidgetStatic cfg before widget = testWidget' cfg (void before) (const $ pure ()) widget
+  -> WD a
+testWidgetStatic cfg before widget = testWidget' cfg before pure widget
 
+-- | Test a widget by running some webdriver commands after hydration.
 testWidgetHydrated
   :: TestWidgetConfig
   -> WD b
@@ -147,6 +157,9 @@ testWidgetHydrated
   -> WD b
 testWidgetHydrated cfg after widget = testWidget' cfg (pure ()) (const after) widget
 
+-- | Test a widget by running some webdriver commands before and after
+-- hydration. Like 'testWidget', but you can use the result of the webdriver
+-- commands from before hydration in the post hydration test.
 testWidget'
   :: TestWidgetConfig
   -> WD a
@@ -156,7 +169,7 @@ testWidget'
   -> (forall m js. TestWidget js (SpiderTimeline Global) m => m ())
   -- ^ Widget we are testing (contents of body)
   -> WD b
-testWidget' (TestWidgetConfig withDebugging headWidget) beforeJS afterSwitchover bodyWidget = do
+testWidget' (TestWidgetConfig withDebugging headWidget jsaddlePort) beforeJS afterSwitchover bodyWidget = do
   let putStrLnDebug :: MonadIO m => Text -> m ()
       putStrLnDebug m = when withDebugging $ liftIO $ putStrLn $ T.unpack m
       staticApp = do
@@ -196,8 +209,8 @@ testWidget' (TestWidgetConfig withDebugging headWidget) beforeJS afterSwitchover
             putStrLnDebug "put waitJSaddle"
         ]
       -- hSilence to get rid of ConnectionClosed logs
-      silenceIfDebug = if withDebugging then id else hSilence [stderr]
-      jsaddleWarp = silenceIfDebug $ Warp.runSettings settings application
+      silenceIfNotDebugging = if withDebugging then id else hSilence [stderr]
+      jsaddleWarp = silenceIfNotDebugging $ Warp.runSettings settings application
   withAsync' jsaddleWarp $ do
     putStrLnDebug "taking waitJSaddle"
     liftIO $ takeMVar waitJSaddle
@@ -216,39 +229,21 @@ testWidget' (TestWidgetConfig withDebugging headWidget) beforeJS afterSwitchover
 -- Utilities
 --------------------------------------------------------------------------------
 
+-- | Embed a different spec type by evaluating it directly.
+embedSpec :: (Hspec.Example a, MonadIO m) => Hspec.Arg a -> a -> m ()
+embedSpec arg spec = liftIO $ do
+  Hspec.Result _info status <- Hspec.evaluateExample
+    spec
+    Hspec.defaultParams
+    (\actionWith -> actionWith arg)
+    (\_ -> pure ())
+  case status of
+    Hspec.Success -> pure ()
+    Hspec.Pending _ _ -> pure () -- should not happen
+    failure -> throwIO failure
+
 withAsync' :: (MonadIO m, MonadMask m) => IO a -> m b -> m b
 withAsync' f g = bracket
   (liftIO $ Async.async f)
   (liftIO . Async.uninterruptibleCancel)
   (const g)
-
---------------------------------------------------------------------------------
-
-{- Note: a nicer interface?
-
-This would have lead to a niced interface, but I don't think this solution is
-expressible with the library
-
-data SessionData = SessionData
-  { sessionData_wdConfig :: WD.WDConfig
-  , sessionData_capabilities :: [Capabilities]
-  , sessionData_selenium :: Selenium
-  }
-
-testSpec = around bracketSelenium $ do
-  describe "createRecipe" $ _what
-
-bracketSelenium :: (SessionData -> IO ()) -> IO ()
-bracketSelenium action = do
-  handle (\(_ :: IOError) -> return ()) $ unshareNetork -- If we run into an exception with sandboxing, just don't bother
-  isHeadless <- pure True -- (== Nothing) <$> lookupEnv "NO_HEADLESS"
-  withSandboxedChromeFlags isHeadless $ \chromeFlags -> do
-    withSeleniumServer $ \selenium -> do
-      let browserPath = T.strip $ T.pack chromium
-      when (T.null browserPath) $ fail "No browser found"
-      withDebugging <- isNothing <$> lookupEnv "NO_DEBUG"
-      let
-        wdConfig = WD.defaultConfig { WD.wdPort = fromIntegral $ _selenium_portNumber selenium }
-        chromeCaps' = WD.getCaps $ chromeConfig browserPath chromeFlags
-      action (SessionData wdConfig [chromeCaps'] selenium) `finally` _selenium_stopServer selenium
--}