module Test.WebDriver.Commands.CommandContexts (
  getCurrentWindow
  , closeWindow
  , focusWindow
  , windows
  , focusFrame
  , focusParentFrame

  -- * Resizing and positioning windows
  , getWindowRect
  , setWindowRect
  , maximize
  , minimize
  , fullscreen

  -- * Types
  , FrameSelector(..)
  , Rect(..)
  , WindowHandle(..)
  ) where

import Control.Monad
import Data.Aeson as A
import Data.Aeson.Types
import Data.Text (Text)
import GHC.Stack
import Test.WebDriver.JSON
import Test.WebDriver.Types
import Test.WebDriver.Util.Commands


-- | Returns a handle to the currently focused window
getCurrentWindow :: (HasCallStack, WebDriver wd) => wd WindowHandle
getCurrentWindow :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
wd WindowHandle
getCurrentWindow = Method -> Text -> Value -> wd WindowHandle
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodGet Text
"/window" Value
Null

-- | Closes the given window
closeWindow :: (HasCallStack, WebDriver wd) => WindowHandle -> wd ()
closeWindow :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
WindowHandle -> wd ()
closeWindow WindowHandle
w = do
  WindowHandle
cw <- wd WindowHandle
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
wd WindowHandle
getCurrentWindow
  WindowHandle -> wd ()
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
WindowHandle -> wd ()
focusWindow WindowHandle
w
  wd Value -> wd ()
forall (m :: * -> *). WebDriver m => m Value -> m ()
ignoreReturn (wd Value -> wd ()) -> wd Value -> wd ()
forall a b. (a -> b) -> a -> b
$ Method -> Text -> Value -> wd Value
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodDelete Text
"/window" Value
Null
  Bool -> wd () -> wd ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (WindowHandle
w WindowHandle -> WindowHandle -> Bool
forall a. Eq a => a -> a -> Bool
== WindowHandle
cw) (wd () -> wd ()) -> wd () -> wd ()
forall a b. (a -> b) -> a -> b
$ WindowHandle -> wd ()
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
WindowHandle -> wd ()
focusWindow WindowHandle
cw

-- | Switch to a given window
focusWindow :: (HasCallStack, WebDriver wd) => WindowHandle -> wd ()
focusWindow :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
WindowHandle -> wd ()
focusWindow WindowHandle
w = wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn (wd NoReturn -> wd ()) -> wd NoReturn -> wd ()
forall a b. (a -> b) -> a -> b
$ Method -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/window" (Value -> wd NoReturn)
-> (WindowHandle -> Value) -> WindowHandle -> wd NoReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> WindowHandle -> Value
forall a. ToJSON a => Text -> a -> Value
single Text
"handle" (WindowHandle -> wd NoReturn) -> WindowHandle -> wd NoReturn
forall a b. (a -> b) -> a -> b
$ WindowHandle
w

-- | Returns a list of all windows available to the session
windows :: (HasCallStack, WebDriver wd) => wd [WindowHandle]
windows :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
wd [WindowHandle]
windows = Method -> Text -> Value -> wd [WindowHandle]
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodGet Text
"/window/handles" Value
Null

-- | Switch focus to the frame specified by the FrameSelector.
focusFrame :: (HasCallStack, WebDriver wd) => FrameSelector -> wd ()
focusFrame :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
FrameSelector -> wd ()
focusFrame FrameSelector
s = wd NoReturn -> wd ()
forall (m :: * -> *). WebDriver m => m NoReturn -> m ()
noReturn (wd NoReturn -> wd ()) -> wd NoReturn -> wd ()
forall a b. (a -> b) -> a -> b
$ Method -> Text -> Value -> wd NoReturn
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/frame" (Value -> wd NoReturn)
-> (FrameSelector -> Value) -> FrameSelector -> wd NoReturn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FrameSelector -> Value
forall a. ToJSON a => Text -> a -> Value
single Text
"id" (FrameSelector -> wd NoReturn) -> FrameSelector -> wd NoReturn
forall a b. (a -> b) -> a -> b
$ FrameSelector
s

-- | Switch focus to the frame specified by the FrameSelector.
focusParentFrame :: (HasCallStack, WebDriver wd) => wd ()
focusParentFrame :: forall (wd :: * -> *). (HasCallStack, WebDriver wd) => wd ()
focusParentFrame = wd Value -> wd ()
forall (m :: * -> *). WebDriver m => m Value -> m ()
ignoreReturn (wd Value -> wd ()) -> wd Value -> wd ()
forall a b. (a -> b) -> a -> b
$ 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
"/frame/parent" ([Pair] -> Value
A.object [])

