module Test.WebDriver.Commands.Actions (
  moveTo
  , moveToCenter
  , moveToFrom
  , clickCenter
  , doubleClickCenter

  -- * Lower-level actions API
  , performActions
  , releaseActions
  , Action(..)
  , ActionSource(..)
  , PointerAction(..)
  , KeyAction(..)
  , PointerOrigin(..)

  -- * Types
  , MouseButton(..)
  ) where

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

-- | A mouse button
data MouseButton = LeftButton | MiddleButton | RightButton
  deriving (MouseButton -> MouseButton -> Bool
(MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool) -> Eq MouseButton
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MouseButton -> MouseButton -> Bool
== :: MouseButton -> MouseButton -> Bool
$c/= :: MouseButton -> MouseButton -> Bool
/= :: MouseButton -> MouseButton -> Bool
Eq, Int -> MouseButton -> ShowS
[MouseButton] -> ShowS
MouseButton -> String
(Int -> MouseButton -> ShowS)
-> (MouseButton -> String)
-> ([MouseButton] -> ShowS)
-> Show MouseButton
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MouseButton -> ShowS
showsPrec :: Int -> MouseButton -> ShowS
$cshow :: MouseButton -> String
show :: MouseButton -> String
$cshowList :: [MouseButton] -> ShowS
showList :: [MouseButton] -> ShowS
Show, Eq MouseButton
Eq MouseButton =>
(MouseButton -> MouseButton -> Ordering)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> Bool)
-> (MouseButton -> MouseButton -> MouseButton)
-> (MouseButton -> MouseButton -> MouseButton)
-> Ord MouseButton
MouseButton -> MouseButton -> Bool
MouseButton -> MouseButton -> Ordering
MouseButton -> MouseButton -> MouseButton
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 :: MouseButton -> MouseButton -> Ordering
compare :: MouseButton -> MouseButton -> Ordering
$c< :: MouseButton -> MouseButton -> Bool
< :: MouseButton -> MouseButton -> Bool
$c<= :: MouseButton -> MouseButton -> Bool
<= :: MouseButton -> MouseButton -> Bool
$c> :: MouseButton -> MouseButton -> Bool
> :: MouseButton -> MouseButton -> Bool
$c>= :: MouseButton -> MouseButton -> Bool
>= :: MouseButton -> MouseButton -> Bool
$cmax :: MouseButton -> MouseButton -> MouseButton
max :: MouseButton -> MouseButton -> MouseButton
$cmin :: MouseButton -> MouseButton -> MouseButton
min :: MouseButton -> MouseButton -> MouseButton
Ord, MouseButton
MouseButton -> MouseButton -> Bounded MouseButton
forall a. a -> a -> Bounded a
$cminBound :: MouseButton
minBound :: MouseButton
$cmaxBound :: MouseButton
maxBound :: MouseButton
Bounded, Int -> MouseButton
MouseButton -> Int
MouseButton -> [MouseButton]
MouseButton -> MouseButton
MouseButton -> MouseButton -> [MouseButton]
MouseButton -> MouseButton -> MouseButton -> [MouseButton]
(MouseButton -> MouseButton)
-> (MouseButton -> MouseButton)
-> (Int -> MouseButton)
-> (MouseButton -> Int)
-> (MouseButton -> [MouseButton])
-> (MouseButton -> MouseButton -> [MouseButton])
-> (MouseButton -> MouseButton -> [MouseButton])
-> (MouseButton -> MouseButton -> MouseButton -> [MouseButton])
-> Enum MouseButton
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: MouseButton -> MouseButton
succ :: MouseButton -> MouseButton
$cpred :: MouseButton -> MouseButton
pred :: MouseButton -> MouseButton
$ctoEnum :: Int -> MouseButton
toEnum :: Int -> MouseButton
$cfromEnum :: MouseButton -> Int
fromEnum :: MouseButton -> Int
$cenumFrom :: MouseButton -> [MouseButton]
enumFrom :: MouseButton -> [MouseButton]
$cenumFromThen :: MouseButton -> MouseButton -> [MouseButton]
enumFromThen :: MouseButton -> MouseButton -> [MouseButton]
$cenumFromTo :: MouseButton -> MouseButton -> [MouseButton]
enumFromTo :: MouseButton -> MouseButton -> [MouseButton]
$cenumFromThenTo :: MouseButton -> MouseButton -> MouseButton -> [MouseButton]
enumFromThenTo :: MouseButton -> MouseButton -> MouseButton -> [MouseButton]
Enum)

