{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- Because of webdriver using dangerous constructors
{-# OPTIONS_GHC -fno-warn-incomplete-record-updates #-}
-- For the undefined trick
{-# OPTIONS_GHC -fno-warn-unused-pattern-binds #-}

module Test.Syd.Webdriver
  ( -- * Defining webdriver tests
    WebdriverSpec,
    webdriverSpec,
    WebdriverTestM (..),
    runWebdriverTestM,
    WebdriverTestEnv (..),
    webdriverTestEnvSetupFunc,

    -- * Writing webdriver tests
    openPath,
    setWindowSize,

    -- * Running a selenium server
    SeleniumServerHandle (..),
    seleniumServerSetupFunc,
  )
where

import Control.Monad.Base
import Control.Monad.Reader
import Control.Monad.Trans.Control
import Data.Aeson as JSON
import GHC.Stack
import Network.HTTP.Client as HTTP
import Network.Socket
import Network.Socket.Free
import Network.Socket.Wait as Port
import Network.URI
import Path
import Path.IO
import System.Exit
import System.Process.Typed
import Test.Syd
import Test.Syd.Path
import Test.Syd.Process.Typed
import Test.Syd.Wai
import Test.WebDriver as WD hiding (setWindowSize)
import Test.WebDriver.Class (WebDriver (..))
import qualified Test.WebDriver.Commands.Internal as WD
import qualified Test.WebDriver.JSON as WD
import Test.WebDriver.Session (WDSessionState (..))

-- | Type synonym for webdriver tests
type WebdriverSpec app = TestDef '[SeleniumServerHandle, HTTP.Manager] (WebdriverTestEnv app)

-- | A monad for webdriver tests.
-- This instantiates the 'WebDriver' class, as well as the 'IsTest' class.
newtype WebdriverTestM app a = WebdriverTestM
  { forall app a.
WebdriverTestM app a -> ReaderT (WebdriverTestEnv app) WD a
unWebdriverTestM :: ReaderT (WebdriverTestEnv app) WD a
  }
  deriving
    ( forall a b. a -> WebdriverTestM app b -> WebdriverTestM app a
forall a b.
(a -> b) -> WebdriverTestM app a -> WebdriverTestM app b
forall app a b. a -> WebdriverTestM app b -> WebdriverTestM app a
forall app a b.
(a -> b) -> WebdriverTestM app a -> WebdriverTestM app b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> WebdriverTestM app b -> WebdriverTestM app a
$c<$ :: forall app a b. a -> WebdriverTestM app b -> WebdriverTestM app a
fmap :: forall a b.
(a -> b) -> WebdriverTestM app a -> WebdriverTestM app b
$cfmap :: forall app a b.
(a -> b) -> WebdriverTestM app a -> WebdriverTestM app b
Functor,
      forall app. Functor (WebdriverTestM app)
forall a. a -> WebdriverTestM app a
forall app a. a -> WebdriverTestM app a
forall a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app a
forall a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
forall a b.
WebdriverTestM app (a -> b)
-> WebdriverTestM app a -> WebdriverTestM app b
forall app a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app a
forall app a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
forall app a b.
WebdriverTestM app (a -> b)
-> WebdriverTestM app a -> WebdriverTestM app b
forall a b c.
(a -> b -> c)
-> WebdriverTestM app a
-> WebdriverTestM app b
-> WebdriverTestM app c
forall app a b c.
(a -> b -> c)
-> WebdriverTestM app a
-> WebdriverTestM app b
-> WebdriverTestM app c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app a
$c<* :: forall app a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app a
*> :: forall a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
$c*> :: forall app a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
liftA2 :: forall a b c.
(a -> b -> c)
-> WebdriverTestM app a
-> WebdriverTestM app b
-> WebdriverTestM app c
$cliftA2 :: forall app a b c.
(a -> b -> c)
-> WebdriverTestM app a
-> WebdriverTestM app b
-> WebdriverTestM app c
<*> :: forall a b.
WebdriverTestM app (a -> b)
-> WebdriverTestM app a -> WebdriverTestM app b
$c<*> :: forall app a b.
WebdriverTestM app (a -> b)
-> WebdriverTestM app a -> WebdriverTestM app b
pure :: forall a. a -> WebdriverTestM app a
$cpure :: forall app a. a -> WebdriverTestM app a
Applicative,
      forall app. Applicative (WebdriverTestM app)
forall a. a -> WebdriverTestM app a
forall app a. a -> WebdriverTestM app a
forall a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
forall a b.
WebdriverTestM app a
-> (a -> WebdriverTestM app b) -> WebdriverTestM app b
forall app a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
forall app a b.
WebdriverTestM app a
-> (a -> WebdriverTestM app b) -> WebdriverTestM app b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> WebdriverTestM app a
$creturn :: forall app a. a -> WebdriverTestM app a
>> :: forall a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
$c>> :: forall app a b.
WebdriverTestM app a
-> WebdriverTestM app b -> WebdriverTestM app b
>>= :: forall a b.
WebdriverTestM app a
-> (a -> WebdriverTestM app b) -> WebdriverTestM app b
$c>>= :: forall app a b.
WebdriverTestM app a
-> (a -> WebdriverTestM app b) -> WebdriverTestM app b
Monad,
      forall app. Monad (WebdriverTestM app)
forall a. IO a -> WebdriverTestM app a
forall app a. IO a -> WebdriverTestM app a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> WebdriverTestM app a
$cliftIO :: forall app a. IO a -> WebdriverTestM app a
MonadIO,
      MonadReader (WebdriverTestEnv app),
      -- We don't want 'MonadBaseControl IO' or 'MonadBase IO', but we have to
      -- because webdriver uses them.
      MonadBaseControl IO,
      MonadBase IO
    )

data WebdriverTestEnv app = WebdriverTestEnv
  { -- | The base url of the app we test, so that we can test external sites just like local ones.
    forall app. WebdriverTestEnv app -> URI
webdriverTestEnvURI :: !URI,
    -- | The webdriver configuration
    forall app. WebdriverTestEnv app -> WDConfig
webdriverTestEnvConfig :: !WDConfig,
    -- | The app that we'll test.
    --
    -- You can put any piece of data here. In the case of yesod tests, we'll put an @App@ here.
    forall app. WebdriverTestEnv app -> app
webdriverTestEnvApp :: !app
  }

instance WDSessionState (WebdriverTestM app) where
  getSession :: WebdriverTestM app WDSession
getSession = forall app a.
ReaderT (WebdriverTestEnv app) WD a -> WebdriverTestM app a
WebdriverTestM forall (m :: * -> *). WDSessionState m => m WDSession
getSession
  putSession :: WDSession -> WebdriverTestM app ()
putSession = forall app a.
ReaderT (WebdriverTestEnv app) WD a -> WebdriverTestM app a
WebdriverTestM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). WDSessionState m => WDSession -> m ()
putSession

instance WebDriver (WebdriverTestM app) where
  doCommand :: forall a b.
(HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> WebdriverTestM app b
doCommand Method
m Text
p a
a = forall app a.
ReaderT (WebdriverTestEnv app) WD a -> WebdriverTestM app a
WebdriverTestM forall a b. (a -> b) -> a -> b
$ forall (wd :: * -> *) a b.
(WebDriver wd, HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doCommand Method
m Text
p a
a

instance IsTest (WebdriverTestM app ()) where
  type Arg1 (WebdriverTestM app ()) = ()
  type Arg2 (WebdriverTestM app ()) = WebdriverTestEnv app
  runTest :: WebdriverTestM app ()
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (WebdriverTestM app ())
     -> Arg2 (WebdriverTestM app ()) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest WebdriverTestM app ()
wdTestFunc = forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() WebdriverTestEnv app
wdte -> forall app a. WebdriverTestEnv app -> WebdriverTestM app a -> IO a
runWebdriverTestM WebdriverTestEnv app
wdte WebdriverTestM app ()
wdTestFunc)

instance IsTest (WebdriverTestM app (GoldenTest a)) where
  type Arg1 (WebdriverTestM app (GoldenTest a)) = ()
  type Arg2 (WebdriverTestM app (GoldenTest a)) = WebdriverTestEnv app
  runTest :: WebdriverTestM app (GoldenTest a)
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 (WebdriverTestM app (GoldenTest a))
     -> Arg2 (WebdriverTestM app (GoldenTest a)) -> IO ())
    -> IO ())
-> IO TestRunResult
runTest WebdriverTestM app (GoldenTest a)
wdTestFunc = forall e.
IsTest e =>
e
-> TestRunSettings
-> ProgressReporter
-> ((Arg1 e -> Arg2 e -> IO ()) -> IO ())
-> IO TestRunResult
runTest (\() WebdriverTestEnv app
wdte -> forall app a. WebdriverTestEnv app -> WebdriverTestM app a -> IO a
runWebdriverTestM WebdriverTestEnv app
wdte WebdriverTestM app (GoldenTest a)
wdTestFunc)

-- | Run a webdriver test.
runWebdriverTestM :: WebdriverTestEnv app -> WebdriverTestM app a -> IO a
runWebdriverTestM :: forall app a. WebdriverTestEnv app -> WebdriverTestM app a -> IO a
runWebdriverTestM WebdriverTestEnv app
env (WebdriverTestM ReaderT (WebdriverTestEnv app) WD a
func) = forall conf a. WebDriverConfig conf => conf -> WD a -> IO a
WD.runSession (forall app. WebdriverTestEnv app -> WDConfig
webdriverTestEnvConfig WebdriverTestEnv app
env) forall a b. (a -> b) -> a -> b
$
  forall (wd :: * -> *) a. WebDriver wd => wd a -> wd a
WD.finallyClose forall a b. (a -> b) -> a -> b
$ do
    forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Integer -> wd ()
setImplicitWait Integer
10_000
    forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Integer -> wd ()
setScriptTimeout Integer
10_000
    forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Integer -> wd ()
setPageLoadTimeout Integer
10_000
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (WebdriverTestEnv app) WD a
func WebdriverTestEnv app
env

-- | Open a page on the URI in the 'WebdriverTestEnv'.
openPath :: String -> WebdriverTestM app ()
openPath :: forall app. String -> WebdriverTestM app ()
openPath String
p = do
  URI
uri <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall app. WebdriverTestEnv app -> URI
webdriverTestEnvURI
  let url :: String
url = forall a. Show a => a -> String
show URI
uri forall a. Semigroup a => a -> a -> a
<> String
p
  forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
String -> wd ()
openPage String
url

-- We have to override this because it returns something.
-- So we remove the 'noReturn'.
setWindowSize ::
  (HasCallStack, WebDriver wd) =>
  -- | (Width, Height)
  (Word, Word) ->
  wd ()
setWindowSize :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Word, Word) -> wd ()
setWindowSize (Word
w, Word
h) =
  forall (wd :: * -> *). WebDriver wd => wd Value -> wd ()
