{-# LANGUAGE RankNTypes, MultiWayIf, ScopedTypeVariables, CPP, QuasiQuotes, RecordWildCards #-}
-- |

module Test.Sandwich.WebDriver.Internal.Screenshots where

import Control.Concurrent
import Control.Exception.Lifted
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

saveScreenshots :: (HasCallStack) => T.Text -> WebDriver -> FilePath -> IO ()
saveScreenshots :: Text -> WebDriver -> FilePath -> IO ()
saveScreenshots Text
screenshotName (WebDriver {FilePath
(Handle, Handle, ProcessHandle, FilePath, FilePath,
 Maybe XvfbSession)
MVar (Map FilePath WDSession)
WDConfig
WdOptions
wdConfig :: WebDriver -> WDConfig
wdSessionMap :: WebDriver -> MVar (Map FilePath WDSession)
wdOptions :: WebDriver -> WdOptions
wdWebDriver :: WebDriver
-> (Handle, Handle, ProcessHandle, FilePath, FilePath,
    Maybe XvfbSession)
wdName :: WebDriver -> FilePath
wdConfig :: WDConfig
wdSessionMap :: MVar (Map FilePath WDSession)
wdOptions :: WdOptions
wdWebDriver :: (Handle, Handle, ProcessHandle, FilePath, FilePath,
 Maybe XvfbSession)
wdName :: 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) -> WDSession -> WD () -> IO ()
forall a. WDSession -> WD a -> IO a
runWD WDSession
sess (WD () -> IO ()) -> WD () -> IO ()
forall a b. (a -> b) -> a -> b
$
    (HttpException -> WD ()) -> WD () -> WD ()
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
(e -> m a) -> m a -> m a
handle (\(HttpException
e :: HttpException) -> case HttpException
e of
               (HttpExceptionRequest Request
_ HttpExceptionContent
content) -> IO () -> WD ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WD ()) -> IO () -> WD ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn [i|HttpException when trying to take a screenshot: '#{content}'|]
               HttpException
e -> IO () -> WD ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WD ()) -> IO () -> WD ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
putStrLn [i|HttpException when trying to take a screenshot: '#{e}'|])
           (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|])