instance ToJSON MouseButton where
  toJSON :: MouseButton -> Value
toJSON = Int -> Value
forall a. ToJSON a => a -> Value
toJSON (Int -> Value) -> (MouseButton -> Int) -> MouseButton -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MouseButton -> Int
forall a. Enum a => a -> Int
fromEnum

instance FromJSON MouseButton where
  parseJSON :: Value -> Parser MouseButton
parseJSON Value
v = Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v Parser Int -> (Int -> Parser MouseButton) -> Parser MouseButton
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (Int
0 :: Int) -> MouseButton -> Parser MouseButton
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return MouseButton
LeftButton
    Int
1 -> MouseButton -> Parser MouseButton
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return MouseButton
MiddleButton
    Int
2 -> MouseButton -> Parser MouseButton
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return MouseButton
RightButton
    Int
err -> String -> Parser MouseButton
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser MouseButton) -> String -> Parser MouseButton
forall a b. (a -> b) -> a -> b
$ String
"Invalid JSON for MouseButton: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
err

-- -----------------------------------------------------------------------------
-- Legacy API (Wire Protocol)
-- -----------------------------------------------------------------------------

movementTimeMs :: Int
movementTimeMs :: Int
movementTimeMs = Int
50

-- | Moves the mouse to the given position relative to the current pointer position.
moveTo :: (HasCallStack, WebDriver wd) => (Int, Int) -> wd ()
moveTo :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Int, Int) -> wd ()
moveTo (Int
x, Int
y) = [ActionSource] -> wd ()
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
[ActionSource] -> wd ()
performActions [String -> [Action] -> ActionSource
PointerSource String
"mouse1" [PointerAction -> Action
ActionPointer (PointerAction -> Action) -> PointerAction -> Action
forall a b. (a -> b) -> a -> b
$ PointerOrigin -> Int -> Int -> Int -> PointerAction
PointerMove PointerOrigin
PointerCurrent Int
x Int
y Int
movementTimeMs]]

-- | Moves the mouse to the center of a given element.
moveToCenter :: (HasCallStack, WebDriver wd) => Element -> wd ()
moveToCenter :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Element -> wd ()
moveToCenter Element
el = [ActionSource] -> wd ()
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
[ActionSource] -> wd ()
performActions [String -> [Action] -> ActionSource
PointerSource String
"mouse1" [PointerAction -> Action
ActionPointer (PointerAction -> Action) -> PointerAction -> Action
forall a b. (a -> b) -> a -> b
$ PointerOrigin -> Int -> Int -> Int -> PointerAction
PointerMove (Element -> PointerOrigin
PointerElement Element
el) Int
0 Int
0 Int
movementTimeMs]]

-- | Moves the mouse to the given position relative to the given element.
moveToFrom :: (HasCallStack, WebDriver wd) => (Int, Int) -> Element -> wd ()
moveToFrom :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Int, Int) -> Element -> wd ()
moveToFrom (Int
x, Int
y) Element
el = [ActionSource] -> wd ()
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
[ActionSource] -> wd ()
performActions [String -> [Action] -> ActionSource
PointerSource String
"mouse1" [PointerAction -> Action
ActionPointer (PointerAction -> Action) -> PointerAction -> Action
forall a b. (a -> b) -> a -> b
$ PointerOrigin -> Int -> Int -> Int -> PointerAction
PointerMove (Element -> PointerOrigin
PointerElement Element
el) Int
x Int
y Int
movementTimeMs]]

