feat: mouse

spago.yaml

@@ -28,6 +28,7 @@ package:
     - ordered-collections
     - parallel
     - prelude
+    - record-extra
     - simple-json
     - spec
     - st

src/Puppeteer.Base.purs

@@ -17,7 +17,7 @@ import Effect.Exception (Error, error)
 import Foreign (Foreign, unsafeFromForeign)
 import Foreign.Object (Object)
 import Foreign.Object as Object
-import Prim.Row (class Union)
+import Prim.Row (class Nub, class Union)
 import Puppeteer.FFI as FFI
 import Simple.JSON (class ReadForeign, class WriteForeign, readImpl, writeImpl)
 import Web.HTML as HTML
@@ -73,6 +73,8 @@ closeContext (Context f) = f unit
 
 type URL = String
 
+type BoundingBox = { x :: Number, y :: Number, width :: Number, height :: Number }
+
 type Viewport =
   { deviceScaleFactor :: Maybe Number
   , hasTouch :: Maybe Boolean
@@ -141,6 +143,12 @@ foreign import data Keyboard :: Type
 instance ReadForeign Keyboard where
   readImpl = pure <<< unsafeFromForeign
 
+--| [`Mouse`](https://pptr.dev/api/puppeteer.mouse)
+foreign import data Mouse :: Type
+
+instance ReadForeign Mouse where
+  readImpl = pure <<< unsafeFromForeign
+
 foreign import data Request :: Type
 
 instance ReadForeign Request where

src/Puppeteer.Handle.purs

@@ -5,7 +5,6 @@ module Puppeteer.Handle
   , click
   , clone
   , boundingBox
-  , boxModel
   , hover
   , isHidden
   , isVisible
@@ -37,7 +36,7 @@ import Foreign (Foreign)
 import Node.Buffer (Buffer)
 import Node.Path (FilePath)
 import Puppeteer.Base (Handle) as X
-import Puppeteer.Base (class IsElement, Handle)
+import Puppeteer.Base (class IsElement, Handle, BoundingBox)
 import Puppeteer.Eval as Eval
 import Puppeteer.FFI as FFI
 import Puppeteer.Screenshot (ScreenshotOptions, prepareScreenshotOptions)
@@ -50,7 +49,7 @@ import Web.HTML as HTML
 
 foreign import _find :: forall a b. String -> Handle a -> Effect (Promise (Array (Handle b)))
 foreign import _click :: forall a. Handle a -> Effect (Promise Unit)
-foreign import _boundingBox :: forall a. Handle a -> Effect (Promise (Nullable Foreign))
+foreign import _boundingBox :: forall a. Handle a -> Effect (Promise (Nullable BoundingBox))
 foreign import _boxModel :: forall a. Handle a -> Effect (Promise (Nullable Foreign))
 foreign import _hover :: forall a. Handle a -> Effect (Promise Unit)
 foreign import _isHidden :: forall a. Handle a -> Effect (Promise Boolean)
@@ -80,12 +79,9 @@ findAll q h = Promise.toAffE $ _find (Selector.toCSS q) h
 click :: forall a. IsElement a => Handle a -> Aff Unit
 click h = Promise.toAffE $ _click h
 
-boundingBox :: forall a. IsElement a => Handle a -> Aff (Maybe Foreign)
+boundingBox :: forall a. IsElement a => Handle a -> Aff (Maybe BoundingBox)
 boundingBox = map Nullable.toMaybe <<< Promise.toAffE <<< _boundingBox
 
-boxModel :: forall a. IsElement a => Handle a -> Aff (Maybe Foreign)
-boxModel = map Nullable.toMaybe <<< Promise.toAffE <<< _boxModel
-
 hover :: forall a. IsElement a => Handle a -> Aff Unit
 hover = Promise.toAffE <<< _hover
 

src/Puppeteer.Mouse.js

@@ -0,0 +1,24 @@
+/** @type {(_2: import('puppeteer').Mouse) => (_3: {x: number, y: number}) => (_1: {button: import('puppeteer').MouseButton, count: number, delay: number}) => () => Promise<void>} */
+export const clickImpl =
+  mouse =>
+  ({ x, y }) =>
+  opts =>
+  () =>
+    mouse.click(x, y, opts)
+
+/** @type {(_2: import('puppeteer').Mouse) => (_3: import('puppeteer').MouseButton) => () => Promise<void>} */
+export const downImpl = mouse => btn => () => mouse.down({ button: btn })
+
+/** @type {(_2: import('puppeteer').Mouse) => (_3: import('puppeteer').MouseButton) => () => Promise<void>} */
+export const upImpl = mouse => btn => () => mouse.up({ button: btn })
+
+/** @type { (_2: import('puppeteer').Mouse) => (_3: {x: number, y: number}) => (_1: {steps: number}) =>() => Promise<void>} */
+export const moveImpl =
+  mouse =>
+  ({ x, y }) =>
+  opts =>
+  () =>
+    mouse.move(x, y, opts)
+
+/** @type { (_2: import('puppeteer').Mouse) => (_3: {deltaX: number, deltaY: number}) => () => Promise<void>} */
+export const scrollImpl = mouse => opts => () => mouse.wheel(opts)

src/Puppeteer.Mouse.purs

@@ -0,0 +1,75 @@
+module Puppeteer.Mouse where
+
+import Prelude
+
+import Control.Promise (Promise)
+import Control.Promise as Promise
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Prim.Row (class Nub, class Union)
+import Puppeteer.Base (Mouse)
+import Record (merge, modify) as Record
+import Type.Prelude (Proxy(..))
+
+data MouseButton
+  = MouseLeft
+  | MouseRight
+  | MouseMiddle
+  | MouseBack
+  | MouseForward
+
+mouseButtonToString :: MouseButton -> String
+mouseButtonToString MouseLeft = "left"
+mouseButtonToString MouseRight = "right"
+mouseButtonToString MouseMiddle = "middle"
+mouseButtonToString MouseBack = "back"
+mouseButtonToString MouseForward = "forward"
+
+type MouseWheelOptions r = (deltaX :: Number, deltaY :: Number | r)
+type MouseMoveOptions r = (steps :: Number | r)
+type MouseOptions r = (button :: MouseButton | r)
+type MouseClickOptions r = (count :: Int, delay :: Number | MouseOptions r)
+
+foreign import scrollImpl :: Mouse -> { deltaX :: Number, deltaY :: Number } -> Effect (Promise Unit)
+foreign import clickImpl :: Mouse -> { x :: Number, y :: Number } -> { button :: String, count :: Int, delay :: Number } -> Effect (Promise Unit)
+foreign import downImpl :: Mouse -> String -> Effect (Promise Unit)
+foreign import upImpl :: Mouse -> String -> Effect (Promise Unit)
+foreign import moveImpl :: Mouse -> { x :: Number, y :: Number } -> { steps :: Number } -> Effect (Promise Unit)
+
+scroll :: forall options missing. Union options missing (MouseWheelOptions ()) => Union options (MouseWheelOptions ()) (MouseWheelOptions ()) => Record options -> Mouse -> Aff Unit
+scroll options mouse = Promise.toAffE
+  $ scrollImpl mouse
+  $ Record.merge options { deltaX: 0.0, deltaY: 0.0 }
+
+down :: MouseButton -> Mouse -> Aff Unit
+down btn mouse = Promise.toAffE $ downImpl mouse (mouseButtonToString btn)
+
+up :: MouseButton -> Mouse -> Aff Unit
+up btn mouse = Promise.toAffE $ upImpl mouse (mouseButtonToString btn)
+
+moveTo
+  :: forall options missing fullU
+   . Nub fullU (MouseMoveOptions ())
+  => Union options missing (MouseMoveOptions ())
+  => Union options (MouseMoveOptions ()) fullU
+  => Record options
+  -> Mouse
+  -> { x :: Number, y :: Number }
+  -> Aff Unit
+moveTo opts mouse xy = Promise.toAffE
+  $ moveImpl mouse xy
+  $ Record.merge opts { steps: 1.0 }
+
+click
+  :: forall options missing fullU
+   . Nub fullU (MouseClickOptions ())
+  => Union options missing (MouseClickOptions ())
+  => Union options (MouseClickOptions ()) fullU
+  => Record options
+  -> Mouse
+  -> { x :: Number, y :: Number }
+  -> Aff Unit
+click opts mouse xy = Promise.toAffE
+  $ clickImpl mouse xy
+  $ Record.modify (Proxy @"button") mouseButtonToString
+  $ Record.merge opts { button: MouseLeft, count: 1, delay: 0.0 }

src/Puppeteer.Page.purs

@@ -41,7 +41,7 @@ import Effect.Aff (Aff)
 import Foreign (Foreign, unsafeToForeign)
 import Node.Path (FilePath)
 import Puppeteer.Base (Page) as X
-import Puppeteer.Base (class PageProducer, CDPSession, Handle, Keyboard, LifecycleEvent, Page, URL, Viewport, duplexLifecycleEvent, duplexViewport, duplexWrite)
+import Puppeteer.Base (class PageProducer, CDPSession, Handle, Keyboard, LifecycleEvent, Mouse, Page, URL, Viewport, duplexLifecycleEvent, duplexViewport, duplexWrite)
 import Puppeteer.Handle (unsafeCoerceHandle)
 import Puppeteer.Selector (class Selector, toCSS)
 import Simple.JSON (readImpl, undefined, writeImpl)
@@ -100,7 +100,7 @@ prepareAddScript (AddModuleRemote url') = writeImpl
 
 foreign import url :: Page -> Effect URL
 foreign import keyboard :: Page -> Effect Keyboard
-foreign import mouse :: Page -> Effect Unit
+foreign import mouse :: Page -> Effect Mouse
 foreign import touchscreen :: Page -> Effect Unit
 foreign import isClosed :: Page -> Effect Boolean
 

test/Puppeteer.Mouse.Spec.purs

@@ -0,0 +1,208 @@
+module Puppeteer.Mouse.Spec where
+
+import Prelude
+
+import Control.Monad.Error.Class (liftMaybe)
+import Data.Array as Array
+import Data.Map as Map
+import Data.Maybe (Maybe(..))
+import Data.Newtype (wrap)
+import Data.Time.Duration (Milliseconds(..))
+import Effect (Effect)
+import Effect.Aff (Aff, delay)
+import Effect.Class (liftEffect)
+import Effect.Exception (error)
+import Puppeteer as Pup
+import Puppeteer.Base (timeout')
+import Puppeteer.Browser as Pup.Browser
+import Puppeteer.Handle as Pup.Handle
+import Puppeteer.Handle.HTML as Pup.Handle.HTML
+import Puppeteer.Keyboard as Pup.Keyboard
+import Puppeteer.Mouse as Mouse
+import Puppeteer.Page as Pup.Page
+import Puppeteer.Page.Event (connectPageConsole)
+import Puppeteer.Page.Event.Spec as Spec.Page.Event
+import Puppeteer.Page.WaitFor as Pup.Page.WaitFor
+import Test.Spec (SpecT, afterAll, beforeAll, beforeWith, describe)
+import Test.Spec.Assertions (shouldEqual)
+import Test.Util (failOnPageError, test)
+
+content :: String
+content =
+  """
+<!DOCTYPE html>
+<html>
+  <head>
+    <title>Simple Page</title>
+    <script>
+      window.addEventListener('load', () => {
+        document.querySelector('#foo').addEventListener('mouseenter', () => {
+          const div = document.createElement('div')
+          div.classList.add('foo-mouseenter')
+          document.body.append(div)
+        })
+  
+        document.querySelector('#bar').addEventListener(
+          'mouseenter',
+          () => {
+            const div = document.createElement('div')
+            div.classList.add('bar-mouseenter')
+            document.body.append(div)
+          },
+        )
+  
+        document.querySelector('#foo').addEventListener('wheel', () => {
+          const div = document.createElement('div')
+          div.classList.add('foo-wheel')
+          document.body.append(div)
+        })
+  
+        document.querySelector('#bar').addEventListener('wheel', () => {
+          const div = document.createElement('div')
+          div.classList.add('bar-wheel')
+          document.body.append(div)
+        })
+  
+        document.querySelector('#foo').addEventListener('mousedown', () => {
+          const div = document.createElement('div')
+          div.classList.add('foo-mousedown')
+          document.body.append(div)
+        })
+  
+        document.querySelector('#bar').addEventListener('mousedown', () => {
+          const div = document.createElement('div')
+          div.classList.add('bar-mousedown')
+          document.body.append(div)
+        })
+
+        document.querySelector('#foo').addEventListener('mouseup', () => {
+          const div = document.createElement('div')
+          div.classList.add('foo-mouseup')
+          document.body.append(div)
+        })
+  
+        document.querySelector('#bar').addEventListener('mouseup', () => {
+          const div = document.createElement('div')
+          div.classList.add('bar-mouseup')
+          document.body.append(div)
+        })
+      })
+    </script>
+  </head>
+  <body>
+    <div id="foo" style="width: 100px; height: 100px; position: fixed; top: 200px; left: 100px;"></div>
+    <div id="bar" style="width: 100px; height: 100px; position: fixed; left: 100px;"></div>
+  </body>
+</html>
+"""
+
+spec :: SpecT Aff Unit Effect Unit
+spec = beforeAll (Pup.launch_ =<< Pup.new)
+  $ afterAll Pup.Browser.close
+  $ describe "Mouse" do
+      test "move" \b -> do
+        p <- Pup.Page.new b
+
+        liftEffect $ connectPageConsole p
+        failOnPageError p do
+          Pup.Page.setContent content Pup.Load p
+          mouse <- liftEffect $ Pup.Page.mouse p
+          { x: fooX, y: fooY } <- liftMaybe (error "#foo does not have bounding box")
+            =<< Pup.Handle.boundingBox
+            =<< liftMaybe (error "#foo not found")
+            =<< Pup.Page.findFirst "div#foo" p
+          { x: barX, y: barY } <- liftMaybe (error "#bar does not have bounding box")
+            =<< Pup.Handle.boundingBox
+            =<< liftMaybe (error "#bar not found")
+            =<< Pup.Page.findFirst "div#bar" p
+
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.foo-mouseenter" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.bar-mouseenter" p
+
+          Mouse.moveTo { steps: 10.0 } mouse { x: fooX + 1.0, y: fooY + 1.0 }
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.foo-mouseenter" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.bar-mouseenter" p
+
+          Mouse.moveTo { steps: 10.0 } mouse { x: barX + 1.0, y: barY + 1.0 }
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.foo-mouseenter" p
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.bar-mouseenter" p
+
+      test "up / down" \b -> do
+        p <- Pup.Page.new b
+
+        liftEffect $ connectPageConsole p
+        failOnPageError p do
+          Pup.Page.setContent content Pup.Load p
+          mouse <- liftEffect $ Pup.Page.mouse p
+          { x: fooX, y: fooY } <- liftMaybe (error "#foo does not have bounding box")
+            =<< Pup.Handle.boundingBox
+            =<< liftMaybe (error "#foo not found")
+            =<< Pup.Page.findFirst "div#foo" p
+          { x: barX, y: barY } <- liftMaybe (error "#bar does not have bounding box")
+            =<< Pup.Handle.boundingBox
+            =<< liftMaybe (error "#bar not found")
+            =<< Pup.Page.findFirst "div#bar" p
+
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.foo-mousedown" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.foo-mouseup" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.bar-mousedown" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.bar-mouseup" p
+
+          Mouse.moveTo { steps: 10.0 } mouse { x: fooX + 1.0, y: fooY + 1.0 }
+          Mouse.down Mouse.MouseLeft mouse
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.foo-mousedown" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.foo-mouseup" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.bar-mousedown" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.bar-mouseup" p
+
+          Mouse.up Mouse.MouseLeft mouse
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.foo-mousedown" p
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.foo-mouseup" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.bar-mousedown" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.bar-mouseup" p
+
+          Mouse.moveTo { steps: 10.0 } mouse { x: barX + 1.0, y: barY + 1.0 }
+          Mouse.down Mouse.MouseLeft mouse
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.foo-mousedown" p
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.foo-mouseup" p
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.bar-mousedown" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.bar-mouseup" p
+
+          Mouse.up Mouse.MouseLeft mouse
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.foo-mousedown" p
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.foo-mouseup" p
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.bar-mousedown" p
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.bar-mouseup" p
+
+      test "click" \b -> do
+        p <- Pup.Page.new b
+
+        liftEffect $ connectPageConsole p
+        failOnPageError p do
+          Pup.Page.setContent content Pup.Load p
+          mouse <- liftEffect $ Pup.Page.mouse p
+          { x: fooX, y: fooY } <- liftMaybe (error "#foo does not have bounding box")
+            =<< Pup.Handle.boundingBox
+            =<< liftMaybe (error "#foo not found")
+            =<< Pup.Page.findFirst "div#foo" p
+          { x: barX, y: barY } <- liftMaybe (error "#bar does not have bounding box")
+            =<< Pup.Handle.boundingBox
+            =<< liftMaybe (error "#bar not found")
+            =<< Pup.Page.findFirst "div#bar" p
+
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.foo-mousedown" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.foo-mouseup" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.bar-mousedown" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.bar-mouseup" p
+
+          Mouse.click {} mouse { x: fooX + 1.0, y: fooY + 1.0 }
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.foo-mousedown" p
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.foo-mouseup" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.bar-mousedown" p
+          shouldEqual 0 =<< Array.length <$> Pup.Page.findAll "div.bar-mouseup" p
+
+          Mouse.click {} mouse { x: barX + 1.0, y: barY + 1.0 }
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.foo-mousedown" p
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.foo-mouseup" p
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.bar-mousedown" p
+          shouldEqual 1 =<< Array.length <$> Pup.Page.findAll "div.bar-mouseup" p

test/Puppeteer.Spec.purs

@@ -8,6 +8,7 @@ import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
 import Puppeteer as Pup
 import Puppeteer.Browser as Pup.Browser
+import Puppeteer.Mouse.Spec as Spec.Mouse
 import Puppeteer.Browser.Spec as Spec.Browser
 import Puppeteer.Handle.Spec as Spec.Handle
 import Puppeteer.Page.Spec as Spec.Page
@@ -37,6 +38,7 @@ spec = describe "Puppeteer" do
     b2 <- Pup.connect (Pup.connectDefault $ Pup.BrowserWebsocket ws) pup
     Pup.Browser.close b2
 
+  Spec.Mouse.spec
   Spec.Browser.spec
   Spec.Page.spec
   Spec.Handle.spec