-- | Get the dimensions of the current window.
getWindowRect :: (HasCallStack, WebDriver wd) => wd Rect
getWindowRect :: forall (wd :: * -> *). (HasCallStack, WebDriver wd) => wd Rect
getWindowRect = Method -> Text -> Value -> wd Rect
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodGet Text
"/window/rect" Value
Null

-- | Set the dimensions of the current window.
setWindowRect :: (HasCallStack, WebDriver wd) => Rect -> wd ()
setWindowRect :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Rect -> wd ()
setWindowRect = wd Value -> wd ()
forall (m :: * -> *). WebDriver m => m Value -> m ()
ignoreReturn (wd Value -> wd ()) -> (Rect -> wd Value) -> Rect -> wd ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Method -> Text -> Rect -> wd Value
forall (wd :: * -> *) a b.
(HasCallStack, WebDriver wd, ToJSON a, FromJSON b) =>
Method -> Text -> a -> wd b
doSessCommand Method
methodPost Text
"/window/rect"

-- | Maximizes the current window
maximize :: (HasCallStack, WebDriver wd) => wd ()
maximize :: forall (wd :: * -> *). (HasCallStack, WebDriver wd) => wd ()
maximize = wd Value -> wd ()
forall (m :: * -> *). WebDriver m => m Value -> m ()
ignoreReturn (wd Value -> wd ()) -> wd Value -> wd ()
forall a b. (a -> b) -> a -> b
$ 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
"/window/maximize" ([Pair] -> Value
A.object [])

-- | Minimizes the current window
minimize :: (HasCallStack, WebDriver wd) => wd ()
minimize :: forall (wd :: * -> *). (HasCallStack, WebDriver wd) => wd ()
minimize = wd Value -> wd ()
forall (m :: * -> *). WebDriver m => m Value -> m ()
ignoreReturn (wd Value -> wd ()) -> wd Value -> wd ()
forall a b. (a -> b) -> a -> b
$ 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
"/window/minimize" ([Pair] -> Value
A.object [])

-- | Fullscreens the current window
fullscreen :: (HasCallStack, WebDriver wd) => wd ()
fullscreen :: forall (wd :: * -> *). (HasCallStack, WebDriver wd) => wd ()
fullscreen = wd Value -> wd ()
forall (m :: * -> *). WebDriver m => m Value -> m ()
ignoreReturn (wd Value -> wd ()) -> wd Value -> wd ()
forall a b. (a -> b) -> a -> b
$ 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
"/window/fullscreen" ([Pair] -> Value
A.object [])


-- | Specifies the frame used by 'Test.WebDriver.Commands.focusFrame'
data FrameSelector =
  WithIndex Integer
  -- | Focus on a frame by name or ID
  | WithName Text
  -- | Focus on a frame 'Element'
  | WithElement Element
  -- | Focus on the first frame, or the main document if iframes are used.
  | DefaultFrame
  deriving (FrameSelector -> FrameSelector -> Bool
(FrameSelector -> FrameSelector -> Bool)
-> (FrameSelector -> FrameSelector -> Bool) -> Eq FrameSelector
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FrameSelector -> FrameSelector -> Bool
== :: FrameSelector -> FrameSelector -> Bool
$c/= :: FrameSelector -> FrameSelector -> Bool
/= :: FrameSelector -> FrameSelector -> Bool
Eq, Int -> FrameSelector -> ShowS
[FrameSelector] -> ShowS
FrameSelector -> String
(Int -> FrameSelector -> ShowS)
-> (FrameSelector -> String)
-> ([FrameSelector] -> ShowS)
-> Show FrameSelector
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FrameSelector -> ShowS
showsPrec :: Int -> FrameSelector -> ShowS
$cshow :: FrameSelector -> String
show :: FrameSelector -> String
$cshowList :: [FrameSelector] -> ShowS
showList :: [FrameSelector] -> ShowS
Show, ReadPrec [FrameSelector]
ReadPrec FrameSelector
Int -> ReadS FrameSelector
ReadS [FrameSelector]
(Int -> ReadS FrameSelector)
-> ReadS [FrameSelector]
-> ReadPrec FrameSelector
-> ReadPrec [FrameSelector]
-> Read FrameSelector
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FrameSelector
readsPrec :: Int -> ReadS FrameSelector
$creadList :: ReadS [FrameSelector]
readList :: ReadS [FrameSelector]
$creadPrec :: ReadPrec FrameSelector
readPrec :: ReadPrec FrameSelector
$creadListPrec :: ReadPrec [FrameSelector]
readListPrec :: ReadPrec [FrameSelector]
Read)