-- | Helper to click the center of an element.
clickCenter :: (HasCallStack, WebDriver wd) => Element -> wd ()
clickCenter :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Element -> wd ()
clickCenter Element
el = [ActionSource] -> wd ()
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
[ActionSource] -> wd ()
performActions [String -> [Action] -> ActionSource
PointerSource String
"mouse1" [
  PointerAction -> Action
ActionPointer (PointerAction -> Action) -> PointerAction -> Action
forall a b. (a -> b) -> a -> b
$ PointerOrigin -> Int -> Int -> Int -> PointerAction
PointerMove (Element -> PointerOrigin
PointerElement Element
el) Int
0 Int
0 Int
movementTimeMs
  , PointerAction -> Action
ActionPointer (PointerAction -> Action) -> PointerAction -> Action
forall a b. (a -> b) -> a -> b
$ MouseButton -> PointerAction
PointerDown MouseButton
LeftButton
  , PointerAction -> Action
ActionPointer (PointerAction -> Action) -> PointerAction -> Action
forall a b. (a -> b) -> a -> b
$ MouseButton -> PointerAction
PointerUp MouseButton
LeftButton
  ]]

-- | Helper to double click the center of an element.
doubleClickCenter :: (HasCallStack, WebDriver wd) => Element -> wd ()
doubleClickCenter :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Element -> wd ()
doubleClickCenter Element
el = [ActionSource] -> wd ()
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
[ActionSource] -> wd ()
performActions [String -> [Action] -> ActionSource
PointerSource String
"mouse1" [
  PointerAction -> Action
ActionPointer (PointerAction -> Action) -> PointerAction -> Action
forall a b. (a -> b) -> a -> b
$ PointerOrigin -> Int -> Int -> Int -> PointerAction
PointerMove (Element -> PointerOrigin
PointerElement Element
el) Int
0 Int
0 Int
movementTimeMs
  , PointerAction -> Action
ActionPointer (PointerAction -> Action) -> PointerAction -> Action
forall a b. (a -> b) -> a -> b
$ MouseButton -> PointerAction
PointerDown MouseButton
LeftButton
  , PointerAction -> Action
ActionPointer (PointerAction -> Action) -> PointerAction -> Action
forall a b. (a -> b) -> a -> b
$ MouseButton -> PointerAction
PointerUp MouseButton
LeftButton
  , Int -> Action
ActionPause Int
100
  , PointerAction -> Action
ActionPointer (PointerAction -> Action) -> PointerAction -> Action
forall a b. (a -> b) -> a -> b
$ MouseButton -> PointerAction
PointerDown MouseButton
LeftButton
  , PointerAction -> Action
ActionPointer (PointerAction -> Action) -> PointerAction -> Action
forall a b. (a -> b) -> a -> b
$ MouseButton -> PointerAction
PointerUp MouseButton
LeftButton
  ]]

-- -----------------------------------------------------------------------------
-- Modern Actions API
-- -----------------------------------------------------------------------------

-- | Origin for pointer actions
data PointerOrigin
  = PointerViewport
  | PointerCurrent
  | PointerElement Element
  deriving (PointerOrigin -> PointerOrigin -> Bool
(PointerOrigin -> PointerOrigin -> Bool)
-> (PointerOrigin -> PointerOrigin -> Bool) -> Eq PointerOrigin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PointerOrigin -> PointerOrigin -> Bool
== :: PointerOrigin -> PointerOrigin -> Bool
$c/= :: PointerOrigin -> PointerOrigin -> Bool
/= :: PointerOrigin -> PointerOrigin -> Bool
Eq, Int -> PointerOrigin -> ShowS
[PointerOrigin] -> ShowS
PointerOrigin -> String
(Int -> PointerOrigin -> ShowS)
-> (PointerOrigin -> String)
-> ([PointerOrigin] -> ShowS)
-> Show PointerOrigin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PointerOrigin -> ShowS
showsPrec :: Int -> PointerOrigin -> ShowS
$cshow :: PointerOrigin -> String
show :: PointerOrigin -> String
$cshowList :: [PointerOrigin] -> ShowS
showList :: [PointerOrigin] -> ShowS
Show)

