diff --git a/spago.yaml b/spago.yaml index a7ebc15..b582365 100644 --- a/spago.yaml +++ b/spago.yaml @@ -28,6 +28,7 @@ package: - ordered-collections - parallel - prelude + - record-extra - simple-json - spec - st diff --git a/src/Puppeteer.Base.purs b/src/Puppeteer.Base.purs index 3ef78b5..9e55b93 100644 --- a/src/Puppeteer.Base.purs +++ b/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 diff --git a/src/Puppeteer.Handle.purs b/src/Puppeteer.Handle.purs index 00b0909..5e26998 100644 --- a/src/Puppeteer.Handle.purs +++ b/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 diff --git a/src/Puppeteer.Mouse.js b/src/Puppeteer.Mouse.js new file mode 100644 index 0000000..22609f0 --- /dev/null +++ b/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} */ +export const clickImpl = + mouse => + ({ x, y }) => + opts => + () => + mouse.click(x, y, opts) + +/** @type {(_2: import('puppeteer').Mouse) => (_3: import('puppeteer').MouseButton) => () => Promise} */ +export const downImpl = mouse => btn => () => mouse.down({ button: btn }) + +/** @type {(_2: import('puppeteer').Mouse) => (_3: import('puppeteer').MouseButton) => () => Promise} */ +export const upImpl = mouse => btn => () => mouse.up({ button: btn }) + +/** @type { (_2: import('puppeteer').Mouse) => (_3: {x: number, y: number}) => (_1: {steps: number}) =>() => Promise} */ +export const moveImpl = + mouse => + ({ x, y }) => + opts => + () => + mouse.move(x, y, opts) + +/** @type { (_2: import('puppeteer').Mouse) => (_3: {deltaX: number, deltaY: number}) => () => Promise} */ +export const scrollImpl = mouse => opts => () => mouse.wheel(opts) diff --git a/src/Puppeteer.Mouse.purs b/src/Puppeteer.Mouse.purs new file mode 100644 index 0000000..292e14f --- /dev/null +++ b/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 } diff --git a/src/Puppeteer.Page.purs b/src/Puppeteer.Page.purs index b8bd9ef..7ba3ee0 100644 --- a/src/Puppeteer.Page.purs +++ b/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 diff --git a/test/Puppeteer.Mouse.Spec.purs b/test/Puppeteer.Mouse.Spec.purs new file mode 100644 index 0000000..0dacb08 --- /dev/null +++ b/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 = + """ + + + + Simple Page + + + +
+
+ + +""" + +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 diff --git a/test/Puppeteer.Spec.purs b/test/Puppeteer.Spec.purs index 0727f98..0ab3271 100644 --- a/test/Puppeteer.Spec.purs +++ b/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