fix: generalize timeout

src/Puppeteer.Base.purs

@@ -2,16 +2,17 @@ module Puppeteer.Base where
 
 import Prelude
 
-import Control.Alt ((<|>))
+import Control.Alt (class Alt, (<|>))
-import Control.Monad.Error.Class (liftMaybe, try)
+import Control.Monad.Error.Class (class MonadError, liftMaybe, try)
 import Control.Monad.Except (runExcept)
-import Control.Parallel (parallel, sequential)
+import Control.Parallel (class Parallel, parallel, sequential)
 import Data.Bifunctor (lmap)
 import Data.Either (Either(..), hush)
 import Data.Map (Map)
 import Data.Maybe (Maybe(..))
 import Data.Time.Duration (Milliseconds)
 import Effect.Aff (Aff, delay)
+import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Exception (Error, error)
 import Foreign (Foreign, unsafeFromForeign)
 import Foreign.Object (Object)
@@ -44,15 +45,20 @@ mapToObject = Object.fromFoldableWithIndex <<< map writeImpl
 merge :: forall a b c. Union a b c => Record a -> Record b -> Record c
 merge a b = unsafeUnion a b
 
-timeout :: forall a. Milliseconds -> Aff a -> Aff (Maybe a)
+timeout :: forall ms mp a e. Parallel mp ms => Alt mp => MonadError e ms => MonadAff ms => Milliseconds -> ms a -> ms (Maybe a)
 timeout t a =
   let
-    timeout_ = const Nothing <$> delay t
+    delay' :: ms Unit
+    delay' = liftAff $ delay t
+    timeout_ = const Nothing <$> delay'
   in
     sequential $ parallel (hush <$> try a) <|> parallel timeout_
 
-timeoutThrow :: forall a. Milliseconds -> Aff a -> Aff a
+timeout' :: forall ms mp a. Parallel mp ms => Alt mp => MonadError Error ms => MonadAff ms => Milliseconds -> ms a -> ms a
-timeoutThrow t a = liftMaybe (error "timeout") =<< timeout t a
+timeout' = timeoutThrow (error "timeout")
+
+timeoutThrow :: forall ms mp a e. Parallel mp ms => Alt mp => MonadError e ms => MonadAff ms => e -> Milliseconds -> ms a -> ms a
+timeoutThrow err t a = liftMaybe err =<< timeout t a
 
 newtype Context (a :: Symbol) = Context (Unit -> Aff Unit)
 

test/Puppeteer.Handle.Spec.purs

@@ -19,8 +19,8 @@ import Effect.Class (liftEffect)
 import Effect.Exception (error)
 import Node.Buffer as Buffer
 import Node.URL as Node.URL