-- | Individual pointer actions
data PointerAction
  = PointerMove { PointerAction -> PointerOrigin
moveOrigin :: PointerOrigin, PointerAction -> Int
moveX :: Int, PointerAction -> Int
moveY :: Int, PointerAction -> Int
moveDuration :: Int }
  | PointerDown { PointerAction -> MouseButton
downButton :: MouseButton }
  | PointerUp { PointerAction -> MouseButton
upButton :: MouseButton }
  | PointerCancel
  deriving (PointerAction -> PointerAction -> Bool
(PointerAction -> PointerAction -> Bool)
-> (PointerAction -> PointerAction -> Bool) -> Eq PointerAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PointerAction -> PointerAction -> Bool
== :: PointerAction -> PointerAction -> Bool
$c/= :: PointerAction -> PointerAction -> Bool
/= :: PointerAction -> PointerAction -> Bool
Eq, Int -> PointerAction -> ShowS
[PointerAction] -> ShowS
PointerAction -> String
(Int -> PointerAction -> ShowS)
-> (PointerAction -> String)
-> ([PointerAction] -> ShowS)
-> Show PointerAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PointerAction -> ShowS
showsPrec :: Int -> PointerAction -> ShowS
$cshow :: PointerAction -> String
show :: PointerAction -> String
$cshowList :: [PointerAction] -> ShowS
showList :: [PointerAction] -> ShowS
Show)

-- | Individual key actions
data KeyAction
  = KeyDown { KeyAction -> String
keyValue :: String }
  | KeyUp { keyValue :: String }
  deriving (KeyAction -> KeyAction -> Bool
(KeyAction -> KeyAction -> Bool)
-> (KeyAction -> KeyAction -> Bool) -> Eq KeyAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyAction -> KeyAction -> Bool
== :: KeyAction -> KeyAction -> Bool
$c/= :: KeyAction -> KeyAction -> Bool
/= :: KeyAction -> KeyAction -> Bool
Eq, Int -> KeyAction -> ShowS
[KeyAction] -> ShowS
KeyAction -> String
(Int -> KeyAction -> ShowS)
-> (KeyAction -> String)
-> ([KeyAction] -> ShowS)
-> Show KeyAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyAction -> ShowS
showsPrec :: Int -> KeyAction -> ShowS
$cshow :: KeyAction -> String
show :: KeyAction -> String
$cshowList :: [KeyAction] -> ShowS
showList :: [KeyAction] -> ShowS
Show)

-- | Generic action that can be pause, pointer, or key
data Action
  = ActionPause { Action -> Int
pauseDuration :: Int }
  | ActionPointer { Action -> PointerAction
pointerAction :: PointerAction }
  | ActionKey { Action -> KeyAction
keyAction :: KeyAction }
  deriving (Action -> Action -> Bool
(Action -> Action -> Bool)
-> (Action -> Action -> Bool) -> Eq Action
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
/= :: Action -> Action -> Bool
Eq, Int -> Action -> ShowS
[Action] -> ShowS
Action -> String
(Int -> Action -> ShowS)
-> (Action -> String) -> ([Action] -> ShowS) -> Show Action
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Action -> ShowS
showsPrec :: Int -> Action -> ShowS
$cshow :: Action -> String
show :: Action -> String
$cshowList :: [Action] -> ShowS
showList :: [Action] -> ShowS
Show)

-- | Action source (input device)
data ActionSource
  = PointerSource { ActionSource -> String
sourceId :: String, ActionSource -> [Action]
actions :: [Action] }
  | KeySource { sourceId :: String, actions :: [Action] }
  deriving (ActionSource -> ActionSource -> Bool
(ActionSource -> ActionSource -> Bool)
-> (ActionSource -> ActionSource -> Bool) -> Eq ActionSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActionSource -> ActionSource -> Bool
== :: ActionSource -> ActionSource -> Bool
$c/= :: ActionSource -> ActionSource -> Bool
/= :: ActionSource -> ActionSource -> Bool
Eq, Int -> ActionSource -> ShowS
[ActionSource] -> ShowS
ActionSource -> String
(Int -> ActionSource -> ShowS)
-> (ActionSource -> String)
-> ([ActionSource] -> ShowS)
-> Show ActionSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActionSource -> ShowS
showsPrec :: Int -> ActionSource -> ShowS
$cshow :: ActionSource -> String
show :: ActionSource -> String
$cshowList :: [ActionSource] -> ShowS
showList :: [ActionSource] -> ShowS
Show)

