fix: support eject / inject / exclusive event handlers

This commit is contained in:
orion 2023-10-26 15:49:54 -05:00
parent 05345f2bb3
commit 1263f5af72
Signed by: orion
GPG Key ID: 6D4165AE4C928719
7 changed files with 103 additions and 10 deletions

View File

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

BIN
bun.lockb

Binary file not shown.

View File

@ -4,7 +4,7 @@
"type": "module", "type": "module",
"scripts": { "scripts": {
"fmt": "bun bun/fmt.js", "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": { "devDependencies": {
"bun-types": "latest", "bun-types": "latest",
@ -17,12 +17,13 @@
"dependencies": { "dependencies": {
"@cliqz/adblocker-puppeteer": "1.23.8", "@cliqz/adblocker-puppeteer": "1.23.8",
"callsites": "^4.1.0", "callsites": "^4.1.0",
"puppeteer": "^21.3.5", "puppeteer-core": "https://git.orionkindel.com/orion/-/packages/npm/puppeteer-core/0.0.2-fork/files/3271#.tgz",
"puppeteer-core": "^21.3.5", "puppeteer": "https://git.orionkindel.com/orion/-/packages/npm/puppeteer/0.0.3-fork/files/3272#.tgz",
"puppeteer-extra": "^3.3.6", "puppeteer-extra": "^3.3.6",
"puppeteer-extra-plugin-adblocker": "^2.13.6", "puppeteer-extra-plugin-adblocker": "^2.13.6",
"puppeteer-extra-plugin-anonymize-ua": "^2.4.6", "puppeteer-extra-plugin-anonymize-ua": "^2.4.6",
"puppeteer-extra-plugin-recaptcha": "^3.6.8", "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"
} }
} }

View File

@ -105,6 +105,9 @@ messageTypeString Verbose = "verbose"
foreign import data ConsoleMessage :: Type 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 instance consoleMessageForeign :: ReadForeign ConsoleMessage where
readImpl = pure <<< unsafeFromForeign readImpl = pure <<< unsafeFromForeign

View File

@ -1,5 +1,7 @@
import { Page } from 'puppeteer' 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]} */ /** @type {(_0: import('puppeteer').PageEvent) => (_1: (_: any) => void) => (_2: Page) => () => [import('puppeteer').PageEvent, (_: any) => void]} */
export const _addListener = t => f => p => () => { export const _addListener = t => f => p => () => {
p.on(t, f) p.on(t, f)
@ -15,3 +17,14 @@ export const _removeListener =
/** @type {(_0: import('puppeteer').PageEvent) => (_1: (_: any) => void) => (_2: Page) => () => void} */ /** @type {(_0: import('puppeteer').PageEvent) => (_1: (_: any) => void) => (_2: Page) => () => void} */
export const _once = t => f => p => () => p.once(t, f) 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)
}

View File

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

View File

@ -2,21 +2,27 @@ module Puppeteer.Page.Event.Spec where
import Prelude import Prelude
import Control.Monad.Error.Class (liftEither, liftMaybe, throwError)
import Control.Monad.Rec.Class (untilJust) import Control.Monad.Rec.Class (untilJust)
import Control.Monad.ST.Class (liftST) 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 Control.Monad.ST.Ref as ST.Ref
import Data.Array as Array import Data.Array as Array
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Maybe (Maybe(..), isJust) import Data.Maybe (Maybe(..), isJust, maybe)
import Data.Newtype (wrap) import Data.Newtype (wrap)
import Effect (Effect) import Effect (Effect)
import Effect.Class (liftEffect)
import Effect.Aff (Aff, launchAff_, delay, forkAff, joinFiber) 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 Effect.Exception as Error
import Puppeteer (timeout) import Puppeteer (timeout)
import Puppeteer as Pup import Puppeteer as Pup
import Puppeteer.Base (timeout') import Puppeteer.Base (timeout')
import Puppeteer.Browser as Pup.Browser import Puppeteer.Browser as Pup.Browser
import Puppeteer.Eval as Pup.Eval
import Puppeteer.HTTP.Request as Pup.HTTP.Request import Puppeteer.HTTP.Request as Pup.HTTP.Request
import Puppeteer.Page as Pup.Page import Puppeteer.Page as Pup.Page
import Puppeteer.Page.Event as Pup.Page.Event import Puppeteer.Page.Event as Pup.Page.Event
@ -41,6 +47,15 @@ pageRequestsJs =
</html> </html>
""" """
pageEmpty :: String
pageEmpty =
"""
<html>
<head></head>
<body></body>
</html>
"""
scriptUnblocks :: String scriptUnblocks :: String
scriptUnblocks = "window.unblock = true" scriptUnblocks = "window.unblock = true"
@ -142,3 +157,42 @@ spec =
closeF <- forkAff $ Pup.Page.Event.once Pup.Page.Event.Close p closeF <- forkAff $ Pup.Page.Event.once Pup.Page.Event.Close p
Pup.Page.close p Pup.Page.close p
joinFiber closeF 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"