fix: listen should not be async by default
This commit is contained in:
parent
b59de0f5b5
commit
f126123369
@ -40,10 +40,10 @@ import Puppeteer.Page.Event.ConsoleMessage as ConsoleMessage
|
||||
import Puppeteer.Page.Event.Dialog (Dialog)
|
||||
import Simple.JSON (class ReadForeign, readImpl)
|
||||
|
||||
connectPageConsole :: Page -> Aff Unit
|
||||
connectPageConsole :: Page -> Effect Unit
|
||||
connectPageConsole p =
|
||||
let
|
||||
onmsg m = do
|
||||
onmsg m = launchAff_ do
|
||||
title <- Page.title p
|
||||
let t = ConsoleMessage.messageType m
|
||||
let textLevel = "[" <> String.toUpper (messageTypeString t) <> "]"
|
||||
@ -149,13 +149,13 @@ once ev p =
|
||||
in
|
||||
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 =
|
||||
let
|
||||
cb' f = unsafePerformEffect $ do
|
||||
evd <- liftEither $ lmap error $ note "parse failed" $ eventData f
|
||||
launchAff_ $ cb evd
|
||||
cb evd
|
||||
in
|
||||
do
|
||||
t <- liftEffect $ _addListener (eventKey ev) cb' p
|
||||
t <- _addListener (eventKey ev) cb' p
|
||||
pure $ Context (\_ -> liftEffect $ _removeListener t p)
|
||||
|
@ -10,7 +10,8 @@ import Data.Either (Either(..))
|
||||
import Data.Maybe (Maybe(..), isJust)
|
||||
import Data.Newtype (wrap)
|
||||
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 Puppeteer (timeout)
|
||||
import Puppeteer as Pup
|
||||
@ -68,7 +69,7 @@ spec =
|
||||
withPage $ test "listen PageError" \p -> do
|
||||
errorsST <- liftST $ ST.Ref.new []
|
||||
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
|
||||
err <- timeoutThrow (wrap 1000.0) $ untilJust (liftST $ Array.head <$> ST.Ref.read errorsST)
|
||||
Error.message err `shouldEqual` "eek!"
|
||||
@ -116,7 +117,7 @@ spec =
|
||||
{ body = Just (Left "console.log('hi')")
|
||||
, contentType = Just "text/javascript"
|
||||
}
|
||||
let
|
||||
|
||||
onrequest c r = do
|
||||
untilJust do
|
||||
continue <- liftST $ ST.Ref.read continueST
|
||||
|
@ -150,7 +150,7 @@ spec = beforeAll (Pup.launch_ =<< Pup.new)
|
||||
|
||||
test "addStyleTag" \b -> do
|
||||
p <- Pup.Page.new b
|
||||
connectPageConsole p
|
||||
liftEffect $ connectPageConsole p
|
||||
failOnPageError p do
|
||||
Pup.Page.setContent simplePage Pup.Load p
|
||||
_ <- Pup.Page.addStyleTag (Pup.Page.AddStyleInline styleFoo) p
|
||||
@ -162,7 +162,7 @@ spec = beforeAll (Pup.launch_ =<< Pup.new)
|
||||
|
||||
test "addScriptTag" \b -> do
|
||||
p <- Pup.Page.new b
|
||||
connectPageConsole p
|
||||
liftEffect $ connectPageConsole p
|
||||
failOnPageError p do
|
||||
Pup.Page.setContent simplePage Pup.Load p
|
||||
_ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline scriptAddBar) p
|
||||
@ -171,7 +171,7 @@ spec = beforeAll (Pup.launch_ =<< Pup.new)
|
||||
|
||||
test "keyboard" \b -> do
|
||||
p <- Pup.Page.new b
|
||||
connectPageConsole p
|
||||
liftEffect $ connectPageConsole p
|
||||
failOnPageError p do
|
||||
Pup.Page.setContent inputPage Pup.Load p
|
||||
input <- liftMaybe (error "no inputs!") =<< Pup.Page.findFirst "input" p
|
||||
|
Loading…
Reference in New Issue
Block a user