-- | Perform a sequence of actions from multiple input sources
performActions :: (HasCallStack, WebDriver wd) => [ActionSource] -> wd ()
performActions :: forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
[ActionSource] -> wd ()
performActions [ActionSource]
sources = 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
"/actions"
  ([Pair] -> Value
A.object [Key
"actions" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (ActionSource -> Value) -> [ActionSource] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map ActionSource -> Value
sourceToJSON [ActionSource]
sources])

-- | Release all currently pressed keys and buttons
releaseActions :: (HasCallStack, WebDriver wd) => wd ()
releaseActions :: forall (wd :: * -> *). (HasCallStack, WebDriver wd) => wd ()
releaseActions = 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
methodDelete Text
"/actions" Value
noObject

-- -----------------------------------------------------------------------------
-- Internal helpers
-- -----------------------------------------------------------------------------

sourceToJSON :: ActionSource -> A.Value
sourceToJSON :: ActionSource -> Value
sourceToJSON (PointerSource String
sid [Action]
acts) = [Pair] -> Value
A.object [
  Key
"type" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (String
"pointer" :: String)
  , Key
"id" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= String
sid
  , Key
"actions" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Action -> Value) -> [Action] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Action -> Value
actionToJSON [Action]
acts
  ]
sourceToJSON (KeySource String
sid [Action]
acts) = [Pair] -> Value
A.object [
  Key
"type" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (String
"key" :: String)
  , Key
"id" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= String
sid
  , Key
"actions" Key -> [Value] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (Action -> Value) -> [Action] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Action -> Value
actionToJSON [Action]
acts
  ]

actionToJSON :: Action -> A.Value
actionToJSON :: Action -> Value
actionToJSON (ActionPause Int
dur) = [Pair] -> Value
A.object [
  Key
"type" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (String
"pause" :: String)
  , Key
"duration" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Int
dur
  ]
actionToJSON (ActionPointer PointerAction
pact) = PointerAction -> Value
pointerActionToJSON PointerAction
pact
actionToJSON (ActionKey KeyAction
kact) = KeyAction -> Value
keyActionToJSON KeyAction
kact

pointerActionToJSON :: PointerAction -> A.Value
pointerActionToJSON :: PointerAction -> Value
pointerActionToJSON (PointerMove PointerOrigin
orig Int
x Int
y Int
dur) = [Pair] -> Value
A.object ([
  Key
"type" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (String
"pointerMove" :: String)
  , Key
"duration" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Int
dur
  , Key
"x" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Int
x
  , Key
"y" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Int
y
  ] [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> PointerOrigin -> [Pair]
originToJSON PointerOrigin
orig)
  where
    originToJSON :: PointerOrigin -> [(Key, A.Value)]
    originToJSON :: PointerOrigin -> [Pair]
originToJSON PointerOrigin
PointerViewport = [(Key
"origin", Text -> Value
A.String Text
"viewport")]
    originToJSON PointerOrigin
PointerCurrent = [(Key
"origin", Text -> Value
A.String Text
"pointer")]
    originToJSON (PointerElement (Element Text
e)) = [(Key
"origin", [Pair] -> Value
A.object [Key
"element-6066-11e4-a52e-4f735466cecf" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= Text
e])]
pointerActionToJSON (PointerDown MouseButton
btn) = [Pair] -> Value
A.object [
  Key
"type" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (String
"pointerDown" :: String)
  , Key
"button" Key -> MouseButton -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= MouseButton
btn
  ]
pointerActionToJSON (PointerUp MouseButton
btn) = [Pair] -> Value
A.object [
  Key
"type" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (String
"pointerUp" :: String)
  , Key
"button" Key -> MouseButton -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= MouseButton
btn
  ]
pointerActionToJSON PointerAction
PointerCancel = [Pair] -> Value
A.object [
  Key
"type" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (String
"pointerCancel" :: String)
  ]

keyActionToJSON :: KeyAction -> A.Value
keyActionToJSON :: KeyAction -> Value
keyActionToJSON (KeyDown String
val) = [Pair] -> Value
A.object [
  Key
"type" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (String
"keyDown" :: String)
  , Key
"value" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= String
val
  ]
keyActionToJSON (KeyUp String
val) = [Pair] -> Value
A.object [
  Key
"type" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= (String
"keyUp" :: String)
  , Key
"value" Key -> String -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
A..= String
val
  ]