{-# LANGUAGE ExistentialQuantification #-}

module Test.WebDriver.Commands.DocumentHandling (
  getSource
  , executeJS
  , asyncJS
  , JSArg(..)
  ) where

import Data.Aeson as A
import qualified Data.Foldable as F
import qualified Data.List as L
import Data.Text (Text)
import GHC.Stack
import Test.WebDriver.Exceptions
import Test.WebDriver.JSON
import Test.WebDriver.Types
import Test.WebDriver.Util.Commands
import UnliftIO.Exception (handle, throwIO)


-- | Get the current page source
getSource :: (HasCallStack, WebDriver wd) => wd Text
getSource :: forall (wd :: * -> *). (HasCallStack, WebDriver wd) => wd Text
getSource = Method -> Text -> Value -> wd Text
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodGet Text
"/source" Value
Null

{- | Inject a snippet of Javascript into the page for execution in the
context of the currently selected frame. The executed script is
assumed to be synchronous and the result of evaluating the script is
returned and converted to an instance of FromJSON.

The first parameter defines a sequence of arguments to pass to the javascript
function. Arguments of type Element will be converted to the
corresponding DOM element. Likewise, any elements in the script result
will be returned to the client as Elements.

The second parameter defines the script itself in the form of a
function body. The value returned by that function will be returned to
the client. The function will be invoked with the provided argument
list and the values may be accessed via the arguments object in the
order specified.

When using 'executeJS', GHC might complain about an ambiguous type in
situations where the result of the executeJS call is ignored/discard.
Consider the following example:

@
	jsExample = do
		e <- findElem (ByCSS "#foo")
		executeJS [] "someAction()"
		return e
@

Because the result of the 'executeJS' is discarded, GHC cannot resolve
which instance of the 'fromJSON' class to use when parsing the
Selenium server response. In such cases, we can use the 'ignoreReturn'
helper function located in "Test.WebDriver.JSON". 'ignoreReturn' has
no runtime effect; it simply helps the type system by expicitly providing
a `fromJSON` instance to use.

@
	import Test.WebDriver.JSON (ignoreReturn)
	jsExample = do
		e <- findElem (ByCSS "#foo")
		ignoreReturn $ executeJS [] "someAction()"
		return e
@
-}
executeJS :: (HasCallStack, F.Foldable f, FromJSON a, WebDriver wd) => f JSArg -> Text -> wd a
executeJS :: forall (f :: * -> *) a (wd :: * -> *).
(HasCallStack, Foldable f, FromJSON a, WebDriver wd) =>
f JSArg -> Text -> wd a
executeJS f JSArg
a Text
s = do
  (Method -> Text -> Value -> wd Value
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/execute/sync" (Value -> wd Value)
-> (([JSArg], Text) -> Value) -> ([JSArg], Text) -> wd Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> ([JSArg], Text) -> Value
forall a b. (ToJSON a, ToJSON b) => (Text, Text) -> (a, b) -> Value
pair (Text
"args", Text
"script") (([JSArg], Text) -> wd Value) -> ([JSArg], Text) -> wd Value
forall a b. (a -> b) -> a -> b
$ (f JSArg -> [JSArg]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f JSArg
a,Text
s))
    wd Value -> (Value -> wd a) -> wd a
forall a b. wd a -> (a -> wd b) -> wd b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> wd a
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => Value -> m a
fromJSON'

-- | Executes a snippet of Javascript code asynchronously. This function works
-- similarly to 'executeJS', except that the Javascript is passed a callback
-- function as its final argument. The script should call this function
-- to signal that it has finished executing, passing to it a value that will be
-- returned as the result of asyncJS. A result of Nothing indicates that the
-- Javascript function timed out (see 'setScriptTimeout')
asyncJS :: (HasCallStack, F.Foldable f, FromJSON a, WebDriver wd) => f JSArg -> Text -> wd (Maybe a)
asyncJS :: forall (f :: * -> *) a (wd :: * -> *).
(HasCallStack, Foldable f, FromJSON a, WebDriver wd) =>
f JSArg -> Text -> wd (Maybe a)
asyncJS f JSArg
a Text
s = (FailedCommand -> wd (Maybe a)) -> wd (Maybe a) -> wd (Maybe a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
(e -> m a) -> m a -> m a
handle FailedCommand -> wd (Maybe a)
forall {m :: * -> *} {a}. MonadIO m => FailedCommand -> m (Maybe a)
timeout (wd (Maybe a) -> wd (Maybe a)) -> wd (Maybe a) -> wd (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
  a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> wd a -> wd (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> wd a
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => Value -> m a
fromJSON' (Value -> wd a) -> wd Value -> wd a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> wd Value
forall {wd :: * -> *} {b}.
(WebDriverBase wd, SessionState wd, FromJSON b) =>
Text -> wd b
getResult Text
"/execute/async")

  where
    getResult :: Text -> wd b
getResult Text
endpoint = Method -> Text -> Value -> wd b
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
endpoint (Value -> wd b)
-> (([JSArg], Text) -> Value) -> ([JSArg], Text) -> wd b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Text) -> ([JSArg], Text) -> Value
forall a b. (ToJSON a, ToJSON b) => (Text, Text) -> (a, b) -> Value
pair (Text
"args", Text
"script") (([JSArg], Text) -> wd b) -> ([JSArg], Text) -> wd b
forall a b. (a -> b) -> a -> b
$ (f JSArg -> [JSArg]
forall a. f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList f JSArg
a,Text
s)

    timeout :: FailedCommand -> m (Maybe a)
timeout (FailedCommand {FailedCommandError
rspError :: FailedCommandError
rspError :: FailedCommand -> FailedCommandError
rspError})
      | FailedCommandError
rspError FailedCommandError -> [FailedCommandError] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`L.elem` [FailedCommandError
Timeout, FailedCommandError
ScriptTimeout] = Maybe a -> m (Maybe a)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    timeout FailedCommand
err = FailedCommand -> m (Maybe a)
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO FailedCommand
err

-- | An existential wrapper for any 'ToJSON' instance. This allows us to pass
-- parameters of many different types to Javascript code.
data JSArg = forall a. ToJSON a => JSArg a

instance ToJSON JSArg where
  toJSON :: JSArg -> Value
toJSON (JSArg a
a) = a -> Value
forall a. ToJSON a => a -> Value
toJSON a
a