{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Test.Sandwich.WebDriver.Internal.Screenshots where

import Control.Concurrent
import Control.Monad
import Control.Monad.IO.Class
import qualified Data.Map as M
import Data.String.Interpolate
import qualified Data.Text as T
import GHC.Stack
import Network.HTTP.Client
import System.FilePath
import Test.Sandwich.WebDriver.Internal.Types
import Test.WebDriver
import UnliftIO.Exception

saveScreenshots :: (HasCallStack) => T.Text -> WebDriver -> FilePath -> IO ()
saveScreenshots :: HasCallStack => Text -> WebDriver -> FilePath -> IO ()
saveScreenshots Text
screenshotName (WebDriver {FilePath
(ProcessHandle, Maybe XvfbSession)
MVar (Map FilePath WDSession)
MVar (OnDemand FilePath)
WDConfig
FfmpegToUse
XvfbToUse
WdOptions
wdName :: FilePath
wdWebDriver :: (ProcessHandle, Maybe XvfbSession)
wdOptions :: WdOptions
wdSessionMap :: MVar (Map FilePath WDSession)
wdConfig :: WDConfig
wdDownloadDir :: FilePath
wdFfmpegToUse :: FfmpegToUse
wdFfmpeg :: MVar (OnDemand FilePath)
wdXvfbToUse :: XvfbToUse
wdXvfb :: MVar (OnDemand FilePath)
wdName :: WebDriver -> FilePath
wdWebDriver :: WebDriver -> (ProcessHandle, Maybe XvfbSession)
wdOptions :: WebDriver -> WdOptions
wdSessionMap :: WebDriver -> MVar (Map FilePath WDSession)
wdConfig :: WebDriver -> WDConfig
wdDownloadDir :: WebDriver -> FilePath
wdFfmpegToUse :: WebDriver -> FfmpegToUse
wdFfmpeg :: WebDriver -> MVar (OnDemand FilePath)
wdXvfbToUse :: WebDriver -> XvfbToUse
wdXvfb :: WebDriver -> MVar (OnDemand FilePath)
..}) FilePath
resultsDir = do
  -- For every session, and for every window, try to get a screenshot for the results dir
  Map FilePath WDSession
sessionMap <- MVar (Map FilePath WDSession) -> IO (Map FilePath WDSession)
forall a. MVar a -> IO a
readMVar MVar (Map FilePath WDSession)
wdSessionMap
  [(FilePath, WDSession)]
-> ((FilePath, WDSession) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Map FilePath WDSession -> [(FilePath, WDSession)]
forall k a. Map k a -> [(k, a)]
M.toList Map FilePath WDSession
sessionMap) (((FilePath, WDSession) -> IO ()) -> IO ())
-> ((FilePath, WDSession) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(FilePath
browser, WDSession
sess) ->
    (HttpException -> IO ()) -> IO () -> IO ()
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\(HttpException
e :: HttpException) -> case HttpException
e of
               (HttpExceptionRequest Request
_ HttpExceptionContent
content) -> IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn [i|HttpException when trying to take a screenshot: '#{content}'|]
               HttpException
e' -> IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn [i|HttpException when trying to take a screenshot: '#{e'}'|])
           (WDSession -> WD () -> IO ()
forall a. WDSession -> WD a -> IO a
runWD WDSession
sess (WD () -> IO ()) -> WD () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> WD ()
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
FilePath -> wd ()
saveScreenshot (FilePath -> WD ()) -> FilePath -> WD ()
forall a b. (a -> b) -> a -> b
$ FilePath
resultsDir FilePath -> FilePath -> FilePath
</> [i|#{browser}_#{screenshotName}.png|])