Working on better dependency injection

sandwich-contexts/package.yaml

@@ -39,6 +39,8 @@ library:
   - Test.Sandwich.Contexts.Nix
   - Test.Sandwich.Contexts.PostgreSQL
   - Test.Sandwich.Contexts.Waits
+
+  - Test.Sandwich.Contexts.Util.Ports
   dependencies:
   - aeson
   - bytestring

sandwich-contexts/sandwich-contexts.cabal

@@ -21,14 +21,14 @@ library
       Test.Sandwich.Contexts.Nix
       Test.Sandwich.Contexts.PostgreSQL
       Test.Sandwich.Contexts.Waits
+      Test.Sandwich.Contexts.Util.Ports
   other-modules:
       Test.Sandwich.Contexts.FakeSmtpServer.Derivation
       Test.Sandwich.Contexts.ReverseProxy.TCP
       Test.Sandwich.Contexts.Util.Aeson
       Test.Sandwich.Contexts.Util.Container
       Test.Sandwich.Contexts.Util.Exception
       Test.Sandwich.Contexts.Util.Nix
-      Test.Sandwich.Contexts.Util.Ports
       Test.Sandwich.Contexts.Util.SocketUtil
       Test.Sandwich.Contexts.Util.UUID
       Paths_sandwich_contexts

sandwich-webdriver/package.yaml

@@ -36,6 +36,7 @@ dependencies:
 - retry
 - safe
 - sandwich >= 0.1.0.3
+- sandwich-contexts
 - string-interpolate
 - text
 - time

sandwich-webdriver/sandwich-webdriver.cabal

@@ -35,7 +35,6 @@ library
       Test.Sandwich.WebDriver.Internal.Binaries.DetectFirefox
       Test.Sandwich.WebDriver.Internal.Binaries.DetectPlatform
       Test.Sandwich.WebDriver.Internal.Capabilities
-      Test.Sandwich.WebDriver.Internal.Ports
       Test.Sandwich.WebDriver.Internal.Screenshots
       Test.Sandwich.WebDriver.Internal.StartWebDriver
       Test.Sandwich.WebDriver.Internal.Types
@@ -85,6 +84,7 @@ library
     , retry
     , safe
     , sandwich >=0.1.0.3
+    , sandwich-contexts
     , string-interpolate
     , text
     , time
@@ -163,6 +163,7 @@ executable sandwich-webdriver-exe
     , retry
     , safe
     , sandwich >=0.1.0.3
+    , sandwich-contexts
     , sandwich-webdriver
     , string-interpolate
     , text
@@ -241,6 +242,7 @@ test-suite sandwich-webdriver-test
     , retry
     , safe
     , sandwich >=0.1.0.3
+    , sandwich-contexts
     , sandwich-webdriver
     , string-interpolate
     , text

sandwich-webdriver/src/Test/Sandwich/WebDriver.hs

@@ -43,6 +43,8 @@ import qualified Data.Map as M
 import Data.Maybe
 import Data.String.Interpolate
 import Test.Sandwich
+import Test.Sandwich.Contexts.Files
+import Test.Sandwich.Contexts.Nix
 import Test.Sandwich.Internal
 import Test.Sandwich.WebDriver.Class
 import Test.Sandwich.WebDriver.Config
@@ -58,7 +60,10 @@ import UnliftIO.MVar
 
 -- | This is the main 'introduce' method for creating a WebDriver.
 introduceWebDriver :: (BaseMonadContext m context) => WdOptions -> SpecFree (LabelValue "webdriver" WebDriver :> context) m () -> SpecFree context m ()
-introduceWebDriver wdOptions = introduce "Introduce WebDriver session" webdriver (allocateWebDriver wdOptions) cleanupWebDriver
+introduceWebDriver wdOptions = undefined -- introduce "Introduce WebDriver session" webdriver (allocateWebDriver wdOptions) cleanupWebDriver
+
+introduceWebDriverViaNix :: (BaseMonadContext m context, HasNixContext context) => WdOptions -> SpecFree (LabelValue "webdriver" WebDriver :> context) m () -> SpecFree context m ()
+introduceWebDriverViaNix wdOptions = introduce "Introduce WebDriver session" webdriver (allocateWebDriver wdOptions) cleanupWebDriver
 
 -- | Same as introduceWebDriver, but merges command line options into the 'WdOptions'.
 introduceWebDriverOptions :: forall a context m. (BaseMonadContext m context, HasCommandLineOptions context a)
@@ -69,7 +74,7 @@ introduceWebDriverOptions wdOptions = introduce "Introduce WebDriver session" we
           allocateWebDriver (addCommandLineOptionsToWdOptions @a clo wdOptions)
 
 -- | Allocate a WebDriver using the given options.
-allocateWebDriver :: (HasBaseContext context, BaseMonad m) => WdOptions -> ExampleT context m WebDriver
+allocateWebDriver :: (BaseMonad m, HasBaseContext context, MonadReader context m) => WdOptions -> ExampleT context m WebDriver
 allocateWebDriver wdOptions = do
   debug "Beginning allocateWebDriver"
   dir <- fromMaybe "/tmp" <$> getCurrentFolder

sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Action.hs

@@ -42,7 +42,10 @@ closeAllSessions :: (HasCallStack, MonadLogger m, MonadUnliftIO m) => WebDriver
 closeAllSessions = closeAllSessionsExcept []
 
 -- | Close the current session