WD.ignoreReturn forall a b. (a -> b) -> a -> b
$
    forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> WindowHandle -> Text -> a -> wd b
WD.doWinCommand Method
methodPost WindowHandle
currentWindow Text
"/size" forall a b. (a -> b) -> a -> b
$
      [Pair] -> Value
object [Key
"width" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word
w, Key
"height" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Word
h]

webdriverSpec ::
  (HTTP.Manager -> SetupFunc (URI, app)) ->
  WebdriverSpec app ->
  Spec
webdriverSpec :: forall app.
(Manager -> SetupFunc (URI, app)) -> WebdriverSpec app -> Spec
webdriverSpec Manager -> SetupFunc (URI, app)
appSetupFunc =
  forall (outers :: [*]) inner result.
TestDefM (Manager : outers) inner result
-> TestDefM outers inner result
managerSpec
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: [*]) b c.
(Int -> Int) -> TestDefM a b c -> TestDefM a b c
modifyMaxSuccess (forall a. Integral a => a -> a -> a
`div` Int
50)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (outers :: [*]) outer oldInner newInner result.
HContains outers outer =>
(outer -> oldInner -> SetupFunc newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith' (\Manager
man () -> Manager -> SetupFunc (URI, app)
appSetupFunc Manager
man)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall outer (outers :: [*]) inner result.
SetupFunc outer
-> TestDefM (outer : outers) inner result
-> TestDefM outers inner result
setupAroundAll SetupFunc SeleniumServerHandle
seleniumServerSetupFunc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall app.
TestDef '[SeleniumServerHandle, Manager] (WebdriverTestEnv app)
-> TestDef '[SeleniumServerHandle, Manager] (URI, app)
webdriverTestEnvSpec