+import Puppeteer (timeout')
 import Puppeteer as Pup
-import Puppeteer.Base (timeoutThrow)
 import Puppeteer.Browser as Pup.Browser
 import Puppeteer.Eval as Pup.Eval
 import Puppeteer.Handle as Pup.Handle
@@ -151,7 +151,7 @@ spec = withPage $ describe "Handle" do
         log <- forkAff $ Pup.Page.Event.once Pup.Page.Event.Console p
         button <- liftMaybe (error "button#clickme not found!") =<< Pup.Page.findFirst (S.button `S.hasId` "clickme") p
         f button
-        log' <- timeoutThrow (wrap 100.0) $ joinFiber log
+        log' <- timeout' (wrap 100.0) $ joinFiber log
         ConsoleMessage.text log' `shouldEqual` "clicked!"
 
   test "click" $ clickOrTap Pup.Handle.click
@@ -202,7 +202,7 @@ spec = withPage $ describe "Handle" do
         pure $ if Array.length as' == 4 then Done as' else Loop as'
     logs <- forkAff $ tailRecM collectLogs []
     Pup.Handle.drop dragme dropme
-    logs' <- timeoutThrow (wrap 1000.0) $ joinFiber logs
+    logs' <- timeout' (wrap 1000.0) $ joinFiber logs
     (ConsoleMessage.text <$> logs') `shouldEqual` [ "drag", "dragenter", "dragover", "dragend" ]
 
   test "screenshot" \p -> do
@@ -214,7 +214,7 @@ spec = withPage $ describe "Handle" do
     sel <- liftMaybe (error "select not found!") =<< Pup.Page.findFirst S.select p
     log <- forkAff $ Pup.Page.Event.once Pup.Page.Event.Console p
     Pup.Handle.select [ "foo" ] sel
-    log' <- timeoutThrow (wrap 1000.0) $ joinFiber log
+    log' <- timeout' (wrap 1000.0) $ joinFiber log
     ConsoleMessage.text log' `shouldEqual` "select(foo)"
 
   test "getProperties" \p -> do

test/Puppeteer.Page.Event.Spec.purs

@@ -15,7 +15,7 @@ import Effect.Aff (Aff, launchAff_, delay, forkAff, joinFiber)
 import Effect.Exception as Error
 import Puppeteer (timeout)
 import Puppeteer as Pup
-import Puppeteer.Base (timeoutThrow)
+import Puppeteer.Base (timeout')
 import Puppeteer.Browser as Pup.Browser
 import Puppeteer.HTTP.Request as Pup.HTTP.Request
 import Puppeteer.Page as Pup.Page
@@ -71,7 +71,7 @@ spec =
             let handle = void <<< liftST <<< flip ST.Ref.modify errorsST <<< Array.cons
             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)
+            err <- timeout' (wrap 1000.0) $ untilJust (liftST $ Array.head <$> ST.Ref.read errorsST)
             Error.message err `shouldEqual` "eek!"
             Pup.closeContext listening
 
@@ -91,7 +91,7 @@ spec =
           withPage $ test "Dialog" \p -> failOnPageError p do
             dialogF <- forkAff $ Pup.Page.Event.once Pup.Page.Event.Dialog p
             script <- forkAff $ Pup.Page.addScriptTag (Pup.Page.AddScriptInline scriptDialog) p
-            dialog <- timeoutThrow (wrap 3000.0) $ joinFiber dialogF
+            dialog <- timeout' (wrap 3000.0) $ joinFiber dialogF
             Dialog.dismiss dialog
             void $ joinFiber script
 
@@ -105,9 +105,9 @@ spec =
             requestIntercepted <- forkAff $ Pup.Page.HTTP.interceptNextRequest onrequest p
             log <- forkAff $ Pup.Page.Event.once Pup.Page.Event.Console p
             loadEvent <- forkAff $ Pup.Page.setContent pageRequestsJs Pup.Load p
-            timeoutThrow (wrap 1000.0) $ joinFiber requestIntercepted
+            timeout' (wrap 1000.0) $ joinFiber requestIntercepted
-            timeoutThrow (wrap 1000.0) $ joinFiber loadEvent
+            timeout' (wrap 1000.0) $ joinFiber loadEvent
-            log' <- timeoutThrow (wrap 1000.0) $ joinFiber log
+            log' <- timeout' (wrap 1000.0) $ joinFiber log
             ConsoleMessage.text log' `shouldEqual` "hi"
 
           withPage $ test "DomContentLoaded, Load" \p -> failOnPageError p do
@@ -132,8 +132,8 @@ spec =
             let shouldBeLoaded yn = shouldEqual yn =<< map isJust loaded'
             shouldBeLoaded false
             _ <- liftST $ ST.Ref.write true continueST
-            timeoutThrow (wrap 100.0) $ joinFiber requestIntercepted
+            timeout' (wrap 100.0) $ joinFiber requestIntercepted
-            timeoutThrow (wrap 100.0) $ joinFiber f
+            timeout' (wrap 100.0) $ joinFiber f
             shouldBeLoaded true
 
           test "Close" \b -> do

test/Puppeteer.Page.Spec.purs

@@ -12,7 +12,7 @@ import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
 import Effect.Exception (error)
 import Puppeteer as Pup
-import Puppeteer.Base (timeoutThrow)
+import Puppeteer.Base (timeout')
 import Puppeteer.Handle as Pup.Handle
 import Puppeteer.Handle.HTML as Pup.Handle.HTML
 import Puppeteer.Keyboard as Pup.Keyboard
@@ -166,7 +166,7 @@ spec = beforeAll (Pup.launch_ =<< Pup.new)
         failOnPageError p do
           Pup.Page.setContent simplePage Pup.Load p
           _ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline scriptAddBar) p
-          _ <- timeoutThrow (Milliseconds 5000.0) $ Pup.Page.WaitFor.selector "div#bar" p
+          _ <- timeout' (Milliseconds 5000.0) $ Pup.Page.WaitFor.selector "div#bar" p
           Pup.Page.close p
 
       test "keyboard" \b -> do