test: test selector

2023-09-29 17:32:24 -05:00
parent ac1b2227d0
commit 7528e0d121
20 changed files with 294 additions and 147 deletions
--- a/test/Puppeteer.Browser.Spec.purs
+++ 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)

--- a/test/Puppeteer.Page.Event.Spec.purs
+++ b/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.Map as Map
-import Data.Maybe (Maybe(..))
+import Data.Either (Either(..))
+import Data.Maybe (Maybe(..), isJust)
 import Data.Newtype (wrap)
-import Data.Time.Duration (Milliseconds(..))
 import Effect (Effect)
-import Effect.Aff (Aff, forkAff, joinFiber, makeAff)
-import Effect.Class (liftEffect)
-import Effect.Exception (error)
+import Effect.Aff (Aff, delay, forkAff, joinFiber)
 import Effect.Exception as Error
+import Puppeteer (timeout)
 import Puppeteer as Pup
 import Puppeteer.Base (timeoutThrow)
-import Puppeteer.Handle as Pup.Handle
-import Puppeteer.Handle.HTML as Pup.Handle.HTML
-import Puppeteer.Keyboard as Pup.Keyboard
+import Puppeteer.Browser as Pup.Browser
+import Puppeteer.HTTP.Request as Pup.HTTP.Request
 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 Test.Spec (SpecT, afterAll, beforeAll, describe)
+import Puppeteer.Page.Event.Dialog as Dialog
+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 })
-listenIntoSTArray e p = do
-  st <- liftST $ ST.Ref.new []
+withPage :: SpecT Aff Pup.Page Effect Unit -> SpecT Aff Pup.Browser Effect Unit
+withPage =
  let
-    handle ed = do
-      eds <- liftST $ ST.Ref.read st
-      _ <- liftST $ ST.Ref.write (eds <> [ ed ]) st
-      pure unit
-  t <- Pup.Page.Event.listen e handle p
-  pure { st, cleanup: Pup.closeContext t }
+    withPage' spec' b = do
+      page <- Pup.Page.new b
+      spec' page
+      Pup.Page.close page
+  in
+    aroundWith withPage'

 spec :: SpecT Aff Unit Effect Unit
 spec =
-  beforeAll (Pup.Page.new =<< Pup.launch_ =<< Pup.puppeteer unit)
-    $ afterAll Pup.Page.close
-    $ describe "Page" do
-        test "listen, PageError" \p -> do
-          { st: errsST, cleanup } <- listenIntoSTArray Pup.Page.Event.PageError p
-          _ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline Pup.Page.Script scriptError) p
-          err <- timeoutThrow (wrap 1000.0)
-            $ untilJust do
-                errs <- liftST $ ST.Ref.read errsST
-                pure $ Array.head errs
-          Error.message err `shouldEqual` "eek!"
-          cleanup
+  beforeAll (Pup.launch_ =<< Pup.puppeteer unit)
+    $ afterAll Pup.Browser.close
+    $ do
+        describe "Event" do
+          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
+            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!"
+            Pup.closeContext listening

-        test "once" \p -> do
-          errF <- forkAff $ Pup.Page.Event.once Pup.Page.Event.PageError p
-          _ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline Pup.Page.Script scriptError) p
-          err <- joinFiber errF
-          Error.message err `shouldEqual` "eek!"
+          withPage $ test "once" \p -> do
+            errF <- forkAff $ Pup.Page.Event.once Pup.Page.Event.PageError p
+            _ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline scriptError) p
+            err <- joinFiber errF
+            Error.message err `shouldEqual` "eek!"

-        test "Console" \p -> do
-          logF <- forkAff $ Pup.Page.Event.once Pup.Page.Event.Console p
-          _ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline Pup.Page.Script scriptLog) p
-          log <- joinFiber logF
-          ConsoleMessage.text log `shouldEqual` "beak"
-          ConsoleMessage.messageType log `shouldEqual` ConsoleMessage.Log
+          withPage $ test "Console" \p -> failOnPageError p do
+            logF <- forkAff $ Pup.Page.Event.once Pup.Page.Event.Console p
+            _ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline scriptLog) p
+            log <- joinFiber logF
+            ConsoleMessage.text log `shouldEqual` "beak"
+            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
--- a/test/Puppeteer.Page.Spec.purs
+++ b/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
--- a/test/Puppeteer.Selector.purs
+++ b/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
--- a/test/Puppeteer.Spec.purs
+++ b/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
--- a/test/Test.Main.purs
+++ b/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