diff --git a/.tool-versions b/.tool-versions index fae5180..53f891e 100644 --- a/.tool-versions +++ b/.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 diff --git a/bun.lockb b/bun.lockb index d8c9f5d..ed02faf 100755 Binary files a/bun.lockb and b/bun.lockb differ diff --git a/package.json b/package.json index 976e491..e1cdfde 100644 --- a/package.json +++ b/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" } } diff --git a/src/Puppeteer.Page.Event.ConsoleMessage.purs b/src/Puppeteer.Page.Event.ConsoleMessage.purs index 9c5a5a0..830f2e9 100644 --- a/src/Puppeteer.Page.Event.ConsoleMessage.purs +++ b/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 diff --git a/src/Puppeteer.Page.Event.js b/src/Puppeteer.Page.Event.js index 20daeac..afdb382 100644 --- a/src/Puppeteer.Page.Event.js +++ b/src/Puppeteer.Page.Event.js @@ -1,5 +1,7 @@ import { Page } from 'puppeteer' +/** @typedef {import('puppeteer').EventsWithWildcard} 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} */ +export const eject = p => () => p.eject() + +/** @type {(_1: import('puppeteer').EmitterState) => (_2: Page) => () => void} */ +export const inject = s => p => () => { + p.inject(s) +} diff --git a/src/Puppeteer.Page.Event.purs b/src/Puppeteer.Page.Event.purs index 67d7e41..af9879d 100644 --- a/src/Puppeteer.Page.Event.purs +++ b/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 diff --git a/test/Puppeteer.Page.Event.Spec.purs b/test/Puppeteer.Page.Event.Spec.purs index 621cadd..b24609c 100644 --- a/test/Puppeteer.Page.Event.Spec.purs +++ b/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 = """ +pageEmpty :: String +pageEmpty = + """ + + + + +""" + 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"