{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Test.Sandwich.WebDriver.Types (
  -- * Type aliases to make signatures shorter
  BaseMonad
  , ContextWithWebdriverDeps
  , ContextWithBaseDeps
  , WebDriverMonad
  , WebDriverSessionMonad

  -- * Context aliases
  , HasBrowserDependencies
  , HasWebDriverContext
  , HasWebDriverSessionContext

  -- * The Xvfb session
  , XvfbSession(..)
  , getXvfbSession
  ) where

import Control.Monad.Catch (MonadMask)
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Reader
import Control.Monad.Trans.Control (MonadBaseControl)
import Data.IORef
import GHC.Stack
import Test.Sandwich
import Test.Sandwich.Contexts.Files
import Test.Sandwich.WebDriver.Internal.Dependencies
import Test.Sandwich.WebDriver.Internal.Types
import qualified Test.WebDriver.Class as W
import qualified Test.WebDriver.Internal as WI
import qualified Test.WebDriver.Session as W
import UnliftIO.Exception as ES


instance (MonadIO m, HasWebDriverSessionContext context) => W.WDSessionState (ExampleT context m) where
  getSession :: ExampleT context m WDSession
getSession = do
    (Session
_, IORef WDSession
sessVar) <- Label "webdriverSession" (Session, IORef WDSession)
-> ExampleT context m (Session, IORef WDSession)
forall context (l :: Symbol) a (m :: * -> *).
(HasLabel context l a, MonadReader context m) =>
Label l a -> m a
getContext Label "webdriverSession" (Session, IORef WDSession)
webdriverSession
    IO WDSession -> ExampleT context m WDSession
forall a. IO a -> ExampleT context m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO WDSession -> ExampleT context m WDSession)
-> IO WDSession -> ExampleT context m WDSession
forall a b. (a -> b) -> a -> b
$ IORef WDSession -> IO WDSession
forall a. IORef a -> IO a
readIORef IORef WDSession
sessVar
  putSession :: WDSession -> ExampleT context m ()
putSession WDSession
sess = do
    (Session
_, IORef WDSession
sessVar) <- Label "webdriverSession" (Session, IORef WDSession)
-> ExampleT context m (Session, IORef WDSession)
forall context (l :: Symbol) a (m :: * -> *).
(HasLabel context l a, MonadReader context m) =>
Label l a -> m a
getContext Label "webdriverSession" (Session, IORef WDSession)
webdriverSession
    IO () -> ExampleT context m ()
forall a. IO a -> ExampleT context m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExampleT context m ()) -> IO () -> ExampleT context m ()
forall a b. (a -> b) -> a -> b
$ IORef WDSession -> WDSession -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef WDSession
sessVar WDSession
sess

-- Implementation copied from that of the WD monad implementation
instance (MonadIO m, MonadBaseControl IO m, HasWebDriverSessionContext context) => W.WebDriver (ExampleT context m) where
  doCommand :: forall a b.
(HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> ExampleT context m b
doCommand Method
method Text
path a
args = Method -> Text -> a -> ExampleT context m Request
forall (s :: * -> *) a.
(WDSessionState s, ToJSON a) =>
Method -> Text -> a -> s Request
WI.mkRequest Method
method Text
path a
args
    ExampleT context m Request
-> (Request
    -> ExampleT context m (Either SomeException (Response ByteString)))
-> ExampleT context m (Either SomeException (Response ByteString))
forall a b.
ExampleT context m a
-> (a -> ExampleT context m b) -> ExampleT context m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Request
-> ExampleT context m (Either SomeException (Response ByteString))
forall (s :: * -> *).
WDSessionStateIO s =>
Request -> s (Either SomeException (Response ByteString))
WI.sendHTTPRequest
    ExampleT context m (Either SomeException (Response ByteString))
-> (Either SomeException (Response ByteString)
    -> ExampleT context m (Response ByteString))
-> ExampleT context m (Response ByteString)
forall a b.
ExampleT context m a
-> (a -> ExampleT context m b) -> ExampleT context m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SomeException -> ExampleT context m (Response ByteString))
-> (Response ByteString
    -> ExampleT context m (Response ByteString))
-> Either SomeException (Response ByteString)
-> ExampleT context m (Response ByteString)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> ExampleT context m (Response ByteString)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO Response ByteString -> ExampleT context m (Response ByteString)
forall a. a -> ExampleT context m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    ExampleT context m (Response ByteString)
-> (Response ByteString
    -> ExampleT context m (Either SomeException b))
-> ExampleT context m (Either SomeException b)
forall a b.
ExampleT context m a
-> (a -> ExampleT context m b) -> ExampleT context m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Response ByteString -> ExampleT context m (Either SomeException b)
forall (s :: * -> *) a.
(HasCallStack, WDSessionStateControl s, FromJSON a) =>
Response ByteString -> s (Either SomeException a)
WI.getJSONResult
    ExampleT context m (Either SomeException b)
-> (Either SomeException b -> ExampleT context m b)
-> ExampleT context m b
forall a b.
ExampleT context m a
-> (a -> ExampleT context m b) -> ExampleT context m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (SomeException -> ExampleT context m b)
-> (b -> ExampleT context m b)
-> Either SomeException b
-> ExampleT context m b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either SomeException -> ExampleT context m b
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO b -> ExampleT context m b
forall a. a -> ExampleT context m a
forall (m :: * -> *) a. Monad m => a -> m a
return

type HasWebDriverContext context = HasLabel context "webdriver" WebDriver
type HasWebDriverSessionContext context = HasLabel context "webdriverSession" WebDriverSession

type ContextWithWebdriverDeps context =
  LabelValue "webdriver" WebDriver
  :> ContextWithBaseDeps context

type ContextWithBaseDeps context =
  -- | Browser dependencies
  LabelValue "browserDependencies" BrowserDependencies
  -- | Java
  :> FileValue "java"
  -- | Selenium
  :> FileValue "selenium.jar"
  -- | Base context
  :> context

type BaseMonad m context = (HasCallStack, MonadUnliftIO m, MonadMask m, HasBaseContext context)
type WebDriverMonad m context = (HasCallStack, MonadUnliftIO m, HasWebDriverContext context)
type WebDriverSessionMonad m context = (WebDriverMonad m context, MonadReader context m, HasWebDriverSessionContext context)