{-# LANGUAGE DataKinds #-}

module Test.Sandwich.WebDriver.Internal.Action where

import Control.Concurrent.MVar.Lifted
import Control.Exception.Safe
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Reader
import Control.Monad.Trans.Control (MonadBaseControl)
import qualified Data.Map as M
import Data.String.Interpolate
import GHC.Stack
import Test.Sandwich
import Test.Sandwich.WebDriver.Internal.Types
import Test.Sandwich.WebDriver.Internal.Util
import qualified Test.WebDriver as W


-- | Close the given sessions
closeSession :: (HasCallStack, MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => Session -> WebDriver -> m ()
closeSession :: forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadLogger m, MonadBaseControl IO m,
 MonadCatch m) =>
Session -> WebDriver -> m ()
closeSession Session
session (WebDriver {MVar (Map Session WDSession)
wdSessionMap :: WebDriver -> MVar (Map Session WDSession)
wdSessionMap :: MVar (Map Session WDSession)
wdSessionMap}) = do
  Maybe WDSession
toClose <- forall (m :: * -> *) a b.
MonadBaseControl IO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar MVar (Map Session WDSession)
wdSessionMap forall a b. (a -> b) -> a -> b
$ \Map Session WDSession
sessionMap ->
    case forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Session
session Map Session WDSession
sessionMap of
      Maybe WDSession
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return (Map Session WDSession
sessionMap, forall a. Maybe a
Nothing)
      Just WDSession
x -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a. Ord k => k -> Map k a -> Map k a
M.delete Session
session Map Session WDSession
sessionMap, forall a. a -> Maybe a
Just WDSession
x)

  forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust Maybe WDSession
toClose forall a b. (a -> b) -> a -> b
$ \WDSession
sess -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. WDSession -> WD a -> IO a
W.runWD WDSession
sess forall (wd :: * -> *). (HasCallStack, WebDriver wd) => wd ()
W.closeSession

-- | Close all sessions except those listed
closeAllSessionsExcept :: (HasCallStack, MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => [Session] -> WebDriver -> m ()
closeAllSessionsExcept :: forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadLogger m, MonadBaseControl IO m,
 MonadCatch m) =>
[Session] -> WebDriver -> m ()
closeAllSessionsExcept [Session]
toKeep (WebDriver {MVar (Map Session WDSession)
wdSessionMap :: MVar (Map Session WDSession)
wdSessionMap :: WebDriver -> MVar (Map Session WDSession)
wdSessionMap}) = do
  Map Session WDSession
toClose <- forall (m :: * -> *) a b.
MonadBaseControl IO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar MVar (Map Session WDSession)
wdSessionMap forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partitionWithKey (\Session
name WDSession
_ -> Session
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Session]
toKeep)

  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Map k a -> [(k, a)]
M.toList Map Session WDSession
toClose) forall a b. (a -> b) -> a -> b
$ \(Session
name, WDSession
sess) ->
    forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. WDSession -> WD a -> IO a
W.runWD WDSession
sess forall (wd :: * -> *). (HasCallStack, WebDriver wd) => wd ()
W.closeSession)
          (\(SomeException
e :: SomeException) -> forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
warn [i|Failed to destroy session '#{name}': '#{e}'|])

-- | Close all sessions
closeAllSessions :: (HasCallStack, MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => WebDriver -> m ()
closeAllSessions :: forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadLogger m, MonadBaseControl IO m,
 MonadCatch m) =>
WebDriver -> m ()
closeAllSessions = forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadLogger m, MonadBaseControl IO m,
 MonadCatch m) =>
[Session] -> WebDriver -> m ()
closeAllSessionsExcept []

-- | Close the current session
closeCurrentSession :: (HasCallStack, MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m, MonadReader context m, HasLabel context "webdriver" WebDriver, HasLabel context "webdriverSession" WebDriverSession) => m ()
closeCurrentSession :: forall (m :: * -> *) context.
(HasCallStack, MonadIO m, MonadLogger m, MonadBaseControl IO m,
 MonadCatch m, MonadReader context m,
 HasLabel context "webdriver" WebDriver,
 HasLabel context "webdriverSession" WebDriverSession) =>
m ()
closeCurrentSession = do
  WebDriver
webDriver <- forall (m :: * -> *) context (l :: Symbol) a.
(Monad m, HasLabel context l a, HasCallStack,
 MonadReader context m) =>
Label l a -> m a
getContext Label "webdriver" WebDriver
webdriver
  (Session
session, IORef WDSession
_) <- forall (m :: * -> *) context (l :: Symbol) a.
(Monad m, HasLabel context l a, HasCallStack,
 MonadReader context m) =>
Label l a -> m a
getContext Label "webdriverSession" WebDriverSession
webdriverSession
  forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadLogger m, MonadBaseControl IO m,
 MonadCatch m) =>
Session -> WebDriver -> m ()
closeSession Session
session WebDriver
webDriver