test: test selector

spago.dhall

@@ -26,6 +26,7 @@ to generate this file without the comments in this block.
   , "filterable"
   , "foldable-traversable"
   , "foreign"
+  , "identity"
   , "integers"
   , "maybe"
   , "newtype"

src/Puppeteer.Base.purs

@@ -3,9 +3,10 @@ module Puppeteer.Base where
 import Prelude
 
 import Control.Alt ((<|>))
-import Control.Monad.Error.Class (liftMaybe, throwError)
+import Control.Monad.Error.Class (liftMaybe, try)
 import Control.Parallel (parallel, sequential)
-import Data.Maybe (Maybe(..), maybe)
+import Data.Either (hush)
+import Data.Maybe (Maybe(..))
 import Data.Time.Duration (Milliseconds)
 import Effect.Aff (Aff, delay)
 import Effect.Exception (error)
@@ -22,7 +23,7 @@ timeout t a =
   let
     timeout_ = const Nothing <$> delay t
   in
-    sequential $ parallel (Just <$> a) <|> parallel timeout_
+    sequential $ parallel (hush <$> try a) <|> parallel timeout_
 
 timeoutThrow :: forall a. Milliseconds -> Aff a -> Aff a
 timeoutThrow t a = liftMaybe (error "timeout") =<< timeout t a

src/Puppeteer.Http.purs

@@ -1,4 +1,4 @@
-module Puppeteer.Http (module X, ErrorCode(..), ResourceType(..), errorCodeString, resourceTypeOfString) where
+module Puppeteer.HTTP (module X, ErrorCode(..), ResourceType(..), errorCodeString, resourceTypeOfString) where
 
 import Puppeteer.Base (Request, Response) as X
 

src/Puppeteer.Page.Event.ConsoleMessage.purs

@@ -58,7 +58,8 @@ data MessageType
 
 derive instance eqMessageType :: Eq MessageType
 derive instance genericMessageType :: Generic MessageType _
-instance showMessageType :: Show MessageType where show = genericShow
+instance showMessageType :: Show MessageType where
+  show = genericShow
 
 messageTypeOfString :: String -> MessageType
 messageTypeOfString "debug" = Debug

src/Puppeteer.Page.Event.purs

@@ -33,7 +33,7 @@ import Effect.Exception (Error, error)
 import Effect.Unsafe (unsafePerformEffect)
 import Foreign (Foreign, unsafeFromForeign)
 import Puppeteer.Base (Context(..), Frame, Page)
-import Puppeteer.Http as Http
+import Puppeteer.HTTP as HTTP
 import Puppeteer.Page as Page
 import Puppeteer.Page.Event.ConsoleMessage (ConsoleMessage, messageTypeString)
 import Puppeteer.Page.Event.ConsoleMessage as ConsoleMessage
@@ -108,7 +108,7 @@ instance nullablePageEvent :: Event NullablePageEvent (Nullable Page) where
 
 data ResponseEvent = Response
 
-instance responseEvent :: Event ResponseEvent Http.Response where
+instance responseEvent :: Event ResponseEvent HTTP.Response where
   eventKey Response = "response"
   eventData = defaultEventData
 
@@ -118,7 +118,7 @@ data RequestEvent
   | RequestFinished
   | RequestServedFromCache
 
-instance requestEvent :: Event RequestEvent Http.Request where
+instance requestEvent :: Event RequestEvent HTTP.Request where
   eventKey Request = "request"
   eventKey RequestFailed = "requestfailed"
   eventKey RequestFinished = "requestfinished"

src/Puppeteer.Page.HTTP.Request.purs

@@ -1,4 +1,15 @@
-module Puppeteer.Http.Request where
+module Puppeteer.HTTP.Request
+  ( ContinueRequestOverrides
+  , RespondToRequest
+  , defaultContinue
+  , defaultRespond
+  , respond
+  , continue
+  , abort
+  , failure
+  , postData
+  , response
+  ) where
 
 import Prelude
 
@@ -7,7 +18,7 @@ import Control.Promise (Promise)
 import Control.Promise as Promise
 import Data.Either (Either, either, hush)
 import Data.Map (Map)
-import Data.Maybe (Maybe)
+import Data.Maybe (Maybe(..))
 import Data.Nullable (Nullable)
 import Data.Nullable as Nullable
 import Effect (Effect)
@@ -16,7 +27,8 @@ import Foreign (Foreign, unsafeToForeign)
 import Node.Buffer (Buffer)
 import Puppeteer.Base (Context(..), Request, Response)
 import Puppeteer.FFI as FFI
