{-# LANGUAGE ViewPatterns, LambdaCase, QuasiQuotes, RecordWildCards, NamedFieldPuns, ScopedTypeVariables, 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 :: 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 <- MVar (Map Session WDSession)
-> (Map Session WDSession
    -> m (Map Session WDSession, Maybe WDSession))
-> m (Maybe WDSession)
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar MVar (Map Session WDSession)
wdSessionMap ((Map Session WDSession
  -> m (Map Session WDSession, Maybe WDSession))
 -> m (Maybe WDSession))
-> (Map Session WDSession
    -> m (Map Session WDSession, Maybe WDSession))
-> m (Maybe WDSession)
forall a b. (a -> b) -> a -> b
$ \Map Session WDSession
sessionMap ->
    case Session -> Map Session WDSession -> Maybe WDSession
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Session
session Map Session WDSession
sessionMap of
      Maybe WDSession
Nothing -> (Map Session WDSession, Maybe WDSession)
-> m (Map Session WDSession, Maybe WDSession)
forall (m :: * -> *) a. Monad m => a -> m a
return (Map Session WDSession
sessionMap, Maybe WDSession
forall a. Maybe a
Nothing)
      Just WDSession
x -> (Map Session WDSession, Maybe WDSession)
-> m (Map Session WDSession, Maybe WDSession)
forall (m :: * -> *) a. Monad m => a -> m a
return (Session -> Map Session WDSession -> Map Session WDSession
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Session
session Map Session WDSession
sessionMap, WDSession -> Maybe WDSession
forall a. a -> Maybe a
Just WDSession
x)

  Maybe WDSession -> (WDSession -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust Maybe WDSession
toClose ((WDSession -> m ()) -> m ()) -> (WDSession -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \WDSession
sess -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ WDSession -> WD () -> IO ()
forall a. WDSession -> WD a -> IO a
W.runWD WDSession
sess WD ()
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 :: [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 <- MVar (Map Session WDSession)
-> (Map Session WDSession
    -> m (Map Session WDSession, Map Session WDSession))
-> m (Map Session WDSession)
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
MVar a -> (a -> m (a, b)) -> m b
modifyMVar MVar (Map Session WDSession)
wdSessionMap ((Map Session WDSession
  -> m (Map Session WDSession, Map Session WDSession))
 -> m (Map Session WDSession))
-> (Map Session WDSession
    -> m (Map Session WDSession, Map Session WDSession))
-> m (Map Session WDSession)
forall a b. (a -> b) -> a -> b
$ (Map Session WDSession, Map Session WDSession)
-> m (Map Session WDSession, Map Session WDSession)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Map Session WDSession, Map Session WDSession)
 -> m (Map Session WDSession, Map Session WDSession))
-> (Map Session WDSession
    -> (Map Session WDSession, Map Session WDSession))
-> Map Session WDSession
-> m (Map Session WDSession, Map Session WDSession)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Session -> WDSession -> Bool)
-> Map Session WDSession
-> (Map Session WDSession, Map Session WDSession)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
M.partitionWithKey (\Session
name WDSession
_ -> Session
name Session -> [Session] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Session]
toKeep)

  [(Session, WDSession)] -> ((Session, WDSession) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map Session WDSession -> [(Session, WDSession)]
forall k a. Map k a -> [(k, a)]
M.toList Map Session WDSession
toClose) (((Session, WDSession) -> m ()) -> m ())
-> ((Session, WDSession) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Session
name, WDSession
sess) ->
    m () -> (SomeException -> m ()) -> m ()
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
catch (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ WDSession -> WD () -> IO ()
forall a. WDSession -> WD a -> IO a
W.runWD WDSession
sess WD ()
forall (wd :: * -> *). (HasCallStack, WebDriver wd) => wd ()
W.closeSession)
          (\(SomeException
e :: SomeException) -> Text -> m ()
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 :: WebDriver -> m ()
closeAllSessions = [Session] -> WebDriver -> m ()
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 :: m ()
closeCurrentSession = do
  WebDriver
webDriver <- Label "webdriver" WebDriver -> m 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
_) <- Label "webdriverSession" (Session, IORef WDSession)
-> m (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" (Session, IORef WDSession)
webdriverSession
  Session -> WebDriver -> m ()
forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadLogger m, MonadBaseControl IO m,
 MonadCatch m) =>
Session -> WebDriver -> m ()
closeSession Session
session WebDriver
webDriver