webdriverTestEnvSpec ::
  TestDef '[SeleniumServerHandle, HTTP.Manager] (WebdriverTestEnv app) ->
  TestDef '[SeleniumServerHandle, HTTP.Manager] (URI, app)
webdriverTestEnvSpec :: forall app.
TestDef '[SeleniumServerHandle, Manager] (WebdriverTestEnv app)
-> TestDef '[SeleniumServerHandle, Manager] (URI, app)
webdriverTestEnvSpec = forall (outers :: [*]) outer oldInner newInner result.
HContains outers outer =>
(outer -> oldInner -> SetupFunc newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith' forall app.
Manager
-> (URI, app)
-> SetupFunc
     (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
go2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (outers :: [*]) outer oldInner newInner result.
HContains outers outer =>
(outer -> oldInner -> SetupFunc newInner)
-> TestDefM outers newInner result
-> TestDefM outers oldInner result
setupAroundWith' forall app.
SeleniumServerHandle
-> (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
-> SetupFunc (WebdriverTestEnv app)
go1
  where
    go1 ::
      SeleniumServerHandle ->
      (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app)) ->
      SetupFunc (WebdriverTestEnv app)
    go1 :: forall app.
SeleniumServerHandle
-> (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
-> SetupFunc (WebdriverTestEnv app)
go1 SeleniumServerHandle
ssh SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app)
func = SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app)
func SeleniumServerHandle
ssh
    go2 ::
      HTTP.Manager ->
      (URI, app) ->
      SetupFunc (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
    go2 :: forall app.
Manager
-> (URI, app)
-> SetupFunc
     (SeleniumServerHandle -> SetupFunc (WebdriverTestEnv app))
go2 Manager
man (URI
uri, app
app) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ \SeleniumServerHandle
ssh -> forall app.
SeleniumServerHandle
-> Manager -> URI -> app -> SetupFunc (WebdriverTestEnv app)
webdriverTestEnvSetupFunc SeleniumServerHandle
ssh Manager
man URI
uri app
app

-- | Set up a 'WebdriverTestEnv' for your app by readying a webdriver session
webdriverTestEnvSetupFunc ::
  SeleniumServerHandle ->
  HTTP.Manager ->
  URI ->
  app ->
  SetupFunc (WebdriverTestEnv app)
webdriverTestEnvSetupFunc :: forall app.
SeleniumServerHandle
-> Manager -> URI -> app -> SetupFunc (WebdriverTestEnv app)
webdriverTestEnvSetupFunc SeleniumServerHandle {PortNumber
seleniumServerHandlePort :: SeleniumServerHandle -> PortNumber
seleniumServerHandlePort :: PortNumber
..} Manager
manager URI
uri app
app = do
  Path Abs File
chromeExecutable <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Path Rel File
chromeFile <- forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile String
"chromium"
    Maybe (Path Abs File)
mExecutable <- forall (m :: * -> *).
MonadIO m =>
Path Rel File -> m (Maybe (Path Abs File))
findExecutable Path Rel File
chromeFile
    case Maybe (Path Abs File)
mExecutable of
      Maybe (Path Abs File)
Nothing -> forall a. String -> IO a
die String
"No chromium found on PATH."
      Just Path Abs File
executable -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Path Abs File
executable

  Path Abs Dir
userDataDir <- String -> SetupFunc (Path Abs Dir)
tempDirSetupFunc String
"chromium-user-data"

  let browser :: Browser
browser =
        Browser
chrome
          { chromeOptions :: [String]
chromeOptions =
              [ String
"--user-data-dir=" forall a. Semigroup a => a -> a -> a
<> Path Abs Dir -> String
fromAbsDir Path Abs Dir
userDataDir,
                String
"--headless",
                -- Bypass OS security model to run on nix as well
                String
"--no-sandbox",
                -- Overcome limited resource problem
                String
"--disable-dev-shm-usage",
                String
"--disable-gpu",
                String
"--use-gl=angle",
                String
"--use-angle=swiftshader",
                String
"--window-size=1920,1080",
                -- So that screenshots tests don't start failing when something new is added at the bottom of the page that isn't even on the screen
                String
"--hide-scrollbars"
              ],
            chromeBinary :: Maybe String
chromeBinary = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Path Abs File -> String
fromAbsFile Path Abs File
chromeExecutable
          }
  let caps :: Capabilities
caps =
        Capabilities
WD.defaultCaps
          { browser :: Browser
browser = Browser
browser
          }
  let webdriverTestEnvConfig :: WDConfig
webdriverTestEnvConfig =
        WDConfig
WD.defaultConfig
          { wdPort :: Int
wdPort = (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: PortNumber -> Int) PortNumber
seleniumServerHandlePort,
            wdHTTPManager :: Maybe Manager
wdHTTPManager = forall a. a -> Maybe a
Just Manager
manager,
            wdCapabilities :: Capabilities
wdCapabilities = Capabilities
caps
          }
  let webdriverTestEnvURI :: URI
webdriverTestEnvURI = URI
uri
      webdriverTestEnvApp :: app
webdriverTestEnvApp = app
app
  forall (f :: * -> *) a. Applicative f => a -> f a
pure WebdriverTestEnv {app
URI
WDConfig
webdriverTestEnvApp :: app
webdriverTestEnvURI :: URI
webdriverTestEnvConfig :: WDConfig
webdriverTestEnvApp :: app
webdriverTestEnvConfig :: WDConfig
webdriverTestEnvURI :: URI
..}

data SeleniumServerHandle = SeleniumServerHandle
  { SeleniumServerHandle -> PortNumber
seleniumServerHandlePort :: PortNumber
  }

-- | Run, and clean up, a selenium server
seleniumServerSetupFunc :: SetupFunc SeleniumServerHandle
seleniumServerSetupFunc :: SetupFunc SeleniumServerHandle
seleniumServerSetupFunc = do
  Path Abs Dir
tempDir <- String -> SetupFunc (Path Abs Dir)
tempDirSetupFunc String
"selenium-server"
  Int
portInt <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
getFreePort
  let processConfig :: ProcessConfig () () ()
processConfig =
        forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
nullStream forall a b. (a -> b) -> a -> b
$
          forall stderr stdin stdout stderr0.
StreamSpec 'STOutput stderr
-> ProcessConfig stdin stdout stderr0
-> ProcessConfig stdin stdout stderr
setStderr forall (anyStreamType :: StreamType). StreamSpec anyStreamType ()
nullStream forall a b. (a -> b) -> a -> b
$
            forall stdin stdout stderr.
String
-> ProcessConfig stdin stdout stderr
-> ProcessConfig stdin stdout stderr
setWorkingDir (Path Abs Dir -> String
fromAbsDir Path Abs Dir
tempDir) forall a b. (a -> b) -> a -> b
$
              String -> [String] -> ProcessConfig () () ()
proc
                String
"selenium-server"
                [ String
"-port",
                  forall a. Show a => a -> String
show Int
portInt
                ]
  Process () () ()
_ <- forall stdin stdout stderr.
ProcessConfig stdin stdout stderr
-> SetupFunc (Process stdin stdout stderr)
typedProcessSetupFunc ProcessConfig () () ()
processConfig
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> Int -> IO ()
Port.wait String
"127.0.0.1" Int
portInt
  let seleniumServerHandlePort :: PortNumber
seleniumServerHandlePort = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
portInt
  forall (f :: * -> *) a. Applicative f => a -> f a
pure SeleniumServerHandle {PortNumber
seleniumServerHandlePort :: PortNumber
seleniumServerHandlePort :: PortNumber
..}