From d404a881e4af9bd37a83e28b3cc88b6accafe2b9 Mon Sep 17 00:00:00 2001
From: thomasjm <tom@codedown.io>
Date: Thu, 17 Oct 2024 06:06:13 -0700
Subject: [PATCH] sandwich-webdriver: more haddocks

---
 .../src/Test/Sandwich/WebDriver.hs            | 22 +++++++++-----
 .../src/Test/Sandwich/WebDriver/Config.hs     | 29 +++++++------------
 .../Test/Sandwich/WebDriver/Internal/Types.hs |  5 ++--
 .../src/Test/Sandwich/WebDriver/Types.hs      | 24 +++++----------
 .../src/Test/Sandwich/WebDriver/Windows.hs    | 10 +++----
 5 files changed, 39 insertions(+), 51 deletions(-)

diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver.hs
index ffd1edbe..dbe134b7 100644
--- a/sandwich-webdriver/src/Test/Sandwich/WebDriver.hs
+++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver.hs
@@ -39,14 +39,20 @@ module Test.Sandwich.WebDriver (
   , introduceWebDriver'
   , addCommandLineOptionsToWdOptions
 
-  -- * Types
+  -- * Context types
+  -- ** WebDriver
   , webdriver
   , WebDriver
   , HasWebDriverContext
+  -- ** WebDriverSession
   , webdriverSession
   , WebDriverSession
   , HasWebDriverSessionContext
 
+  -- * On demand options
+  , OnDemandOptions
+  , defaultOnDemandOptions
+
   -- * Re-exports
   , module Test.Sandwich.WebDriver.Config
   ) where
@@ -79,7 +85,7 @@ import UnliftIO.MVar
 -- | Introduce a 'WebDriver', using the given 'WebDriverDependencies'.
 -- A good default is 'defaultWebDriverDependencies'.
 introduceWebDriver :: forall context m. (
-  BaseMonadContext m context, HasSomeCommandLineOptions context
+  BaseMonad m context, HasSomeCommandLineOptions context
   )
   -- | How to obtain dependencies
   => WebDriverDependencies
@@ -99,7 +105,7 @@ introduceWebDriver wdd wdOptions = introduceWebDriver' wdd alloc wdOptions
 -- | Introduce a 'WebDriver' using the current 'NixContext'.
 -- This will pull everything required from the configured Nixpkgs snapshot.
 introduceWebDriverViaNix :: forall m context. (
-  BaseMonadContext m context, HasSomeCommandLineOptions context, HasNixContext context
+  BaseMonad m context, HasSomeCommandLineOptions context, HasNixContext context
   )
   -- | Options
   => WdOptions
@@ -109,7 +115,7 @@ introduceWebDriverViaNix = introduceWebDriverViaNix' (defaultNodeOptions { nodeO
 
 -- | Same as 'introduceWebDriverViaNix', but allows passing custom 'NodeOptions'.
 introduceWebDriverViaNix' :: forall m context. (
-  BaseMonadContext m context, HasSomeCommandLineOptions context, HasNixContext context
+  BaseMonad m context, HasSomeCommandLineOptions context, HasNixContext context
   )
   => NodeOptions
   -- | Options
@@ -135,7 +141,7 @@ introduceWebDriverViaNix' nodeOptions wdOptions =
 
 -- | Same as 'introduceWebDriver', but with a controllable allocation callback.
 introduceWebDriver' :: forall m context. (
-  BaseMonadContext m context
+  BaseMonad m context
   )
   -- | Dependencies
   => WebDriverDependencies
@@ -150,8 +156,8 @@ introduceWebDriver' (WebDriverDependencies {..}) alloc wdOptions =
 
 -- | Allocate a WebDriver using the given options.
 allocateWebDriver :: (
-  BaseMonad m
-  , HasBaseContext context, HasFile context "java", HasFile context "selenium.jar", HasBrowserDependencies context
+  BaseMonad m context
+  , HasFile context "java", HasFile context "selenium.jar", HasBrowserDependencies context
   )
   -- | Options
   => WdOptions
@@ -162,7 +168,7 @@ allocateWebDriver wdOptions onDemandOptions = do
   startWebDriver wdOptions onDemandOptions dir
 
 -- | Clean up the given WebDriver.
-cleanupWebDriver :: (BaseMonad m) => WebDriver -> ExampleT context m ()
+cleanupWebDriver :: (BaseMonad m context) => WebDriver -> ExampleT context m ()
 cleanupWebDriver sess = do
   closeAllSessions sess
   stopWebDriver sess
diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Config.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Config.hs
index 981a3a9b..0be5f282 100644
--- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Config.hs
+++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Config.hs
@@ -8,8 +8,6 @@ module Test.Sandwich.WebDriver.Config (
   , httpManager
   , httpRetryCount
   , saveSeleniumMessageHistory
-  , WhenToSave(..)
-  , RunMode(..)
 
   -- * Accessors for the 'WebDriver' context
   , getWdOptions
@@ -17,39 +15,32 @@ module Test.Sandwich.WebDriver.Config (
   , getDownloadDirectory
   , getWebDriverName
 
-  -- ** Xvfb mode
+  -- * Xvfb mode
   , XvfbConfig
   , defaultXvfbConfig
   , xvfbResolution
   , xvfbStartFluxbox
 
-  -- ** Headless mode
+  -- * Headless mode
   , HeadlessConfig
   , defaultHeadlessConfig
   , headlessResolution
 
-  -- * Dependency obtaining options
-  , SeleniumToUse(..)
-  , BrowserDependenciesSpec(..)
-  , ChromeToUse(..)
-  , ChromeDriverToUse(..)
-  , FirefoxToUse(..)
-  , GeckoDriverToUse(..)
-  , GeckoDriverVersion(..)
-  , XvfbDependenciesSpec(..)
-  , XvfbToUse(..)
-  , FluxboxToUse(..)
-  , FfmpegToUse(..)
-  , BrowserDependencies(..)
-
   -- * Browser capabilities
   , chromeCapabilities
   , headlessChromeCapabilities
   , firefoxCapabilities
   , headlessFirefoxCapabilities
+
+  -- * Types
+  , WhenToSave(..)
+  , RunMode(..)
+  , browserDependencies
+  , BrowserDependenciesSpec(..)
+  , BrowserDependencies(..)
+  , HasBrowserDependencies
   ) where
 
-import Test.Sandwich.WebDriver.Binaries
 import Test.Sandwich.WebDriver.Internal.Capabilities
 import Test.Sandwich.WebDriver.Internal.Dependencies
 import Test.Sandwich.WebDriver.Internal.Types
diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Types.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Types.hs
index db156d66..b3029f21 100644
--- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Types.hs
+++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Internal/Types.hs
@@ -19,7 +19,6 @@ import Test.Sandwich
 import Test.Sandwich.WebDriver.Internal.Binaries.Ffmpeg
 import Test.Sandwich.WebDriver.Internal.Binaries.Xvfb
 import qualified Test.WebDriver as W
-import qualified Test.WebDriver.Class as W
 import qualified Test.WebDriver.Session as W
 import UnliftIO.Async
 
@@ -34,8 +33,6 @@ webdriver = Label
 webdriverSession :: Label "webdriverSession" WebDriverSession
 webdriverSession = Label
 
-type WebDriverContext context wd = (HasLabel context "webdriver" WebDriver, W.WebDriver (ExampleT context wd))
-
 type ToolsRoot = FilePath
 
 data WhenToSave = Always | OnException | Never deriving (Show, Eq)
@@ -69,6 +66,8 @@ data WdOptions = WdOptions {
   -- ^ Number of times to retry an HTTP request if it times out.
   }
 
+-- | How to obtain certain binaries "on demand". These may or not be needed based on 'WdOptions', so
+-- they will be obtained as needed.
 data OnDemandOptions = OnDemandOptions {
   -- | How to obtain ffmpeg binary.
   ffmpegToUse :: FfmpegToUse
diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Types.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Types.hs
index 1759ccea..841d1b37 100644
--- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Types.hs
+++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Types.hs
@@ -7,21 +7,15 @@
 
 module Test.Sandwich.WebDriver.Types (
   -- * Type aliases to make signatures shorter
-  ContextWithWebdriverDeps
+  BaseMonad
+  , ContextWithWebdriverDeps
   , ContextWithBaseDeps
+  , WebDriverMonad
 
-  -- * Constraint synonyms
-  , BaseMonad
-  , BaseMonadContext
+  -- * Context aliases
   , HasBrowserDependencies
   , HasWebDriverContext
   , HasWebDriverSessionContext
-  , WebDriverMonad
-  , WebDriverSessionMonad
-
-  -- * On demand options
-  , OnDemandOptions
-  , defaultOnDemandOptions
 
   -- * The Xvfb session
   , XvfbSession(..)
@@ -49,7 +43,7 @@ import qualified Test.WebDriver.Session as W
 import UnliftIO.Exception as ES
 
 
-instance (MonadIO m, HasLabel context "webdriverSession" WebDriverSession) => W.WDSessionState (ExampleT context m) where
+instance (MonadIO m, HasWebDriverSessionContext context) => W.WDSessionState (ExampleT context m) where
   getSession = do
     (_, sessVar) <- getContext webdriverSession
     liftIO $ readIORef sessVar
@@ -58,7 +52,7 @@ instance (MonadIO m, HasLabel context "webdriverSession" WebDriverSession) => W.
     liftIO $ writeIORef sessVar sess
 
 -- Implementation copied from that of the WD monad implementation
-instance (MonadIO m, HasLabel context "webdriverSession" WebDriverSession, MonadBaseControl IO m) => W.WebDriver (ExampleT context m) where
+instance (MonadIO m, MonadBaseControl IO m, HasWebDriverSessionContext context) => W.WebDriver (ExampleT context m) where
   doCommand method path args = WI.mkRequest method path args
     >>= WI.sendHTTPRequest
     >>= either throwIO return
@@ -86,7 +80,5 @@ hoistExample :: ExampleT context IO a -> ExampleT (LabelValue "webdriverSession"
 hoistExample (ExampleT r) = ExampleT $ transformContext r
   where transformContext = withReaderT (\(_ :> ctx) -> ctx)
 
-type WebDriverMonad m context = (HasCallStack, HasLabel context "webdriver" WebDriver, MonadUnliftIO m, MonadBaseControl IO m)
-type WebDriverSessionMonad m context = (WebDriverMonad m context, MonadReader context m, HasLabel context "webdriverSession" WebDriverSession)
-type BaseMonad m = (HasCallStack, MonadUnliftIO m, MonadMask m)
-type BaseMonadContext m context = (BaseMonad m, HasBaseContext context)
+type BaseMonad m context = (HasCallStack, MonadUnliftIO m, MonadMask m, HasBaseContext context)
+type WebDriverMonad m context = (HasCallStack, MonadUnliftIO m, HasWebDriverContext context)
diff --git a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Windows.hs b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Windows.hs
index 1c8e440b..2a0c2339 100644
--- a/sandwich-webdriver/src/Test/Sandwich/WebDriver/Windows.hs
+++ b/sandwich-webdriver/src/Test/Sandwich/WebDriver/Windows.hs
@@ -13,16 +13,16 @@ module Test.Sandwich.WebDriver.Windows (
 import Control.Monad.IO.Class
 import Control.Monad.Reader
 import Data.Maybe
-import GHC.Stack
 import Test.Sandwich
 import Test.Sandwich.WebDriver.Internal.Types
 import Test.Sandwich.WebDriver.Resolution
+import Test.Sandwich.WebDriver.Types
 import Test.WebDriver
 import qualified Test.WebDriver.Class as W
 
 
 -- | Position the window on the left 50% of the screen.
-setWindowLeftSide :: (HasCallStack, MonadIO wd, WebDriverContext context wd, MonadReader context wd, W.WebDriver wd) => wd ()
+setWindowLeftSide :: (WebDriverMonad m context, MonadReader context m, W.WebDriver m) => m ()
 setWindowLeftSide = do
   sess <- getContext webdriver
   (x, y, width, height) <- case runMode $ wdOptions sess of
@@ -36,7 +36,7 @@ setWindowLeftSide = do
   setWindowSize (round (screenWidth / 2.0), round screenHeight)
 
 -- | Position the window on the right 50% of the screen.
-setWindowRightSide :: (HasCallStack, MonadIO wd, WebDriverContext context wd, MonadReader context wd, W.WebDriver wd) => wd ()
+setWindowRightSide :: (WebDriverMonad m context, MonadReader context m, W.WebDriver m) => m ()
 setWindowRightSide = do
   sess <- getContext webdriver
   (x, y, width, height) <- case runMode $ wdOptions sess of
@@ -50,7 +50,7 @@ setWindowRightSide = do
   setWindowSize (round (screenWidth / 2.0), round screenHeight)
 
 -- | Fullscreen the browser window.
-setWindowFullScreen :: (HasCallStack, MonadIO wd, WebDriverContext context wd, MonadReader context wd, W.WebDriver wd) => wd ()
+setWindowFullScreen :: (WebDriverMonad m context, MonadReader context m, W.WebDriver m) => m ()
 setWindowFullScreen = do
   sess <- getContext webdriver
   (x, y, width, height) <- case runMode $ wdOptions sess of
@@ -69,7 +69,7 @@ getScreenResolution (WebDriver {wdWebDriver=(_, maybeXvfbSession)}) = case maybe
   Nothing -> liftIO getResolution
   Just (XvfbSession {..}) -> liftIO $ getResolutionForDisplay xvfbDisplayNum
 
-getScreenPixelDimensions :: (MonadIO wd, W.WebDriver wd) => Int -> Int -> wd (Double, Double)
+getScreenPixelDimensions :: (MonadIO m, W.WebDriver m) => Int -> Int -> m (Double, Double)
 getScreenPixelDimensions width height = do
   devicePixelRatio <- executeJS [] "return window.devicePixelRatio" >>= \case
     Just (ratio :: Double) -> pure ratio