-import Puppeteer.Http (ErrorCode, errorCodeString)
+import Puppeteer.HTTP (ErrorCode, errorCodeString)
+import Puppeteer.Page.HTTP (InterceptRequestsHint)
 import Simple.JSON (readImpl, writeImpl)
 
 type RespondToRequest =
@@ -26,6 +38,9 @@ type RespondToRequest =
   , status :: Maybe Int
   }
 
+defaultRespond :: RespondToRequest
+defaultRespond = { body: Nothing, contentType: Nothing, headers: Nothing, status: Nothing }
+
 prepareRespondToRequest :: RespondToRequest -> Foreign
 prepareRespondToRequest { body, contentType, headers: headers', status } = writeImpl
   { body: FFI.maybeToUndefined $ map (either unsafeToForeign unsafeToForeign) body
@@ -41,11 +56,14 @@ type ContinueRequestOverrides =
   , url :: Maybe String
   }
 
+defaultContinue :: ContinueRequestOverrides
+defaultContinue = { url: Nothing, postData: Nothing, headers: Nothing, method: Nothing }
+
 prepareContinueRequestOverrides :: ContinueRequestOverrides -> Foreign
-prepareContinueRequestOverrides { headers: headers', method: method', postData, url: url' } = writeImpl
+prepareContinueRequestOverrides { headers: headers', method: method', postData: postData', url: url' } = writeImpl
   { headers: FFI.maybeToUndefined $ map FFI.mapToRecord headers'
   , method: FFI.maybeToUndefined method'
-  , postData: FFI.maybeToUndefined postData
+  , postData: FFI.maybeToUndefined postData'
   , url: FFI.maybeToUndefined url'
   }
 
@@ -63,13 +81,13 @@ foreign import _failure :: Request -> Effect (Nullable { errorText :: String })
 foreign import _postData :: Request -> Effect Foreign
 foreign import _response :: Request -> Effect (Nullable Response)
 
-abort :: Context "intercepting requests" -> ErrorCode -> Request -> Aff Unit
+abort :: Context InterceptRequestsHint -> ErrorCode -> Request -> Aff Unit
 abort _ e = Promise.toAff <<< _abort (errorCodeString e)
 
-continue :: Context "intercepting requests" -> ContinueRequestOverrides -> Request -> Aff Unit
+continue :: Context InterceptRequestsHint -> ContinueRequestOverrides -> Request -> Aff Unit
 continue _ o = Promise.toAff <<< _continue (prepareContinueRequestOverrides o)
 
-respond :: Context "intercepting requests" -> RespondToRequest -> Request -> Aff Unit
+respond :: Context InterceptRequestsHint -> RespondToRequest -> Request -> Aff Unit
 respond _ r = Promise.toAff <<< _respond (prepareRespondToRequest r)
 
 failure :: Request -> Effect (Maybe String)

src/Puppeteer.Page.HTTP.Response.purs

@@ -1,4 +1,4 @@
-module Puppeteer.Http.Response (request, url, status, statusText, bodyBuffer, bodyJson, bodyText, remoteAddressIp, remoteAddressPort) where
+module Puppeteer.HTTP.Response (request, url, status, statusText, bodyBuffer, bodyJson, bodyText, remoteAddressIp, remoteAddressPort) where
 
 import Prelude
 

src/Puppeteer.Page.HTTP.purs

@@ -1,4 +1,13 @@
-module Puppeteer.Page.Http (bypassCsp, disableCache, interceptRequests, sendExtraHeaders, interceptNextRequest) where
+module Puppeteer.Page.HTTP
+  ( BypassCSPHint
+  , InterceptRequestsHint
+  , DisableCacheHint
+  , bypassCsp
+  , disableCache
+  , interceptRequests
+  , sendExtraHeaders
+  , interceptNextRequest
+  ) where
 
 import Prelude
 
@@ -9,7 +18,7 @@ import Effect.Aff (Aff)
 import Foreign (Foreign)
 import Puppeteer.Base (Context(..), Page, closeContext)
 import Puppeteer.FFI as FFI
-import Puppeteer.Http (Request)
+import Puppeteer.HTTP (Request)
 import Puppeteer.Page.Event as Event
 
 foreign import _bypassCsp :: Page -> Promise Unit
@@ -47,12 +56,12 @@ interceptRequests p = do
   Promise.toAff $ _interceptRequests p
   pure (Context $ \_ -> Promise.toAff $ _uninterceptRequests p)
 
-interceptNextRequest :: Page -> (Context InterceptRequestsHint -> Request -> Aff Unit) -> Aff Unit
+interceptNextRequest :: (Context InterceptRequestsHint -> Request -> Aff Unit) -> Page -> Aff Unit
-interceptNextRequest p cb = do
+interceptNextRequest cb p = do
   ctx <- interceptRequests p
   req <- Event.once Event.Request p
-  closeContext ctx
   cb ctx req
+  closeContext ctx
   pure unit
 
 sendExtraHeaders :: Map String String -> Page -> Aff Unit

src/Puppeteer.Page.Navigate.purs

@@ -10,33 +10,33 @@ import Data.Time.Duration (Milliseconds(..))
 import Effect.Aff (Aff)
 import Foreign (Foreign)
 import Puppeteer.Base (LifecycleEvent(..), Page, URL, prepareLifecycleEvent)
-import Puppeteer.Http as Http
+import Puppeteer.HTTP as HTTP
 
-foreign import _forward :: Foreign -> Page -> Promise (Maybe Http.Response)
+foreign import _forward :: Foreign -> Page -> Promise (Maybe HTTP.Response)
-foreign import _back :: Foreign -> Page -> Promise (Maybe Http.Response)
+foreign import _back :: Foreign -> Page -> Promise (Maybe HTTP.Response)
-foreign import _reload :: Foreign -> Page -> Promise (Maybe Http.Response)
+foreign import _reload :: Foreign -> Page -> Promise (Maybe HTTP.Response)
-foreign import _to :: String -> Foreign -> Page -> Promise (Maybe Http.Response)
+foreign import _to :: String -> Foreign -> Page -> Promise (Maybe HTTP.Response)
 
-forward :: LifecycleEvent -> Page -> Aff (Maybe Http.Response)
+forward :: LifecycleEvent -> Page -> Aff (Maybe HTTP.Response)
 forward ev = Promise.toAff <<< _forward (prepareLifecycleEvent ev)
 
-back :: LifecycleEvent -> Page -> Aff (Maybe Http.Response)
+back :: LifecycleEvent -> Page -> Aff (Maybe HTTP.Response)
 back ev = Promise.toAff <<< _back (prepareLifecycleEvent ev)
 
-to :: URL -> LifecycleEvent -> Page -> Aff (Maybe Http.Response)
+to :: URL -> LifecycleEvent -> Page -> Aff (Maybe HTTP.Response)
 to url ev = Promise.toAff <<< _to url (prepareLifecycleEvent ev)
 
-reload :: LifecycleEvent -> Page -> Aff (Maybe Http.Response)
+reload :: LifecycleEvent -> Page -> Aff (Maybe HTTP.Response)
 reload ev = Promise.toAff <<< _reload (prepareLifecycleEvent ev)
 
-forward_ :: Page -> Aff (Maybe Http.Response)
+forward_ :: Page -> Aff (Maybe HTTP.Response)
 forward_ = forward Load
 
-back_ :: Page -> Aff (Maybe Http.Response)
+back_ :: Page -> Aff (Maybe HTTP.Response)
 back_ = back Load
 
-to_ :: URL -> Page -> Aff (Maybe Http.Response)
+to_ :: URL -> Page -> Aff (Maybe HTTP.Response)
 to_ url = to url Load
 
-reload_ :: Page -> Aff (Maybe Http.Response)
+reload_ :: Page -> Aff (Maybe HTTP.Response)
 reload_ = reload Load

src/Puppeteer.Page.purs

@@ -13,7 +13,6 @@ module Puppeteer.Page
   , AddStyleLocal(..)
   , AddStyleRemote(..)
   , AddScript(..)
-  , ScriptType(..)
   , close
   , isClosed
   , content
@@ -48,16 +47,13 @@ import Puppeteer.Selector (class Selector, toCSS)
 import Simple.JSON (readImpl, undefined, writeImpl)
 import Web.HTML (HTMLLinkElement, HTMLScriptElement, HTMLStyleElement)
 
-data ScriptType = Script | Module
-
-prepareScriptType :: ScriptType -> Foreign
-prepareScriptType Module = unsafeToForeign "module"
-prepareScriptType Script = undefined
-
 data AddScript
-  = AddScriptInline ScriptType String
+  = AddScriptInline String
-  | AddScriptLocal ScriptType FilePath
+  | AddScriptLocal FilePath
-  | AddScriptRemote ScriptType URL
+  | AddScriptRemote URL
+  | AddModuleInline String
+  | AddModuleLocal FilePath
+  | AddModuleRemote URL
 
 data AddStyleInline = AddStyleInline String
 data AddStyleLocal = AddStyleLocal FilePath
@@ -77,16 +73,28 @@ instance styleRemote :: AddStyle AddStyleRemote HTMLLinkElement where
   prepareAddStyle (AddStyleRemote url') = writeImpl { url: url' }
 
 prepareAddScript :: AddScript -> Foreign
-prepareAddScript (AddScriptInline type' content') = writeImpl
+prepareAddScript (AddScriptInline content') = writeImpl
-  { type: prepareScriptType type'
+  { type: undefined
   , content: content'
   }
-prepareAddScript (AddScriptLocal type' path) = writeImpl
+prepareAddScript (AddScriptLocal path) = writeImpl
-  { type: prepareScriptType type'
+  { type: undefined
   , path
   }
-prepareAddScript (AddScriptRemote type' url') = writeImpl
+prepareAddScript (AddScriptRemote url') = writeImpl
-  { type: prepareScriptType type'
+  { type: undefined
+  , url: url'
+  }
+prepareAddScript (AddModuleInline content') = writeImpl
+  { type: writeImpl "module"
+  , content: content'
+  }
+prepareAddScript (AddModuleLocal path) = writeImpl
+  { type: writeImpl "module"
+  , path
+  }
+prepareAddScript (AddModuleRemote url') = writeImpl
+  { type: writeImpl "module"
   , url: url'
   }
 

src/Puppeteer.Selector.purs

@@ -4,8 +4,9 @@ import Prelude
 
 import Data.Int as Int
 import Data.String as String
-import Web.HTML.HTMLHtmlElement (HTMLHtmlElement)
+import Data.Tuple (Tuple(..))
 import Web.HTML (HTMLAnchorElement, HTMLAudioElement, HTMLBRElement, HTMLBodyElement, HTMLButtonElement, HTMLCanvasElement, HTMLDListElement, HTMLDataElement, HTMLDataListElement, HTMLDivElement, HTMLElement, HTMLEmbedElement, HTMLFieldSetElement, HTMLFormElement, HTMLHRElement, HTMLHeadElement, HTMLHeadingElement, HTMLIFrameElement, HTMLImageElement, HTMLInputElement, HTMLLIElement, HTMLLabelElement, HTMLLegendElement, HTMLLinkElement, HTMLMetaElement, HTMLMeterElement, HTMLOListElement, HTMLObjectElement, HTMLOptGroupElement, HTMLOptionElement, HTMLParagraphElement, HTMLPreElement, HTMLProgressElement, HTMLQuoteElement, HTMLScriptElement, HTMLSelectElement, HTMLSourceElement, HTMLSpanElement, HTMLStyleElement, HTMLTableCaptionElement, HTMLTableCellElement, HTMLTableColElement, HTMLTableElement, HTMLTableRowElement, HTMLTableSectionElement, HTMLTemplateElement, HTMLTextAreaElement, HTMLTimeElement, HTMLTitleElement, HTMLTrackElement, HTMLUListElement, HTMLVideoElement)
+import Web.HTML.HTMLHtmlElement (HTMLHtmlElement)
 
 class Selector :: Type -> Type -> Constraint
 class Selector a e | a -> e where
@@ -17,15 +18,15 @@ instance selectorString :: Selector String HTMLElement where
 instance selectorArraySel :: Selector s e => Selector (Array s) e where
   toCSS = map toCSS >>> String.joinWith ", "
 
-instance selectorHaving :: Selector s e => Selector (Having s) e where
+instance selectorHas :: Selector s e => Selector (Has s) e where
-  toCSS (HavingId id s) = toCSS s <> "#" <> id
+  toCSS (HasId s id) = toCSS s <> "#" <> id
-  toCSS (HavingClass cls s) = toCSS s <> "." <> cls
+  toCSS (HasClass s cls) = toCSS s <> "." <> cls
-  toCSS (HavingAttrEqualTo k v s) = toCSS s <> "[" <> k <> "=" <> v <> "]"
+  toCSS (HasAttrEqualTo s k v) = toCSS s <> "[" <> show k <> "=" <> show v <> "]"
-  toCSS (HavingAttrListContaining k v s) = toCSS s <> "[" <> k <> "~=" <> v <> "]"
+  toCSS (HasAttrListContaining s k v) = toCSS s <> "[" <> show k <> "~=" <> show v <> "]"
-  toCSS (HavingAttrStartsWith k v s) = toCSS s <> "[" <> k <> "^=" <> v <> "]"
+  toCSS (HasAttrStartsWith s k v) = toCSS s <> "[" <> show k <> "^=" <> show v <> "]"
-  toCSS (HavingAttrEndsWith k v s) = toCSS s <> "[" <> k <> "$=" <> v <> "]"
+  toCSS (HasAttrEndsWith s k v) = toCSS s <> "[" <> show k <> "$=" <> show v <> "]"
-  toCSS (HavingAttrContaining k v s) = toCSS s <> "[" <> k <> "*=" <> v <> "]"
+  toCSS (HasAttrContaining s k v) = toCSS s <> "[" <> show k <> "*=" <> show v <> "]"
-  toCSS (HavingAttr k s) = toCSS s <> "[" <> k <> "]"
+  toCSS (HasAttr s k) = toCSS s <> "[" <> show k <> "]"
 
 instance selectorSelectorRefine :: Selector s e => Selector (SelectorRefine s) e where
   toCSS (SelectorActive a) = toCSS a <> ":active"
@@ -60,15 +61,15 @@ instance selectorSelectorCombinator :: (Selector a e, Selector b f) => Selector
   toCSS (SelectorNot a b) = toCSS a <> ":not(" <> toCSS b <> ")"
   toCSS (SelectorWhere a b) = toCSS a <> ":where(" <> toCSS b <> ")"
 
-data Having a
+data Has a
-  = HavingId String a
+  = HasId a String
-  | HavingClass String a
+  | HasClass a String
-  | HavingAttrEqualTo String String a
+  | HasAttrEqualTo a String String
-  | HavingAttrListContaining String String a
+  | HasAttrListContaining a String String
-  | HavingAttrStartsWith String String a
+  | HasAttrStartsWith a String String
-  | HavingAttrEndsWith String String a
+  | HasAttrEndsWith a String String
-  | HavingAttrContaining String String a
+  | HasAttrContaining a String String
-  | HavingAttr String a
+  | HasAttr a String
 
 data SelectorRefine a
   = SelectorActive a
@@ -789,26 +790,26 @@ invalid = SelectorInvalid
 valid :: forall a. a -> SelectorRefine a
 valid = SelectorValid
 
-havingId :: forall a. String -> a -> Having a
+hasId :: forall a. a -> String -> Has a
-havingId = HavingId
+hasId = HasId
 
-havingClass :: forall a. String -> a -> Having a
+hasClass :: forall a. a -> String -> Has a
-havingClass = HavingClass
+hasClass = HasClass
 
-havingAttrEqualTo :: forall a. String -> String -> a -> Having a
+hasAttrEqualTo :: forall a. a -> Tuple String String -> Has a
-havingAttrEqualTo = HavingAttrEqualTo
+hasAttrEqualTo a (Tuple b c) = HasAttrEqualTo a b c
 
-havingAttrListContaining :: forall a. String -> String -> a -> Having a
+hasAttrListContaining :: forall a. a -> Tuple String String -> Has a
-havingAttrListContaining = HavingAttrListContaining
+hasAttrListContaining a (Tuple b c) = HasAttrListContaining a b c
 
-havingAttrStartsWith :: forall a. String -> String -> a -> Having a
+hasAttrStartsWith :: forall a. a -> Tuple String String -> Has a
-havingAttrStartsWith = HavingAttrStartsWith
+hasAttrStartsWith a (Tuple b c) = HasAttrStartsWith a b c
 
-havingAttrEndsWith :: forall a. String -> String -> a -> Having a
+hasAttrEndsWith :: forall a. a -> Tuple String String -> Has a
-havingAttrEndsWith = HavingAttrEndsWith
+hasAttrEndsWith a (Tuple b c) = HasAttrEndsWith a b c
 
-havingAttrContaining :: forall a. String -> String -> a -> Having a
+hasAttrContaining :: forall a. a -> Tuple String String -> Has a
-havingAttrContaining = HavingAttrContaining
+hasAttrContaining a (Tuple b c) = HasAttrContaining a b c
 
-havingAttr :: forall a. String -> a -> Having a
+hasAttr :: forall a. a -> String -> Has a
-havingAttr = HavingAttr
+hasAttr a b = HasAttr a b

test/Puppeteer.Browser.Spec.purs

@@ -7,7 +7,7 @@ import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
 import Puppeteer as Pup
 import Puppeteer.Browser as Pup.Browser
-import Test.Spec (SpecT, beforeAll, describe)
+import Test.Spec (SpecT, afterAll, beforeAll, describe)
 import Test.Spec.Assertions (shouldEqual, shouldNotEqual)
 import Test.Util (test, testE)
 

test/Puppeteer.Page.Event.Spec.purs

@@ -2,77 +2,142 @@ module Puppeteer.Page.Event.Spec where
 
 import Prelude
 
-import Control.Monad.Error.Class (liftMaybe)
 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.Ref
 import Data.Array as Array
-import Data.Array.NonEmpty as NonEmptyArray
+import Data.Either (Either(..))
-import Data.Map as Map
+import Data.Maybe (Maybe(..), isJust)
-import Data.Maybe (Maybe(..))
 import Data.Newtype (wrap)
-import Data.Time.Duration (Milliseconds(..))
 import Effect (Effect)
-import Effect.Aff (Aff, forkAff, joinFiber, makeAff)
+import Effect.Aff (Aff, delay, forkAff, joinFiber)
-import Effect.Class (liftEffect)
-import Effect.Exception (error)
 import Effect.Exception as Error
+import Puppeteer (timeout)
 import Puppeteer as Pup
 import Puppeteer.Base (timeoutThrow)
-import Puppeteer.Handle as Pup.Handle
+import Puppeteer.Browser as Pup.Browser
-import Puppeteer.Handle.HTML as Pup.Handle.HTML
+import Puppeteer.HTTP.Request as Pup.HTTP.Request
-import Puppeteer.Keyboard as Pup.Keyboard
 import Puppeteer.Page as Pup.Page
-import Puppeteer.Page.Event (connectPageConsole)
 import Puppeteer.Page.Event as Pup.Page.Event
 import Puppeteer.Page.Event.ConsoleMessage as ConsoleMessage
-import Puppeteer.Page.WaitFor as Pup.Page.WaitFor
+import Puppeteer.Page.Event.Dialog as Dialog
-import Test.Spec (SpecT, afterAll, beforeAll, describe)
+import Puppeteer.Page.HTTP as Pup.Page.HTTP
+import Test.Spec (SpecT, afterAll, aroundWith, beforeAll, describe)
 import Test.Spec.Assertions (shouldEqual)
 import Test.Util (failOnPageError, test)
 
 scriptError :: String
 scriptError = "throw new Error('eek!')"
 
+pageRequestsJs :: String
+pageRequestsJs =
+  """
+<html>
+<head>
+  <script defer src="http://remote.org/index.js"></script>
+</head>
+<body></body>
+</html>
+"""
+
+scriptUnblocks :: String
+scriptUnblocks = "window.unblock = true"
+
+scriptDialog :: String
+scriptDialog = "alert('wow!')"
+
 scriptLog :: String
 scriptLog = "console.log('beak')"
 
-listenIntoSTArray :: forall e ed. Pup.Page.Event.Event e ed => e -> Pup.Page -> Aff ({ st :: ST.Ref.STRef ST.Global (Array ed), cleanup :: Aff Unit })
+withPage :: SpecT Aff Pup.Page Effect Unit -> SpecT Aff Pup.Browser Effect Unit
-listenIntoSTArray e p = do
+withPage =
-  st <- liftST $ ST.Ref.new []
   let
-    handle ed = do
+    withPage' spec' b = do
-      eds <- liftST $ ST.Ref.read st
+      page <- Pup.Page.new b
-      _ <- liftST $ ST.Ref.write (eds <> [ ed ]) st
+      spec' page
-      pure unit
+      Pup.Page.close page
-  t <- Pup.Page.Event.listen e handle p
+  in
-  pure { st, cleanup: Pup.closeContext t }
+    aroundWith withPage'
 
 spec :: SpecT Aff Unit Effect Unit
 spec =
-  beforeAll (Pup.Page.new =<< Pup.launch_ =<< Pup.puppeteer unit)
+  beforeAll (Pup.launch_ =<< Pup.puppeteer unit)
-    $ afterAll Pup.Page.close
+    $ afterAll Pup.Browser.close
-    $ describe "Page" do
+    $ do
-        test "listen, PageError" \p -> do
+        describe "Event" do
-          { st: errsST, cleanup } <- listenIntoSTArray Pup.Page.Event.PageError p
+          withPage $ test "listen PageError" \p -> do
-          _ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline Pup.Page.Script scriptError) p
+            errorsST <- liftST $ ST.Ref.new []
-          err <- timeoutThrow (wrap 1000.0)
+            let handle = void <<< liftST <<< flip ST.Ref.modify errorsST <<< Array.cons
-            $ untilJust do
+            listening <- Pup.Page.Event.listen Pup.Page.Event.PageError handle p
-                errs <- liftST $ ST.Ref.read errsST
+            void $ Pup.Page.addScriptTag (Pup.Page.AddScriptInline scriptError) p
-                pure $ Array.head errs
+            err <- timeoutThrow (wrap 1000.0) $ untilJust (liftST $ Array.head <$> ST.Ref.read errorsST)
-          Error.message err `shouldEqual` "eek!"
+            Error.message err `shouldEqual` "eek!"
-          cleanup
+            Pup.closeContext listening
 
-        test "once" \p -> do
+          withPage $ test "once" \p -> do
-          errF <- forkAff $ Pup.Page.Event.once Pup.Page.Event.PageError p
+            errF <- forkAff $ Pup.Page.Event.once Pup.Page.Event.PageError p
-          _ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline Pup.Page.Script scriptError) p
+            _ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline scriptError) p
-          err <- joinFiber errF
+            err <- joinFiber errF
-          Error.message err `shouldEqual` "eek!"
+            Error.message err `shouldEqual` "eek!"
 
-        test "Console" \p -> do
+          withPage $ test "Console" \p -> failOnPageError p do
-          logF <- forkAff $ Pup.Page.Event.once Pup.Page.Event.Console p
+            logF <- forkAff $ Pup.Page.Event.once Pup.Page.Event.Console p
-          _ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline Pup.Page.Script scriptLog) p
+            _ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline scriptLog) p
-          log <- joinFiber logF
+            log <- joinFiber logF
-          ConsoleMessage.text log `shouldEqual` "beak"
+            ConsoleMessage.text log `shouldEqual` "beak"
-          ConsoleMessage.messageType log `shouldEqual` ConsoleMessage.Log
+            ConsoleMessage.messageType log `shouldEqual` ConsoleMessage.Log
+
+          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.dismiss dialog
+            void $ joinFiber script
+
+          withPage $ test "Request" \p -> failOnPageError p do
+            let
+              rep = Pup.HTTP.Request.defaultRespond
+                { body = Just (Left "console.log('hi')")
+                , contentType = Just "text/javascript"
+                }
+            let onrequest c = Pup.HTTP.Request.respond c rep
+            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
+            timeoutThrow (wrap 1000.0) $ joinFiber loadEvent
+            log' <- timeoutThrow (wrap 1000.0) $ joinFiber log
+            ConsoleMessage.text log' `shouldEqual` "hi"
+
+          withPage $ test "DomContentLoaded, Load" \p -> failOnPageError p do
+            continueST <- liftST $ ST.Ref.new false
+            let
+              rep = Pup.HTTP.Request.defaultRespond
+                { body = Just (Left "console.log('hi')")
+                , contentType = Just "text/javascript"
+                }
+            let
+              onrequest c r = do
+                untilJust do
+                  continue <- liftST $ ST.Ref.read continueST
+                  if not continue then delay $ wrap 100.0 else pure unit
+                  pure $ if continue then Just unit else Nothing
+                Pup.HTTP.Request.respond c rep r
+            requestIntercepted <- forkAff $ Pup.Page.HTTP.interceptNextRequest onrequest p
+            f <- forkAff $ Pup.Page.setContent pageRequestsJs Pup.Load p
+            domContentLoaded <- forkAff $ Pup.Page.Event.once Pup.Page.Event.DomContentLoaded p
+            loaded <- forkAff $ Pup.Page.Event.once Pup.Page.Event.Load p
+            let loaded' = timeout (wrap 100.0) $ joinFiber domContentLoaded <$ joinFiber loaded
+            let shouldBeLoaded yn = shouldEqual yn =<< map isJust loaded'
+            shouldBeLoaded false
+            _ <- liftST $ ST.Ref.write true continueST
+            timeoutThrow (wrap 100.0) $ joinFiber requestIntercepted
+            timeoutThrow (wrap 100.0) $ joinFiber f
+            shouldBeLoaded true
+
+          test "Close" \b -> do
+            p <- Pup.Page.new b
+            failOnPageError p do
+              closeF <- forkAff $ Pup.Page.Event.once Pup.Page.Event.Close p
+              Pup.Page.close p
+              joinFiber closeF

test/Puppeteer.Page.Spec.purs

@@ -15,11 +15,13 @@ import Puppeteer as Pup
 import Puppeteer.Base (timeoutThrow)
 import Puppeteer.Handle as Pup.Handle
 import Puppeteer.Handle.HTML as Pup.Handle.HTML
-import Puppeteer.Page as Pup.Page
 import Puppeteer.Keyboard as Pup.Keyboard
+import Puppeteer.Page as Pup.Page
+import Puppeteer.Browser as Pup.Browser
 import Puppeteer.Page.Event (connectPageConsole)
+import Puppeteer.Page.Event.Spec as Spec.Page.Event
 import Puppeteer.Page.WaitFor as Pup.Page.WaitFor
-import Test.Spec (SpecT, beforeAll, describe)
+import Test.Spec (SpecT, afterAll, beforeAll, beforeWith, describe)
 import Test.Spec.Assertions (shouldEqual)
 import Test.Util (failOnPageError, test)
 
@@ -74,6 +76,7 @@ inputPage =
 
 spec :: SpecT Aff Unit Effect Unit
 spec = beforeAll (Pup.launch_ =<< Pup.puppeteer unit)
+  $ afterAll Pup.Browser.close
   $ describe "Page" do
       test "new, close, isClosed" \b -> do
         p <- Pup.Page.new b
@@ -162,7 +165,7 @@ spec = beforeAll (Pup.launch_ =<< Pup.puppeteer unit)
         connectPageConsole p
         failOnPageError p do
           Pup.Page.setContent simplePage Pup.Load p
-          _ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline Pup.Page.Script scriptAddBar) p
+          _ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline scriptAddBar) p
           _ <- timeoutThrow (Milliseconds 5000.0) $ Pup.Page.WaitFor.selector "div#bar" p
           Pup.Page.close p
 
@@ -179,3 +182,5 @@ spec = beforeAll (Pup.launch_ =<< Pup.puppeteer unit)
           Pup.Keyboard.doType "foo bar bingus bat" kb
           shouldEqual "foo bar bingus bat" =<< Pup.Handle.HTML.value input'
           Pup.Page.close p
+
+      beforeWith (const $ pure unit) Spec.Page.Event.spec

test/Puppeteer.Selector.purs

@@ -0,0 +1,38 @@
+module Puppeteer.Selector.Spec where
+
+import Prelude
+
+import Data.Foldable (fold)
+import Data.Identity (Identity)
+import Data.Tuple.Nested ((/\))
+import Effect.Aff (Aff)
+import Puppeteer.Selector as S
+import Test.Spec (SpecT, describe)
+import Test.Spec.Assertions (shouldEqual)
+import Test.Util (test)
+import Web.HTML (HTMLButtonElement)
+
+spec :: SpecT Aff Unit Identity Unit
+spec = describe "Selector" do
+  test "toCSS" do
+    let isButton = identity :: forall s. S.Selector s HTMLButtonElement => s -> s
+    let
+      s = S.toCSS
+        $ isButton
+        $ S.button
+            `S.hasId` "foo"
+            `S.hasClass` "bar"
+            `S.hasAttr` "disabled"
+            `S.hasAttrContaining` ("ident" /\ "abc")
+            `S.hasAttrListContaining` ("feet" /\ "left_foot")
+            `S.hasAttrStartsWith` ("name" /\ "frank")
+            `S.hasAttrEndsWith` ("name" /\ "johnson")
+            `S.isDescendantOf` S.body
+            `S.isChildOf` S.html
+    let
+      expected = fold
+        [ "html > body button"
+        , "#foo.bar"
+        , """["disabled"]["ident"*="abc"]["feet"~="left_foot"]["name"^="frank"]["name"$="johnson"]"""
+        ]
+    s `shouldEqual` expected

test/Puppeteer.Spec.purs

@@ -2,12 +2,16 @@ module Puppeteer.Spec where
 
 import Prelude
 
+import Data.Newtype (unwrap)
 import Effect (Effect)
 import Effect.Aff (Aff)
 import Effect.Class (liftEffect)
 import Puppeteer as Pup
 import Puppeteer.Browser as Pup.Browser
-import Test.Spec (SpecT, describe, parallel)
+import Puppeteer.Browser.Spec as Spec.Browser
+import Puppeteer.Page.Spec as Spec.Page
+import Puppeteer.Selector.Spec as Spec.Selector
+import Test.Spec (SpecT, describe, mapSpecTree, parallel)
 import Test.Spec.Assertions (shouldEqual)
 import Test.Util (test)
 
@@ -30,3 +34,7 @@ spec = describe "Puppeteer" do
 
     b2 <- Pup.connect (Pup.connectDefault $ Pup.BrowserWebsocket ws) pup
     Pup.Browser.close b2
+
+  Spec.Browser.spec
+  Spec.Page.spec
+  mapSpecTree (pure <<< unwrap) identity Spec.Selector.spec

test/Test.Main.purs

@@ -18,7 +18,6 @@ import Node.Process as Process
 import Node.Stream as Writable
 import Puppeteer.Browser.Spec as Spec.Browser
 import Puppeteer.Page.Spec as Spec.Page
-import Puppeteer.Page.Event.Spec as Spec.Page.Event
 import Puppeteer.Spec as Spec
 import Test.Spec (SpecT)
 import Test.Spec.Config (defaultConfig)
@@ -28,17 +27,10 @@ import Test.Spec.Runner (runSpecT)
 
 foreign import errorString :: Error -> Effect String
 
-specs :: SpecT Aff Unit Effect Unit
-specs = do
-  Spec.spec
-  Spec.Browser.spec
-  Spec.Page.spec
-  Spec.Page.Event.spec
-
 main :: Effect Unit
 main = launchAff_ do
   let cfg = defaultConfig { timeout = Nothing, exit = false }
-  run <- liftEffect $ runSpecT cfg [ consoleReporter ] specs
+  run <- liftEffect $ runSpecT cfg [ consoleReporter ] Spec.spec
   res <- (map (join <<< map (foldl Array.snoc [])) run) :: Aff (Array Result)
   let
     getError = case _ of