{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{- |
Module : Test.WebDriverWrapper.Constants
Description : Constant values, such as links and paths.
 -}
module Test.WebDriverWrapper.Constants (chromeDriverArchiveDirectory, chromeDriverArchivePath, chromeDriverArchIndex, chromeDriverVersionsUrl, chromeDriverPath, geckoDriverPath, defaultPath, defaultSeleniumJarUrl, desiredPlatform, getGeckoDriverDownloadUrl, geckoDriverVersionSource, downloadPath, geckoArchivePath, fileFormat, seleniumPath, seleniumLogPath) where

import Data.String.Interpolate (i)
import qualified System.Info as SI
import System.Directory (getXdgDirectory, XdgDirectory (XdgData))
import System.FilePath ((</>))

-- Paths. Should be platform independent.
-- | @haskell-webdriver-wrapper@ directory, created at `XdgData`. 
defaultPath :: IO FilePath
defaultPath :: IO FilePath
defaultPath = XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
XdgData FilePath
"haskell-webdriver-wrapper"

-- | Directory named after `desiredPlatform`, created at the `defaultPath`.
downloadPath :: IO FilePath
downloadPath :: IO FilePath
downloadPath = (FilePath -> FilePath -> FilePath
</> FilePath
desiredPlatform) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
defaultPath

-- | Intermediary path for the compressed version of geckodriver. Inside `downloadPath`.
geckoArchivePath :: IO FilePath
geckoArchivePath :: IO FilePath
geckoArchivePath = (FilePath -> FilePath -> FilePath
</> FilePath
archive) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
downloadPath
    where
        archive :: FilePath
archive = FilePath
"geckodriver" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
fileFormat

-- | Path for geckodriver. Inside `downloadPath`. 
geckoDriverPath :: IO FilePath
geckoDriverPath :: IO FilePath
geckoDriverPath = (FilePath -> FilePath -> FilePath
</> FilePath
"geckodriver") (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
downloadPath

-- | Intermediary path for the compressed version of chromedriver. Inside `downloadPath`.
chromeDriverArchivePath :: IO FilePath
chromeDriverArchivePath :: IO FilePath
chromeDriverArchivePath = (FilePath -> FilePath -> FilePath
</> FilePath
"chromedriver.zip") (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
downloadPath

-- | Where chromedriver initially gets unziped to
chromeDriverArchiveDirectory :: IO FilePath
chromeDriverArchiveDirectory :: IO FilePath
chromeDriverArchiveDirectory = (FilePath -> FilePath -> FilePath
</> FilePath
chromeDriverRelativeZipPath) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
downloadPath

-- | Path for chromedriver. Inside `downloadPath`. 
chromeDriverPath :: IO FilePath
chromeDriverPath :: IO FilePath
chromeDriverPath = (FilePath -> FilePath -> FilePath
</> FilePath
"chromedriver") (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
downloadPath

-- | Path for selenium.jar. Inside `downloadPath`.
seleniumPath :: IO FilePath
seleniumPath :: IO FilePath
seleniumPath = (FilePath -> FilePath -> FilePath
</> FilePath
"selenium.jar") (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
downloadPath

-- | Path for Selenium's log file. Inside `defaultPath`. 
seleniumLogPath :: IO FilePath
seleniumLogPath :: IO FilePath
seleniumLogPath = (FilePath -> FilePath -> FilePath
</> FilePath
"selenium.log") (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
defaultPath

-- URLs. Might change at any moment, kinda why I'm putting them all together here.
-- | Url to download Selenium from. 
defaultSeleniumJarUrl :: String
defaultSeleniumJarUrl :: FilePath
defaultSeleniumJarUrl = FilePath
"https://selenium-release.storage.googleapis.com/3.141/selenium-server-standalone-3.141.59.jar"

-- | API to get geckodriver's latest version.
geckoDriverVersionSource :: String
geckoDriverVersionSource :: FilePath
geckoDriverVersionSource = FilePath
"https://api.github.com/repos/mozilla/geckodriver/releases/latest"

-- | Url to download geckodriver from. Always the latest version provided by `geckoDriverVersionSource`.
getGeckoDriverDownloadUrl :: String -> String
getGeckoDriverDownloadUrl :: FilePath -> FilePath
getGeckoDriverDownloadUrl FilePath
version = [i|https://github.com/mozilla/geckodriver/releases/download/#{version}/geckodriver-#{version}-#{platform}#{format}|]
    where
        platform :: FilePath
platform = FilePath
desiredPlatform
        format :: FilePath
format = FilePath
fileFormat

-- | API to get chromedriver's download url.
chromeDriverVersionsUrl :: String
chromeDriverVersionsUrl :: FilePath
chromeDriverVersionsUrl = FilePath
"https://googlechromelabs.github.io/chrome-for-testing/known-good-versions-with-downloads.json"

-- Platform-dependent variables. 
-- | Archive format for geckodriver's download. @.zip@ for Windows, @.tar.gz@ for everyone else. 
fileFormat :: String
fileFormat :: FilePath
fileFormat = case FilePath
SI.os of
    FilePath
"windows" -> FilePath
".zip"
    FilePath
"mingw32" -> FilePath
".zip"

    FilePath
"darwrin" -> FilePath
".tar.gz"
    FilePath
"linux"   -> FilePath
".tar.gz"

    FilePath
_         -> FilePath
".tar.gz"

-- | Platform this code is running at. The options are:
-- 
--      * win64
--      * win-aarch64
--      * win32
--      * macos
--      * macos-aarch64
--      * linux64
--      * linux-aarch64
--      * linux32
-- 
--  If the platform is not identified, @linux64@ is used. 
desiredPlatform :: String
desiredPlatform :: FilePath
desiredPlatform = case (FilePath
SI.os, FilePath
SI.arch) of
    (FilePath
"windows", FilePath
"x86_64")   -> FilePath
"win64"
    (FilePath
"windows", FilePath
"aarch64")  -> FilePath
"win-aarch64"
    (FilePath
"windows", FilePath
"i386")     -> FilePath
"win32"
    (FilePath
"mingw32", FilePath
"x86_64")   -> FilePath
"win64"
    (FilePath
"mingw32", FilePath
"aarch64")  -> FilePath
"win-aarch64"
    (FilePath
"mingw32", FilePath
"i386")     -> FilePath
"win32"

    (FilePath
"darwin", FilePath
"x86_64")    -> FilePath
"macos"
    (FilePath
"darwin", FilePath
"aarch64")   -> FilePath
"macos-aarch64"

    (FilePath
"linux", FilePath
"x86_64")     -> FilePath
"linux64"
    (FilePath
"linux", FilePath
"aarch64")    -> FilePath
"linux-aarch64"
    (FilePath
"linux", FilePath
"i386")       -> FilePath
"linux32"

    (FilePath, FilePath)
_ -> FilePath
"linux64"

-- | Index for `chromeDriverVersionsUrl`, which provides a list of urls where each platform is represented by an entry.
--  If the platform is not identified, @linux64@'s index is used.
chromeDriverArchIndex :: Int
chromeDriverArchIndex :: Int
chromeDriverArchIndex = case (FilePath
SI.os, FilePath
SI.arch) of
    (FilePath
"linux", FilePath
"x86_64")   -> Int
0
    (FilePath
"darwin", FilePath
"aarch64") -> Int
1
    (FilePath
"darwin", FilePath
"x86_64")  -> Int
2
    (FilePath
"windows", FilePath
"i386")   -> Int
3
    (FilePath
"mingw32", FilePath
"i386")   -> Int
3
    (FilePath
"windows", FilePath
"x86_64") -> Int
4

    (FilePath, FilePath)
_ -> Int
0

chromeDriverRelativeZipPath :: FilePath
chromeDriverRelativeZipPath :: FilePath
chromeDriverRelativeZipPath = FilePath
"chromedriver-" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> case (FilePath
SI.os, FilePath
SI.arch) of
    (FilePath
"linux", FilePath
"x86_64")   -> FilePath
"linux64"
    (FilePath
"darwin", FilePath
"aarch64") -> FilePath
"mac-arm64"
    (FilePath
"darwin", FilePath
"x86_64")  -> FilePath
"max-x64"
    (FilePath
"windows", FilePath
"i386")   -> FilePath
"win32"
    (FilePath
"mingw32", FilePath
"i386")   -> FilePath
"win32"
    (FilePath
"windows", FilePath
"x86_64") -> FilePath
"win64"

    (FilePath, FilePath)
_ -> FilePath
"linux64"