{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_HADDOCK not-home #-}
-- | Internal functions used to implement the functions exported by
-- "Test.WebDriver.Commands". These may be useful for implementing non-standard
-- webdriver commands.
module Test.WebDriver.Commands.Internal
       (-- * Low-level webdriver functions
         doCommand
        -- ** Commands with :sessionId URL parameter
       , doSessCommand, SessionId(..)
        -- ** Commands with element :id URL parameters
       , doElemCommand, Element(..)
        -- ** Commands with :windowHandle URL parameters
       , doWinCommand, WindowHandle(..), currentWindow
        -- * Exceptions
       , NoSessionId(..)
       ) where

import Test.WebDriver.Class
import Test.WebDriver.JSON
import Test.WebDriver.Session
import Test.WebDriver.Utils (urlEncode)

import Control.Applicative
import Control.Exception.Lifted
import Data.Aeson
import Data.Aeson.Types
import Data.CallStack
import Data.Default.Class
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable

import Prelude -- hides some "unused import" warnings

{- |An opaque identifier for a web page element. -}
newtype Element = Element Text
                  deriving (Element -> Element -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Element -> Element -> Bool
$c/= :: Element -> Element -> Bool
== :: Element -> Element -> Bool
$c== :: Element -> Element -> Bool
Eq, Eq Element
Element -> Element -> Bool
Element -> Element -> Ordering
Element -> Element -> Element
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Element -> Element -> Element
$cmin :: Element -> Element -> Element
max :: Element -> Element -> Element
$cmax :: Element -> Element -> Element
>= :: Element -> Element -> Bool
$c>= :: Element -> Element -> Bool
> :: Element -> Element -> Bool
$c> :: Element -> Element -> Bool
<= :: Element -> Element -> Bool
$c<= :: Element -> Element -> Bool
< :: Element -> Element -> Bool
$c< :: Element -> Element -> Bool
compare :: Element -> Element -> Ordering
$ccompare :: Element -> Element -> Ordering
Ord, Int -> Element -> ShowS
[Element] -> ShowS
Element -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Element] -> ShowS
$cshowList :: [Element] -> ShowS
show :: Element -> String
$cshow :: Element -> String
showsPrec :: Int -> Element -> ShowS
$cshowsPrec :: Int -> Element -> ShowS
Show, ReadPrec [Element]
ReadPrec Element
Int -> ReadS Element
ReadS [Element]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Element]
$creadListPrec :: ReadPrec [Element]
readPrec :: ReadPrec Element
$creadPrec :: ReadPrec Element
readList :: ReadS [Element]
$creadList :: ReadS [Element]
readsPrec :: Int -> ReadS Element
$creadsPrec :: Int -> ReadS Element
Read)

instance FromJSON Element where
  parseJSON :: Value -> Parser Element
parseJSON (Object Object
o) = Text -> Element
Element forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"ELEMENT" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"element-6066-11e4-a52e-4f735466cecf")
  parseJSON Value
v = forall a. String -> Value -> Parser a
typeMismatch String
"Element" Value
v

instance ToJSON Element where
  toJSON :: Element -> Value
toJSON (Element Text
e) = [Pair] -> Value
object [Key
"ELEMENT" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
e]


{- |An opaque identifier for a browser window -}
newtype WindowHandle = WindowHandle Text
                     deriving (WindowHandle -> WindowHandle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowHandle -> WindowHandle -> Bool
$c/= :: WindowHandle -> WindowHandle -> Bool
== :: WindowHandle -> WindowHandle -> Bool
$c== :: WindowHandle -> WindowHandle -> Bool
Eq, Eq WindowHandle
WindowHandle -> WindowHandle -> Bool
WindowHandle -> WindowHandle -> Ordering
WindowHandle -> WindowHandle -> WindowHandle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WindowHandle -> WindowHandle -> WindowHandle
$cmin :: WindowHandle -> WindowHandle -> WindowHandle
max :: WindowHandle -> WindowHandle -> WindowHandle
$cmax :: WindowHandle -> WindowHandle -> WindowHandle
>= :: WindowHandle -> WindowHandle -> Bool
$c>= :: WindowHandle -> WindowHandle -> Bool
> :: WindowHandle -> WindowHandle -> Bool
$c> :: WindowHandle -> WindowHandle -> Bool
<= :: WindowHandle -> WindowHandle -> Bool
$c<= :: WindowHandle -> WindowHandle -> Bool
< :: WindowHandle -> WindowHandle -> Bool
$c< :: WindowHandle -> WindowHandle -> Bool
compare :: WindowHandle -> WindowHandle -> Ordering
$ccompare :: WindowHandle -> WindowHandle -> Ordering
Ord, Int -> WindowHandle -> ShowS
[WindowHandle] -> ShowS
WindowHandle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowHandle] -> ShowS
$cshowList :: [WindowHandle] -> ShowS
show :: WindowHandle -> String
$cshow :: WindowHandle -> String
showsPrec :: Int -> WindowHandle -> ShowS
$cshowsPrec :: Int -> WindowHandle -> ShowS
Show, ReadPrec [WindowHandle]
ReadPrec WindowHandle
Int -> ReadS WindowHandle
ReadS [WindowHandle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WindowHandle]
$creadListPrec :: ReadPrec [WindowHandle]
readPrec :: ReadPrec WindowHandle
$creadPrec :: ReadPrec WindowHandle
readList :: ReadS [WindowHandle]
$creadList :: ReadS [WindowHandle]
readsPrec :: Int -> ReadS WindowHandle
$creadsPrec :: Int -> ReadS WindowHandle
Read,
                               Value -> Parser [WindowHandle]
