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

{- |
Module : Test.WebDriverWrapper.Constants
Description : Constant values, such as links and paths.
 -}

module Test.WebDriverWrapper.Constants (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 String
defaultPath = XdgDirectory -> String -> IO String
getXdgDirectory XdgDirectory
XdgData String
"haskell-webdriver-wrapper"

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

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

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

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

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

-- URLs. Might change at any moment, kinda why I'm putting them all together here.
-- | Url to download Selenium from. 
defaultSeleniumJarUrl :: String
defaultSeleniumJarUrl :: String
defaultSeleniumJarUrl = String
"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 :: String
geckoDriverVersionSource = String
"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 :: String -> String
getGeckoDriverDownloadUrl String
version = [i|https://github.com/mozilla/geckodriver/releases/download/#{version}/geckodriver-#{version}-#{platform}#{format}|]
    where
        platform :: String
platform = String
desiredPlatform
        format :: String
format = String
fileFormat

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

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

    String
_         -> String
".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 :: String
desiredPlatform = case (String
SI.os, String
SI.arch) of
    (String
"windows", String
"x86_64")   -> String
"win64"
    (String
"windows", String
"aarch64")  -> String
"win-aarch64"
    (String
"windows", String
"i386")     -> String
"win32"
    (String
"mingw32", String
"x86_64")   -> String
"win64"
    (String
"mingw32", String
"aarch64")  -> String
"win-aarch64"
    (String
"mingw32", String
"i386")     -> String
"win32"

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

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

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