{-# LANGUAGE TemplateHaskell #-}

module Test.WebDriver.Commands.Sessions (
  -- * Server information
  serverStatus

  -- * Timeouts
  , getTimeouts
  , setTimeouts

  -- ** Set individual timeouts
  , setScriptTimeout
  , setPageLoadTimeout
  , setImplicitWait

  -- * Types
  , Timeouts(..)
  , emptyTimeouts

  -- , sessions
  -- , getActualCaps
  ) where

import Data.Aeson as A
import Data.Aeson.TH as A
import GHC.Stack
import Test.WebDriver.Capabilities.Aeson
import Test.WebDriver.Types
import Test.WebDriver.Util.Commands


-- | Get information from the server as a JSON 'Object'. For more information
-- about this object see
-- <https://github.com/SeleniumHQ/selenium/wiki/JsonWireProtocol#status>
serverStatus :: (HasCallStack, WebDriver wd) => wd Value   -- todo: make this a record type
serverStatus :: forall (wd :: * -> *). (HasCallStack, WebDriver wd) => wd Value
serverStatus = Method -> Text -> Value -> wd Value
forall (m :: * -> *) a b.
(HasCallStack, WebDriver m, ToJSON a, FromJSON b) =>
Method -> Text -> a -> m b
doCommand Method
methodGet Text
"/status" Value
Null

-- -- | Get the actual server-side 'Capabilities' of the current session.
-- -- TODO: remove, seems not to exist in the W3C spec
-- getActualCaps :: (HasCallStack, WebDriver wd) => wd Capabilities
-- getActualCaps = doSessCommand methodGet "" Null

data Timeouts = Timeouts {
  -- | Determines when to interrupt a script that is being evaluated.
  Timeouts -> Maybe Integer
timeoutsScript :: Maybe Integer
  -- | Provides the timeout limit used to interrupt navigation of the browsing context.
  , Timeouts -> Maybe Integer
timeoutsPageLoad :: Maybe Integer
  -- | Gives the timeout of when to abort locating an element.
  , Timeouts -> Maybe Integer
timeoutsImplicit :: Maybe Integer
  } deriving (Int -> Timeouts -> ShowS
[Timeouts] -> ShowS
Timeouts -> String
(Int -> Timeouts -> ShowS)
-> (Timeouts -> String) -> ([Timeouts] -> ShowS) -> Show Timeouts
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Timeouts -> ShowS
showsPrec :: Int -> Timeouts -> ShowS
$cshow :: Timeouts -> String
show :: Timeouts -> String
$cshowList :: [Timeouts] -> ShowS
showList :: [Timeouts] -> ShowS
Show, Timeouts -> Timeouts -> Bool
(Timeouts -> Timeouts -> Bool)
-> (Timeouts -> Timeouts -> Bool) -> Eq Timeouts
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Timeouts -> Timeouts -> Bool
== :: Timeouts -> Timeouts -> Bool
$c/= :: Timeouts -> Timeouts -> Bool
/= :: Timeouts -> Timeouts -> Bool
Eq)
deriveJSON toCamel1 ''Timeouts
emptyTimeouts :: Timeouts
emptyTimeouts :: Timeouts
emptyTimeouts = Maybe Integer -> Maybe Integer -> Maybe Integer -> Timeouts
Timeouts Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing Maybe Integer
forall a. Maybe a
Nothing

-- | Get all the 'Timeouts' simultaneously.
getTimeouts :: (HasCallStack, WebDriver wd) => wd Timeouts
getTimeouts :: forall (wd :: * -> *). (HasCallStack, WebDriver wd) => wd Timeouts
getTimeouts = Method -> Text -> Value -> wd Timeouts
forall (m :: * -> *) a b.
(HasCallStack, WebDriver m, ToJSON a, FromJSON b) =>
Method -> Text -> a -> m b
doSessCommand Method
methodGet Text
"/timeouts" Value
Null

-- | Set all the 'Timeouts' simultaneously.
setTimeouts :: (HasCallStack, WebDriver wd) => Timeouts -> wd ()
setTimeouts :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Timeouts -> wd ()
setTimeouts Timeouts
timeouts = Method -> Text -> Value -> wd ()
forall (m :: * -> *) a b.
(HasCallStack, WebDriver m, ToJSON a, FromJSON b) =>
Method -> Text -> a -> m b
doSessCommand Method
methodPost Text
"/timeouts" (Timeouts -> Value
forall a. ToJSON a => a -> Value
A.toJSON Timeouts
timeouts)

-- | Set the "script" value of the 'Timeouts'.
-- Selenium 3 and 4 accept @null@ for this value, which unsets it. The spec doesn't mention this.
setScriptTimeout :: (HasCallStack, WebDriver wd) => Maybe Integer -> wd ()
setScriptTimeout :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Maybe Integer -> wd ()
setScriptTimeout Maybe Integer
x = Method -> Text -> Value -> wd ()
forall (m :: * -> *) a b.
(HasCallStack, WebDriver m, ToJSON a, FromJSON b) =>
Method -> Text -> a -> m b
doSessCommand Method
methodPost Text
"/timeouts" ([Pair] -> Value
A.object [(Key
"script", Value -> (Integer -> Value) -> Maybe Integer -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
A.Null (Scientific -> Value
A.Number (Scientific -> Value)
-> (Integer -> Scientific) -> Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral) Maybe Integer
x)])

-- | Set the "pageLoad" value of the 'Timeouts'.
setPageLoadTimeout :: (HasCallStack, WebDriver wd) => Integer -> wd ()
setPageLoadTimeout :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Integer -> wd ()
setPageLoadTimeout Integer
x = Method -> Text -> Value -> wd ()
forall (m :: * -> *) a b.
(HasCallStack, WebDriver m, ToJSON a, FromJSON b) =>
Method -> Text -> a -> m b
doSessCommand Method
methodPost Text
"/timeouts" ([Pair] -> Value
A.object [(Key
"pageLoad", Scientific -> Value
A.Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)])

-- | Set the "implicit" value of the 'Timeouts'.
setImplicitWait :: (HasCallStack, WebDriver wd) => Integer -> wd ()
setImplicitWait :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Integer -> wd ()
setImplicitWait Integer
x = Method -> Text -> Value -> wd ()
forall (m :: * -> *) a b.
(HasCallStack, WebDriver m, ToJSON a, FromJSON b) =>
Method -> Text -> a -> m b
doSessCommand Method
methodPost Text
"/timeouts" ([Pair] -> Value
A.object [(Key
"implicit", Scientific -> Value
A.Number (Scientific -> Value) -> Scientific -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x)])