-closeCurrentSession :: (HasCallStack, MonadLogger m, MonadUnliftIO m, MonadReader context m, HasLabel context "webdriver" WebDriver, HasLabel context "webdriverSession" WebDriverSession) => m ()
+closeCurrentSession :: (
+  HasCallStack, MonadLogger m, MonadUnliftIO m
+  , MonadReader context m, HasLabel context "webdriver" WebDriver, HasLabel context "webdriverSession" WebDriverSession
+  ) => m ()
 closeCurrentSession = do
   webDriver <- getContext webdriver
   (session, _) <- getContext webdriverSession

sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Capabilities.hs

@@ -1,5 +1,4 @@
 {-# LANGUAGE OverloadedLists #-}
--- |
 
 module Test.Sandwich.WebDriver.Internal.Capabilities (
   -- * Chrome

sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/StartWebDriver.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -13,6 +14,7 @@ import Control.Monad.Catch (MonadMask)
 import Control.Monad.IO.Class
 import Control.Monad.IO.Unlift
 import Control.Monad.Logger
+import Control.Monad.Reader
 import Control.Monad.Trans.Control (MonadBaseControl)
 import Control.Retry
 import qualified Data.Aeson as A
@@ -32,10 +34,11 @@ import System.FilePath
 import System.IO
 import System.Process
 import Test.Sandwich
+import Test.Sandwich.Contexts.Files
+import Test.Sandwich.Contexts.Util.Ports (findFreePortOrException)
 import Test.Sandwich.Util.Process
 import Test.Sandwich.WebDriver.Internal.Binaries
 import Test.Sandwich.WebDriver.Internal.Binaries.DetectChrome (detectChromeVersion)
-import Test.Sandwich.WebDriver.Internal.Ports
 import Test.Sandwich.WebDriver.Internal.Types
 import Test.Sandwich.WebDriver.Internal.Util
 import qualified Test.WebDriver as W
@@ -61,7 +64,7 @@ fromText = id
 type Constraints m = (HasCallStack, MonadLogger m, MonadUnliftIO m, MonadBaseControl IO m, MonadMask m)
 
 -- | Spin up a Selenium WebDriver and create a WebDriver
-startWebDriver :: Constraints m => WdOptions -> FilePath -> m WebDriver
+startWebDriver :: (Constraints m, MonadReader context m, HasFile context "java") => WdOptions -> FilePath -> m WebDriver
 startWebDriver wdOptions@(WdOptions {..}) runRoot = do
   -- Create a unique name for this webdriver so the folder for its log output doesn't conflict with any others
   webdriverName <- ("webdriver_" <>) <$> liftIO makeUUID
@@ -120,11 +123,16 @@ startWebDriver wdOptions@(WdOptions {..}) runRoot = do
 
 startWebDriver' :: (
   MonadLogger m, MonadUnliftIO m, MonadBaseControl IO m, MonadMask m
+  , MonadReader context m, HasFile context "java"
   ) => WdOptions -> T.Text -> [Char] -> [Char] -> [Char] -> [String] -> Maybe XvfbSession -> Maybe [(String, String)] -> m WebDriver
 startWebDriver' wdOptions@(WdOptions {capabilities=capabilities', ..}) webdriverName webdriverRoot downloadDir seleniumPath driverArgs maybeXvfbSession javaEnv = do
+  javaPath <- askFile @"java"
+
   port <- liftIO findFreePortOrException
-  let wdCreateProcess = (proc "java" (driverArgs <> ["-jar", seleniumPath
-                                                    , "-port", show port])) { env = javaEnv }
+  let wdCreateProcess = (
+        proc javaPath (driverArgs <> ["-jar", seleniumPath
+                                     , "-port", show port])
+        ) { env = javaEnv }
 
   -- Open output handles
   let seleniumOutPath = webdriverRoot </> seleniumOutFileName
@@ -237,6 +245,8 @@ configureHeadlessCapabilities _ (RunHeadless {}) browser = error [i|Headless mod
 configureHeadlessCapabilities _ _ browser = return browser
 
 
+-- | Configure download capabilities to set the download directory and disable prompts
+-- (since you can't test download prompts using Selenium)
 configureDownloadCapabilities :: (
   MonadIO m, MonadBaseControl IO m
   ) => [Char] -> W.Capabilities -> m W.Capabilities

sandwich/src/Test/Sandwich/ArgParsing.hs

@@ -191,12 +191,12 @@ commandLineSlackOptions maybeInternal = CommandLineSlackOptions
 
 -- * Parse command line args
 
-parseCommandLineArgs :: forall a. Parser a -> TopSpecWithOptions' a -> IO (CommandLineOptions a)
+parseCommandLineArgs :: forall a. Typeable a => Parser a -> TopSpecWithOptions' a -> IO (CommandLineOptions a)
 parseCommandLineArgs parser spec = do
   (clo, _, _) <- parseCommandLineArgs' parser spec
   return clo
 
-parseCommandLineArgs' :: forall a. Parser a -> TopSpecWithOptions' a -> IO (
+parseCommandLineArgs' :: forall a. Typeable a => Parser a -> TopSpecWithOptions' a -> IO (
   CommandLineOptions a
   , Mod FlagFields (Maybe IndividualTestModule) -> Parser (Maybe IndividualTestModule)
   , [(NodeModuleInfo, T.Text)]