{-# LANGUAGE DataKinds #-}

module Test.Sandwich.WebDriver.Internal.Action where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Logger
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 Test.Sandwich.WebDriver.Types
import qualified Test.WebDriver as W
import UnliftIO.Concurrent
import UnliftIO.Exception


-- | Close the given session.
closeSession :: (HasCallStack, MonadLogger m, MonadUnliftIO m) => Session -> WebDriver -> m ()
closeSession :: forall (m :: * -> *).
(HasCallStack, MonadLogger m, MonadUnliftIO m) =>
Session -> WebDriver -> m ()
closeSession Session
session (WebDriver {MVar (Map Session WDSession)
wdSessionMap :: MVar (Map Session WDSession)
wdSessionMap :: WebDriver -> 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.
MonadUnliftIO 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 a. a -> m a
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 a. a -> m a
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 a. IO a -> m a
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, MonadLogger m, MonadUnliftIO m) => [Session] -> WebDriver -> m ()
closeAllSessionsExcept :: forall (m :: * -> *).
(HasCallStack, MonadLogger m, MonadUnliftIO m) =>
[Session] -> WebDriver -> m ()
closeAllSessionsExcept [Session]
toKeep (WebDriver {MVar (Map Session WDSession)
wdSessionMap :: WebDriver -> MVar (Map Session WDSession)
wdSessionMap :: 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.
MonadUnliftIO 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 a. a -> m a
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 a. Eq a => a -> [a] -> 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.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch (IO () -> m ()
forall a. IO a -> m a
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, MonadLogger m, MonadUnliftIO m) => WebDriver -> m ()
closeAllSessions :: forall (m :: * -> *).
(HasCallStack, MonadLogger m, MonadUnliftIO m) =>
WebDriver -> m ()
closeAllSessions = [Session] -> WebDriver -> m ()
forall (m :: * -> *).
(HasCallStack, MonadLogger m, MonadUnliftIO m) =>
[Session] -> WebDriver -> m ()
closeAllSessionsExcept []

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