fix: support eject / inject / exclusive event handlers

.tool-versions

@@ -1,3 +1,3 @@
-purescript 0.15.11-3
-spago 0.21.0
-bun 1.0.3
+purescript 0.15.12
+spago system 0.21.0
+bun 1.0.7

package.json

@@ -4,7 +4,7 @@
   "type": "module",
   "scripts": {
     "fmt": "bun bun/fmt.js",
-    "postinstall": "bunx @puppeteer/browsers install chrome@stable --path $HOME/.cache/puppeteer"
+    "postinstall": "rm -rf node_modules/puppeteer-extra/node_modules/"
   },
   "devDependencies": {
     "bun-types": "latest",
@@ -17,12 +17,13 @@
   "dependencies": {
     "@cliqz/adblocker-puppeteer": "1.23.8",
     "callsites": "^4.1.0",
-    "puppeteer": "^21.3.5",
-    "puppeteer-core": "^21.3.5",
+    "puppeteer-core": "https://git.orionkindel.com/orion/-/packages/npm/puppeteer-core/0.0.2-fork/files/3271#.tgz",
+    "puppeteer": "https://git.orionkindel.com/orion/-/packages/npm/puppeteer/0.0.3-fork/files/3272#.tgz",
     "puppeteer-extra": "^3.3.6",
     "puppeteer-extra-plugin-adblocker": "^2.13.6",
     "puppeteer-extra-plugin-anonymize-ua": "^2.4.6",
     "puppeteer-extra-plugin-recaptcha": "^3.6.8",
-    "puppeteer-extra-plugin-stealth": "^2.11.2"
+    "puppeteer-extra-plugin-stealth": "^2.11.2",
+    "purescript-language-server": "latest"
   }
 }

src/Puppeteer.Page.Event.ConsoleMessage.purs

@@ -105,6 +105,9 @@ messageTypeString Verbose = "verbose"
 
 foreign import data ConsoleMessage :: Type
 
+instance Show ConsoleMessage where
+  show m = show { text: text m, messageType: messageType m, stackTrace: stackTrace m, location: location m }
+
 instance consoleMessageForeign :: ReadForeign ConsoleMessage where
   readImpl = pure <<< unsafeFromForeign
 

src/Puppeteer.Page.Event.js

@@ -1,5 +1,7 @@
 import { Page } from 'puppeteer'
 