instance ToJSON FrameSelector where
  toJSON :: FrameSelector -> Value
toJSON FrameSelector
s = case FrameSelector
s of
    WithIndex Integer
i -> Integer -> Value
forall a. ToJSON a => a -> Value
toJSON Integer
i
    WithName Text
n -> Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
n
    WithElement Element
e -> Element -> Value
forall a. ToJSON a => a -> Value
toJSON Element
e
    FrameSelector
DefaultFrame -> Value
Null

data Rect = Rect {
  Rect -> Float
rectX :: Float
  , Rect -> Float
rectY :: Float
  , Rect -> Float
rectWidth :: Float
  , Rect -> Float
rectHeight :: Float
  } deriving (Rect -> Rect -> Bool
(Rect -> Rect -> Bool) -> (Rect -> Rect -> Bool) -> Eq Rect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rect -> Rect -> Bool
== :: Rect -> Rect -> Bool
$c/= :: Rect -> Rect -> Bool
/= :: Rect -> Rect -> Bool
Eq, Eq Rect
Eq Rect =>
(Rect -> Rect -> Ordering)
-> (Rect -> Rect -> Bool)
-> (Rect -> Rect -> Bool)
-> (Rect -> Rect -> Bool)
-> (Rect -> Rect -> Bool)
-> (Rect -> Rect -> Rect)
-> (Rect -> Rect -> Rect)
-> Ord Rect
Rect -> Rect -> Bool
Rect -> Rect -> Ordering
Rect -> Rect -> Rect
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
$ccompare :: Rect -> Rect -> Ordering
compare :: Rect -> Rect -> Ordering
$c< :: Rect -> Rect -> Bool
< :: Rect -> Rect -> Bool
$c<= :: Rect -> Rect -> Bool
<= :: Rect -> Rect -> Bool
$c> :: Rect -> Rect -> Bool
> :: Rect -> Rect -> Bool
$c>= :: Rect -> Rect -> Bool
>= :: Rect -> Rect -> Bool
$cmax :: Rect -> Rect -> Rect
max :: Rect -> Rect -> Rect
$cmin :: Rect -> Rect -> Rect
min :: Rect -> Rect -> Rect
Ord, Int -> Rect -> ShowS
[Rect] -> ShowS
Rect -> String
(Int -> Rect -> ShowS)
-> (Rect -> String) -> ([Rect] -> ShowS) -> Show Rect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rect -> ShowS
showsPrec :: Int -> Rect -> ShowS
$cshow :: Rect -> String
show :: Rect -> String
$cshowList :: [Rect] -> ShowS
showList :: [Rect] -> ShowS
Show)

instance FromJSON Rect where
  parseJSON :: Value -> Parser Rect
parseJSON (Object Object
o) = Float -> Float -> Float -> Float -> Rect
Rect (Float -> Float -> Float -> Float -> Rect)
-> Parser Float -> Parser (Float -> Float -> Float -> Rect)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Float
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"x"
                              Parser (Float -> Float -> Float -> Rect)
-> Parser Float -> Parser (Float -> Float -> Rect)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Float
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"y"
                              Parser (Float -> Float -> Rect)
-> Parser Float -> Parser (Float -> Rect)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Float
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"width"
                              Parser (Float -> Rect) -> Parser Float -> Parser Rect
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Float
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"height"
  parseJSON Value
j = String -> Value -> Parser Rect
forall a. String -> Value -> Parser a
typeMismatch String
"Rect" Value
j

instance ToJSON Rect where
  toJSON :: Rect -> Value
toJSON (Rect Float
x Float
y Float
width Float
height)
    = [Pair] -> Value
object [ Key
"x" Key -> Float -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Float
x
             , Key
"y" Key -> Float -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Float
y
             , Key
"width" Key -> Float -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Float
width
             , Key
"height" Key -> Float -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Float
height
             ]