{- |
Module : Core
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. 
-}
module Test.WebDriverWrapper (wrappedRunSession, wrappedRunWD, wrapWebDriverFunction, downloadIfMissing) 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)
import Test.WebDriver.Types (WD, WDSession)
import Test.WebDriver.Config (WebDriverConfig)
import Test.WebDriver.Monad (runWD)
import Control.Exception (bracket)

-- | Same as `runSession`, but starts Selenium before execution and kills Selenium after execution. 
-- Will download Selenium or Firefox's webdriver (geckodriver) if any is missing. 
wrappedRunSession :: WebDriverConfig conf => conf -> WD a -> IO a
wrappedRunSession :: forall conf a. WebDriverConfig conf => conf -> WD a -> IO a
wrappedRunSession conf
conf WD a
wd = (conf, WD a) -> ((conf, WD a) -> IO a) -> IO a
forall a b. a -> (a -> IO b) -> IO b
wrapWebDriverFunction (conf
conf,WD a
wd) ((conf -> WD a -> IO a) -> (conf, WD a) -> IO a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry conf -> 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. 
wrappedRunWD ::  WDSession -> WD a -> IO a 
wrappedRunWD :: forall a. WDSession -> WD a -> IO a
wrappedRunWD WDSession
session WD a
wd = (WDSession, WD a) -> ((WDSession, WD a) -> IO a) -> IO a
forall a b. a -> (a -> IO b) -> IO b
wrapWebDriverFunction (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 or Firefox's webdriver (geckodriver) if any is missing. 
wrapWebDriverFunction :: a -> (a -> IO b) -> IO b
wrapWebDriverFunction :: forall a b. a -> (a -> IO b) -> IO b
wrapWebDriverFunction a
webdriverArgs a -> IO b
webdriverFunction = do
    IO ()
downloadIfMissing
    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
        IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
startSelenium
        (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. 
downloadIfMissing :: IO()
downloadIfMissing :: IO ()
downloadIfMissing =  IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO ()
concurrently_ IO ()
getSeleniumIfNeeded IO ()
getGeckoDriverIfNeeded