Value -> Parser WindowHandle
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WindowHandle]
$cparseJSONList :: Value -> Parser [WindowHandle]
parseJSON :: Value -> Parser WindowHandle
$cparseJSON :: Value -> Parser WindowHandle
FromJSON, [WindowHandle] -> Encoding
[WindowHandle] -> Value
WindowHandle -> Encoding
WindowHandle -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WindowHandle] -> Encoding
$ctoEncodingList :: [WindowHandle] -> Encoding
toJSONList :: [WindowHandle] -> Value
$ctoJSONList :: [WindowHandle] -> Value
toEncoding :: WindowHandle -> Encoding
$ctoEncoding :: WindowHandle -> Encoding
toJSON :: WindowHandle -> Value
$ctoJSON :: WindowHandle -> Value
ToJSON)
instance Default WindowHandle where
  def :: WindowHandle
def = WindowHandle
currentWindow

-- |A special 'WindowHandle' that always refers to the currently focused window.
-- This is also used by the 'Default' instance.
currentWindow :: WindowHandle
currentWindow :: WindowHandle
currentWindow = Text -> WindowHandle
WindowHandle Text
"current"

instance Exception NoSessionId
-- |A command requiring a session ID was attempted when no session ID was
-- available.
newtype NoSessionId = NoSessionId String
                 deriving (NoSessionId -> NoSessionId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NoSessionId -> NoSessionId -> Bool
$c/= :: NoSessionId -> NoSessionId -> Bool
== :: NoSessionId -> NoSessionId -> Bool
$c== :: NoSessionId -> NoSessionId -> Bool
Eq, Int -> NoSessionId -> ShowS
[NoSessionId] -> ShowS
NoSessionId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NoSessionId] -> ShowS
$cshowList :: [NoSessionId] -> ShowS
show :: NoSessionId -> String
$cshow :: NoSessionId -> String
showsPrec :: Int -> NoSessionId -> ShowS
$cshowsPrec :: Int -> NoSessionId -> ShowS
Show, Typeable)

-- |This a convenient wrapper around 'doCommand' that automatically prepends
-- the session URL parameter to the wire command URL. For example, passing
-- a URL of \"/refresh\" will expand to \"/session/:sessionId/refresh\", where
-- :sessionId is a URL parameter as described in
-- <https://github.com/SeleniumHQ/selenium/wiki/JsonWireProtocol>
doSessCommand :: (HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
                  Method -> Text -> a -> wd b
doSessCommand :: forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
method Text
path a
args = do
  WDSession { wdSessId :: WDSession -> Maybe SessionId
wdSessId = Maybe SessionId
mSessId } <- forall (m :: * -> *). WDSessionState m => m WDSession
getSession
  case Maybe SessionId
mSessId of
      Maybe SessionId
Nothing -> forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> NoSessionId
NoSessionId forall a b. (a -> b) -> a -> b
$ String
msg
        where
          msg :: String
msg = String
"doSessCommand: No session ID found for relative URL "
                forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
path
      Just (SessionId Text
sId) ->
        -- Catch BadJSON exceptions here, since most commands go through this function.
        -- Then, re-throw them with "error", which automatically appends a callstack
        -- to the message in modern GHCs.
        -- This callstack makes it easy to see which command caused the BadJSON exception,
        -- without exposing too many internals.
        forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
catch
          (forall (wd :: * -> *) a b.
(WebDriver wd, HasCallStack, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doCommand Method
method ([Text] -> Text
T.concat [Text
"/session/", Text -> Text
urlEncode Text
sId, Text
path]) a
args)
          (\(BadJSON
e :: BadJSON) -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show BadJSON
e)

-- |A wrapper around 'doSessCommand' to create element URLs.
-- For example, passing a URL of "/active" will expand to
-- \"/session/:sessionId/element/:id/active\", where :sessionId and :id are URL
-- parameters as described in the wire protocol.
doElemCommand :: (HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
                  Method -> Element -> Text -> a -> wd b
doElemCommand :: forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Element -> Text -> a -> wd b
doElemCommand Method
m (Element Text
e) Text
path a
a =
  forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
m ([Text] -> Text
T.concat [Text
"/element/", Text -> Text
urlEncode Text
e, Text
path]) a
a

-- |A wrapper around 'doSessCommand' to create window handle URLS.
-- For example, passing a URL of \"/size\" will expand to
-- \"/session/:sessionId/window/:windowHandle/\", where :sessionId and
-- :windowHandle are URL parameters as described in the wire protocol
doWinCommand :: (HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
                 Method -> WindowHandle -> Text -> a -> wd b
doWinCommand :: forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> WindowHandle -> Text -> a -> wd b
doWinCommand Method
m (WindowHandle Text
w) Text
path a
a =
  forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
m ([Text] -> Text
T.concat [Text
"/window/", Text -> Text
urlEncode Text
w, Text
path]) a
a