{- |
Module : Test.WebDriverWrapper
Description : end-user functions.

The wrapped functions (`wrappedRunSession` and `wrappedRunWD`) will download Selenium and Firefox's webdriver (geckodriver) if they're not already on the `Test.WebDriverWrapper.Constants.downloadPath`, then start Selenium before running the webdriver equivalent function (`runSession` and `runWD`). They kill the Selenium process at the end of their execution. 
-}
{-# OPTIONS_GHC -Wno-missing-fields #-}
{-# LANGUAGE NamedFieldPuns #-}
module Test.WebDriverWrapper (wrappedRunSession, wrapWebDriverFunction, wrappedFirefoxRunWD, wrappedChromeRunWD) where

import System.Process (cleanupProcess)
import Control.Concurrent.Async (concurrently_)
import Test.WebDriverWrapper.Selenium (getSeleniumIfNeeded, startSelenium)
import Test.WebDriverWrapper.GeckoDriver (getGeckoDriverIfNeeded)
import Test.WebDriver
    ( runSession,
      Capabilities(..),
      WDConfig(wdCapabilities),
      Browser(..) )
import Test.WebDriver.Types (WD, WDSession)
import Test.WebDriver.Monad (runWD)
import Control.Exception (bracket)
import Test.WebDriverWrapper.ChromeDriver (getChromeDriverIfNeeded)

-- | Same as `runSession`, but starts Selenium before execution and kills Selenium after execution. 
-- Will download Selenium or the browser's webdriver (geckodriver or chromedriver) if any is missing. 
wrappedRunSession :: WDConfig -> WD a -> IO a
wrappedRunSession :: forall a. WDConfig -> WD a -> IO a
wrappedRunSession WDConfig
conf WD a
wd = Browser -> (WDConfig, WD a) -> ((WDConfig, WD a) -> IO a) -> IO a
forall a b. Browser -> a -> (a -> IO b) -> IO b
wrapWebDriverFunction (Capabilities -> Browser
browser (Capabilities -> Browser) -> Capabilities -> Browser
forall a b. (a -> b) -> a -> b
$ WDConfig -> Capabilities
wdCapabilities WDConfig
conf) (WDConfig
conf, WD a
wd) ((WDConfig -> WD a -> IO a) -> (WDConfig, WD a) -> IO a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry WDConfig -> WD a -> IO a
forall conf a. WebDriverConfig conf => conf -> WD a -> IO a
runSession)

-- | Same as `runWD`, but starts Selenium before execution and kills Selenium after execution. 
-- Will download Selenium or Firefox's webdriver (geckodriver) if any is missing. 
wrappedFirefoxRunWD ::  WDSession -> WD a -> IO a
wrappedFirefoxRunWD :: forall a. WDSession -> WD a -> IO a
wrappedFirefoxRunWD WDSession
session WD a
wd = Browser -> (WDSession, WD a) -> ((WDSession, WD a) -> IO a) -> IO a
forall a b. Browser -> a -> (a -> IO b) -> IO b
wrapWebDriverFunction (Firefox{}) (WDSession
session, WD a
wd) ((WDSession -> WD a -> IO a) -> (WDSession, WD a) -> IO a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry WDSession -> WD a -> IO a
forall a. WDSession -> WD a -> IO a
runWD)

-- | Same as `runWD`, but starts Selenium before execution and kills Selenium after execution. 
-- Will download Selenium or Chrome's webdriver (chromedriver) if any is missing. 
wrappedChromeRunWD ::  WDSession -> WD a -> IO a
wrappedChromeRunWD :: forall a. WDSession -> WD a -> IO a
wrappedChromeRunWD WDSession
session WD a
wd = Browser -> (WDSession, WD a) -> ((WDSession, WD a) -> IO a) -> IO a
forall a b. Browser -> a -> (a -> IO b) -> IO b
wrapWebDriverFunction (Chrome{}) (WDSession
session, WD a
wd) ((WDSession -> WD a -> IO a) -> (WDSession, WD a) -> IO a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry WDSession -> WD a -> IO a
forall a. WDSession -> WD a -> IO a
runWD)

-- | Runs a function in between starting and killing Selenium. Takes in the arguments and the function, in that order. 
-- Will download Selenium and the Browser's webdriver (geckodriver or chromedriver) if any is missing. 
wrapWebDriverFunction :: Browser -> a -> (a -> IO b) -> IO b
wrapWebDriverFunction :: forall a b. Browser -> a -> (a -> IO b) -> IO b
wrapWebDriverFunction Browser
browser' a
webdriverArgs a -> IO b
webdriverFunction = do
    case Browser
browser' of
        Firefox {}             -> IO ()
downloadIfMissingGecko
        Chrome  {Maybe FilePath
chromeBinary :: Maybe FilePath
chromeBinary :: Browser -> Maybe FilePath
chromeBinary} -> Maybe FilePath -> IO ()
downloadIfMissingChrome Maybe FilePath
chromeBinary
        Browser
_                      -> FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"unsuported browser"

    IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> IO ())
-> ((Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
    -> IO b)
-> IO b
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (Browser
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
startSelenium Browser
browser')
        (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle) -> IO ()
cleanupProcess
        (IO b
-> (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO b
forall a b. a -> b -> a
const (IO b
 -> (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
 -> IO b)
-> IO b
-> (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
-> IO b
forall a b. (a -> b) -> a -> b
$ a -> IO b
webdriverFunction a
webdriverArgs)

-- | Dowloads Selenium or Firefox's webdriver (geckodriver) if they're missing. 
downloadIfMissingGecko :: IO()
downloadIfMissingGecko :: IO ()
downloadIfMissingGecko =  IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO ()
concurrently_ IO ()
getSeleniumIfNeeded IO ()
getGeckoDriverIfNeeded

-- | Dowloads Selenium or Firefox's webdriver (geckodriver) if they're missing. 
-- Takes a @chromeBinary@'s path, whose @chromedriver@ version will match. 
downloadIfMissingChrome :: Maybe FilePath -> IO()
downloadIfMissingChrome :: Maybe FilePath -> IO ()
downloadIfMissingChrome Maybe FilePath
chromeBinary' =  IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO ()
concurrently_ IO ()
getSeleniumIfNeeded (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe FilePath -> IO ()
getChromeDriverIfNeeded Maybe FilePath
chromeBinary'