+/** @typedef {import('puppeteer').EventsWithWildcard<import('puppeteer').PageEvents>} Events */
+
 /** @type {(_0: import('puppeteer').PageEvent) => (_1: (_: any) => void) => (_2: Page) => () => [import('puppeteer').PageEvent, (_: any) => void]} */
 export const _addListener = t => f => p => () => {
   p.on(t, f)
@@ -15,3 +17,14 @@ export const _removeListener =
 
 /** @type {(_0: import('puppeteer').PageEvent) => (_1: (_: any) => void) => (_2: Page) => () => void} */
 export const _once = t => f => p => () => p.once(t, f)
+
+/** @type {(_2: Page) => () => void} */
+export const removeAllListeners = p => () => p.removeAllListeners()
+
+/** @type {(_2: Page) => () => import('puppeteer').EmitterState<Events>} */
+export const eject = p => () => p.eject()
+
+/** @type {(_1: import('puppeteer').EmitterState<Events>) => (_2: Page) => () => void} */
+export const inject = s => p => () => {
+  p.inject(s)
+}

src/Puppeteer.Page.Event.purs

@@ -1,5 +1,8 @@
 module Puppeteer.Page.Event
-  ( once
+  ( exclusive
+  , inject
+  , eject
+  , once
   , listen
   , eventKey
   , eventData
@@ -14,6 +17,7 @@ module Puppeteer.Page.Event
   , ResponseEvent(..)
   , DialogEvent(..)
   , ConsoleMessageEvent(..)
+  , EmitterState
   ) where
 
 import Prelude
@@ -136,11 +140,16 @@ class Event ev d | ev -> d, d -> ev where
 defaultEventData :: forall d. ReadForeign d => Foreign -> Maybe d
 defaultEventData = hush <<< runExcept <<< readImpl
 
+foreign import data EmitterState :: Type
 foreign import data ListenerToken :: Type
 foreign import _once :: String -> (Foreign -> Unit) -> Page -> Effect Unit
 foreign import _addListener :: String -> (Foreign -> Unit) -> Page -> Effect ListenerToken
 foreign import _removeListener :: ListenerToken -> Page -> Effect Unit
 
+foreign import removeAllListeners :: Page -> Effect Unit
+foreign import eject :: Page -> Effect EmitterState
+foreign import inject :: EmitterState -> Page -> Effect Unit
+
 once :: forall ev evd. Event ev evd => ev -> Page -> Aff evd
 once ev p =
   let
@@ -152,6 +161,19 @@ once ev p =
   in
     makeAff f
 
+exclusive :: forall ev evd. Event ev evd => ev -> (evd -> Effect Unit) -> Page -> Effect (Context "exclusive event listener")
+exclusive ev cb p =
+  let
+    close before ctx _ = do
+      closeContext ctx
+      liftEffect $ inject before p
+  in
+    do
+      before <- eject p
+      removeAllListeners p
+      ev <- listen ev cb p
+      pure $ Context $ close before ev
+
 listen :: forall ev evd. Event ev evd => ev -> (evd -> Effect Unit) -> Page -> Effect (Context "event listener")
 listen ev cb p =
   let

test/Puppeteer.Page.Event.Spec.purs

@@ -2,21 +2,27 @@ module Puppeteer.Page.Event.Spec where
 
 import Prelude
 
+import Control.Monad.Error.Class (liftEither, liftMaybe, throwError)
 import Control.Monad.Rec.Class (untilJust)
 import Control.Monad.ST.Class (liftST)
+import Control.Monad.ST.Global as ST
+import Control.Monad.ST.Ref as ST
 import Control.Monad.ST.Ref as ST.Ref
 import Data.Array as Array
 import Data.Either (Either(..))
-import Data.Maybe (Maybe(..), isJust)
+import Data.Maybe (Maybe(..), isJust, maybe)
 import Data.Newtype (wrap)
 import Effect (Effect)
-import Effect.Class (liftEffect)
 import Effect.Aff (Aff, launchAff_, delay, forkAff, joinFiber)
+import Effect.Class (liftEffect)
+import Effect.Console as Console
+import Effect.Exception (error)
 import Effect.Exception as Error
 import Puppeteer (timeout)
 import Puppeteer as Pup
 import Puppeteer.Base (timeout')
 import Puppeteer.Browser as Pup.Browser
+import Puppeteer.Eval as Pup.Eval
 import Puppeteer.HTTP.Request as Pup.HTTP.Request
 import Puppeteer.Page as Pup.Page
 import Puppeteer.Page.Event as Pup.Page.Event
@@ -41,6 +47,15 @@ pageRequestsJs =
 </html>
 """
 
+pageEmpty :: String
+pageEmpty =
+  """
+<html>
+<head></head>
+<body></body>
+</html>
+"""
+
 scriptUnblocks :: String
 scriptUnblocks = "window.unblock = true"
 
@@ -142,3 +157,42 @@ spec =
               closeF <- forkAff $ Pup.Page.Event.once Pup.Page.Event.Close p
               Pup.Page.close p
               joinFiber closeF
+
+          test "exclusive" \b -> do
+            msgST <- liftEffect $ ST.toEffect $ ST.new $ Right Nothing
+            p <- Pup.Page.new b
+            Pup.Page.setContent pageEmpty Pup.Load p
+            onceLog <- forkAff $ Pup.Page.Event.once Pup.Page.Event.Console p
+            exclusive <- liftEffect $ Pup.Page.Event.exclusive
+              Pup.Page.Event.Console
+              ( \m -> do
+                  prev <- ST.toEffect $ ST.modify (const $ Right Nothing) msgST
+                  case prev of
+                    Right (Just _) -> void $ ST.toEffect $ ST.write (Left $ error $ "last message was not taken") msgST
+                    Right Nothing -> void $ ST.toEffect $ ST.write (Right $ Just m) msgST
+                    Left _ -> pure unit
+              )
+              p
+
+            Pup.Eval.unsafeRunJs0 @Unit "() => console.log('cheddar')" p
+            delay $ wrap 50.0
+
+            cheddarEM <- liftEffect $ ST.toEffect $ ST.read msgST
+            void $ liftEffect $ ST.toEffect $ ST.write (Right Nothing) msgST
+            cheddar <- liftMaybe (error "cheddar: listener did not fire") =<< liftEither cheddarEM
+            (ConsoleMessage.text cheddar) `shouldEqual` "cheddar"
+
+            Pup.Eval.unsafeRunJs0 @Unit "() => console.log('brie')" p
+            brieEM <- liftEffect $ ST.toEffect $ ST.read msgST
+            void $ liftEffect $ ST.toEffect $ ST.write (Right Nothing) msgST
+            brie <- liftMaybe (error "brie: listener did not fire") =<< liftEither brieEM
+            (ConsoleMessage.text brie) `shouldEqual` "brie"
+
+            Pup.closeContext exclusive
+
+            Pup.Eval.unsafeRunJs0 @Unit "() => console.log('camembert')" p
+            camembertEM <- liftEffect $ ST.toEffect $ ST.read msgST
+            void $ liftEffect $ ST.toEffect $ ST.write (Right Nothing) msgST
+            maybe (pure unit) (const $ throwError $ error "camembert: listener wasn't removed") =<< liftEither camembertEM
+            camembertFromOnce <- joinFiber onceLog
+            (ConsoleMessage.text camembertFromOnce) `shouldEqual` "camembert"