orion/purescript-puppeteer
orion/purescript-puppeteer
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fix: listen should not be async by default

Browse Source
This commit is contained in:
orion 2023-10-07 11:28:24 -05:00
parent b59de0f5b5
commit f126123369
Signed by: orion
GPG Key ID: 6D4165AE4C928719
3 changed files with 12 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Puppeteer.Page.Event.purs
View File

@ -40,10 +40,10 @@ import Puppeteer.Page.Event.ConsoleMessage as ConsoleMessage
import Puppeteer.Page.Event.Dialog (Dialog) import Puppeteer.Page.Event.Dialog (Dialog)
import Simple.JSON (class ReadForeign, readImpl) import Simple.JSON (class ReadForeign, readImpl)
connectPageConsole :: Page -> Aff Unit connectPageConsole :: Page -> Effect Unit
connectPageConsole p = connectPageConsole p =
let let
onmsg m = do onmsg m = launchAff_ do
title <- Page.title p title <- Page.title p
let t = ConsoleMessage.messageType m let t = ConsoleMessage.messageType m
let textLevel = "[" <> String.toUpper (messageTypeString t) <> "]" let textLevel = "[" <> String.toUpper (messageTypeString t) <> "]"
@ -149,13 +149,13 @@ once ev p =
in in
makeAff f makeAff f
listen :: forall ev evd. Event ev evd => ev -> (evd -> Aff Unit) -> Page -> Aff (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
cb' f = unsafePerformEffect $ do cb' f = unsafePerformEffect $ do
evd <- liftEither $ lmap error $ note "parse failed" $ eventData f evd <- liftEither $ lmap error $ note "parse failed" $ eventData f
launchAff_ $ cb evd cb evd
in in
do do
t <- liftEffect $ _addListener (eventKey ev) cb' p t <- _addListener (eventKey ev) cb' p
pure $ Context (\_ -> liftEffect $ _removeListener t p) pure $ Context (\_ -> liftEffect $ _removeListener t p)

7
test/Puppeteer.Page.Event.Spec.purs
View File

@ -10,7 +10,8 @@ import Data.Either (Either(..))
import Data.Maybe (Maybe(..), isJust) import Data.Maybe (Maybe(..), isJust)
import Data.Newtype (wrap) import Data.Newtype (wrap)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff, delay, forkAff, joinFiber) import Effect.Class (liftEffect)
import Effect.Aff (Aff, launchAff_, delay, forkAff, joinFiber)
import Effect.Exception as Error import Effect.Exception as Error
import Puppeteer (timeout) import Puppeteer (timeout)
import Puppeteer as Pup import Puppeteer as Pup
@ -68,7 +69,7 @@ spec =
withPage $ test "listen PageError" \p -> do withPage $ test "listen PageError" \p -> do
errorsST <- liftST $ ST.Ref.new [] errorsST <- liftST $ ST.Ref.new []
let handle = void <<< liftST <<< flip ST.Ref.modify errorsST <<< Array.cons let handle = void <<< liftST <<< flip ST.Ref.modify errorsST <<< Array.cons
listening <- Pup.Page.Event.listen Pup.Page.Event.PageError handle p listening <- liftEffect $ Pup.Page.Event.listen Pup.Page.Event.PageError handle p
void $ Pup.Page.addScriptTag (Pup.Page.AddScriptInline scriptError) p void $ Pup.Page.addScriptTag (Pup.Page.AddScriptInline scriptError) p
err <- timeoutThrow (wrap 1000.0) $ untilJust (liftST $ Array.head <$> ST.Ref.read errorsST) err <- timeoutThrow (wrap 1000.0) $ untilJust (liftST $ Array.head <$> ST.Ref.read errorsST)
Error.message err `shouldEqual` "eek!" Error.message err `shouldEqual` "eek!"
@ -116,7 +117,7 @@ spec =
{ body = Just (Left "console.log('hi')") { body = Just (Left "console.log('hi')")
, contentType = Just "text/javascript" , contentType = Just "text/javascript"
} }
let
onrequest c r = do onrequest c r = do
untilJust do untilJust do
continue <- liftST $ ST.Ref.read continueST continue <- liftST $ ST.Ref.read continueST

6
test/Puppeteer.Page.Spec.purs
View File

@ -150,7 +150,7 @@ spec = beforeAll (Pup.launch_ =<< Pup.new)
test "addStyleTag" \b -> do test "addStyleTag" \b -> do
p <- Pup.Page.new b p <- Pup.Page.new b
connectPageConsole p liftEffect $ connectPageConsole p
failOnPageError p do failOnPageError p do
Pup.Page.setContent simplePage Pup.Load p Pup.Page.setContent simplePage Pup.Load p
_ <- Pup.Page.addStyleTag (Pup.Page.AddStyleInline styleFoo) p _ <- Pup.Page.addStyleTag (Pup.Page.AddStyleInline styleFoo) p
@ -162,7 +162,7 @@ spec = beforeAll (Pup.launch_ =<< Pup.new)
test "addScriptTag" \b -> do test "addScriptTag" \b -> do
p <- Pup.Page.new b p <- Pup.Page.new b
connectPageConsole p liftEffect $ connectPageConsole p
failOnPageError p do failOnPageError p do
Pup.Page.setContent simplePage Pup.Load p Pup.Page.setContent simplePage Pup.Load p
_ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline scriptAddBar) p _ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline scriptAddBar) p
@ -171,7 +171,7 @@ spec = beforeAll (Pup.launch_ =<< Pup.new)
test "keyboard" \b -> do test "keyboard" \b -> do
p <- Pup.Page.new b p <- Pup.Page.new b
connectPageConsole p liftEffect $ connectPageConsole p
failOnPageError p do failOnPageError p do
Pup.Page.setContent inputPage Pup.Load p Pup.Page.setContent inputPage Pup.Load p
input <- liftMaybe (error "no inputs!") =<< Pup.Page.findFirst "input" p input <- liftMaybe (error "no inputs!") =<< Pup.Page.findFirst "input" p