fix: initial commit lol

2023-09-29 00:14:09 -05:00
commit ec3e06746f
150 changed files with 245475 additions and 0 deletions
--- a/test/Puppeteer.Browser.Spec.purs
+++ b/test/Puppeteer.Browser.Spec.purs
@@ -0,0 +1,27 @@
+module Puppeteer.Browser.Spec where
+
+import Prelude
+
+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, beforeAll, describe)
+import Test.Spec.Assertions (shouldEqual, shouldNotEqual)
+import Test.Util (test, testE)
+
+spec :: SpecT Aff Unit Effect Unit
+spec = beforeAll (Pup.launch_ =<< Pup.puppeteer unit)
+  $ describe "Browser" do
+      testE "websocketEndpoint" $ shouldNotEqual "" <=< Pup.Browser.websocketEndpoint
+      testE "connected" $ shouldEqual true <=< Pup.Browser.connected
+      test "disconnect and close" $ \b -> do
+        ws <- liftEffect $ Pup.Browser.websocketEndpoint b
+        liftEffect $ Pup.Browser.disconnect b
+        connected <- liftEffect $ Pup.Browser.connected b
+        connected `shouldEqual` false
+
+        pup <- Pup.puppeteer unit
+        b' <- Pup.connect (Pup.connectDefault $ Pup.BrowserWebsocket ws) pup
+        Pup.Browser.close b'
--- a/test/Puppeteer.Page.Spec.purs
+++ b/test/Puppeteer.Page.Spec.purs
@@ -0,0 +1,179 @@
+module Puppeteer.Page.Spec where
+
+import Prelude
+
+import Control.Monad.Error.Class (liftMaybe)
+import Data.Array as Array
+import Data.Map as Map
+import Data.Maybe (Maybe(..))
+import Data.Time.Duration (Milliseconds(..))
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Effect.Class (liftEffect)
+import Effect.Exception (error)
+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.Event (connectPageConsole)
+import Puppeteer.Page.WaitFor as Pup.Page.WaitFor
+import Test.Spec (SpecT, beforeAll, describe)
+import Test.Spec.Assertions (shouldEqual)
+import Test.Util (failOnPageError, test)
+
+styleFoo :: String
+styleFoo =
+  """
+#foo {
+  width: 200px;
+}
+"""
+
+scriptAddBar :: String
+scriptAddBar =
+  """
+const bar = document.createElement('div')
+bar.id = 'bar'
+document.body.append(bar)
+"""
+
+simplePage :: String
+simplePage =
+  """
+<!DOCTYPE html>
+<html>
+  <head>
+    <title>Simple Page</title>
+  </head>
+  <body>
+    <div id="foo">
+      <p>Foo</p>
+      <p>Bar</p>
+      <p>Baz</p>
+    </div>
+    <div></div>
+  </body>
+</html>
+"""
+
+inputPage :: String
+inputPage =
+  """
+<!DOCTYPE html>
+<html>
+  <head>
+    <title>Input Page</title>
+  </head>
+  <body>
+    <input type="text"></input>
+  </body>
+</html>
+"""
+
+spec :: SpecT Aff Unit Effect Unit
+spec = beforeAll (Pup.launch_ =<< Pup.puppeteer unit)
+  $ describe "Page" do
+      test "new, close, isClosed" \b -> do
+        p <- Pup.Page.new b
+        let shouldBeClosed b' = shouldEqual b' <=< liftEffect <<< Pup.Page.isClosed $ p
+        shouldBeClosed false
+        Pup.Page.close p
+        shouldBeClosed true
+
+      test "all" \b -> do
+        let pageCountShouldBe n = shouldEqual n <=< map Array.length <<< Pup.Page.all $ b
+        pageCountShouldBe 1
+        p <- Pup.Page.new b
+        pageCountShouldBe 2
+        Pup.Page.close p
+        pageCountShouldBe 1
+
+      test "bringToFront" \b -> do
+        p <- Pup.Page.new b
+        Pup.Page.bringToFront p
+        Pup.Page.close p
+
+      test "setContent, content" \b -> do
+        p <- Pup.Page.new b
+        let html = "<html><head></head><body></body></html>"
+        Pup.Page.setContent html Pup.Load p
+        c <- Pup.Page.content p
+        c `shouldEqual` html
+        Pup.Page.close p
+
+      test "setViewport, viewport" \b -> do
+        p <- Pup.Page.new b
+        let vp = { deviceScaleFactor: Nothing
+                 , hasTouch: Nothing
+                 , height: 1200
+                 , width: 800
+                 , isLandscape: Nothing
+                 , isMobile: Nothing
+                 }
+
+        Pup.Page.setViewport vp p
+        vp' <- liftMaybe (error "no viewport!") $ Pup.Page.viewport p
+        vp' `shouldEqual` vp
+
+      test "title" \b -> do
+        p <- Pup.Page.new b
+        Pup.Page.setContent simplePage Pup.Load p
+        shouldEqual "Simple Page" =<< Pup.Page.title p
+
+      test "url" \b -> do
+        p <- Pup.Page.new b
+        url <- liftEffect $ Pup.Page.url p
+        url `shouldEqual` "about:blank"
+
+      test "findAll" \b -> do
+        p <- Pup.Page.new b
+        Pup.Page.setContent simplePage Pup.Load p
+        let selectorCountShouldBe s n = shouldEqual n =<< Array.length <$> Pup.Page.findAll s p
+        selectorCountShouldBe "div" 2
+        selectorCountShouldBe "div#foo" 1
+
+      test "findFirst" \b -> do
+        p <- Pup.Page.new b
+        Pup.Page.setContent simplePage Pup.Load p
+        let maybeNoDivs = liftMaybe (error "no divs!")
+        div <- maybeNoDivs =<< Array.head <$> Pup.Page.findAll "div" p
+        divFF <- maybeNoDivs =<< Pup.Page.findFirst "div" p
+        isEq <- Pup.Handle.HTML.equals div divFF
+        shouldEqual isEq true
+
+      test "addStyleTag" \b -> do
+        p <- Pup.Page.new b
+        connectPageConsole p
+        failOnPageError p do
+          Pup.Page.setContent simplePage Pup.Load p
+          _ <- Pup.Page.addStyleTag (Pup.Page.AddStyleInline styleFoo) p
+          foo <- liftMaybe (error "#foo not found") =<< Pup.Page.findFirst "div#foo" p
+          style <- Pup.Handle.HTML.computedStyle foo
+          width <- liftMaybe (error "#foo doesn't have width") $ Map.lookup "width" style
+          width `shouldEqual` "200px"
+          Pup.Page.close p
+
+      test "addScriptTag" \b -> do
+        p <- Pup.Page.new b
+        connectPageConsole p
+        failOnPageError p do
+          Pup.Page.setContent simplePage Pup.Load p
+          _ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline Pup.Page.Script scriptAddBar) p
+          _ <- timeoutThrow (Milliseconds 5000.0) $ Pup.Page.WaitFor.selector "div#bar" p
+          Pup.Page.close p
+
+      test "keyboard" \b -> do
+        p <- Pup.Page.new b
+        connectPageConsole p
+        failOnPageError p do
+          Pup.Page.setContent inputPage Pup.Load p
+          input <- liftMaybe (error "no inputs!") =<< Pup.Page.findFirst "input" p
+          input' <- liftMaybe (error "not an input!") =<< Pup.Handle.HTML.toHTMLInputElement input
+          shouldEqual "" =<< Pup.Handle.HTML.value input'
+          Pup.Handle.focus input
+          kb <- liftEffect $ Pup.Page.keyboard p
+          Pup.Keyboard.doType "foo bar bingus bat" kb
+          shouldEqual "foo bar bingus bat" =<< Pup.Handle.HTML.value input'
+          Pup.Page.close p
--- a/test/Puppeteer.Spec.purs
+++ b/test/Puppeteer.Spec.purs
@@ -0,0 +1,32 @@
+module Puppeteer.Spec where
+
+import Prelude
+
+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 Test.Spec.Assertions (shouldEqual)
+import Test.Util (test)
+
+spec :: SpecT Aff Unit Effect Unit
+spec = describe "Puppeteer" do
+  test "launch" do
+    pup <- Pup.puppeteer unit
+    map void Pup.launch_ pup
+
+  test "connect" do
+    pup <- Pup.puppeteer unit
+
+    b1 <- Pup.launch_ pup
+    ws <- liftEffect $ Pup.Browser.websocketEndpoint b1
+
+    liftEffect do
+      shouldEqual true <=< Pup.Browser.connected $ b1
+      Pup.Browser.disconnect b1
+      shouldEqual false <=< Pup.Browser.connected $ b1
+
+    b2 <- Pup.connect (Pup.connectDefault $ Pup.BrowserWebsocket ws) pup
+    Pup.Browser.close b2
--- a/test/Test.Main.js
+++ b/test/Test.Main.js
@@ -0,0 +1,2 @@
+/** @type {(_: Error) => () => string} */
+export const errorString = e => () => e.toString()
--- a/test/Test.Main.purs
+++ b/test/Test.Main.purs
@@ -0,0 +1,53 @@
+module Test.Main where
+
+import Prelude
+
+import Data.Array as Array
+import Data.Filterable (filterMap)
+import Data.Foldable (findMap, fold, foldl)
+import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Traversable (traverse)
+import Effect (Effect, foreachE)
+import Effect.Aff (Aff, launchAff_)
+import Effect.Class (liftEffect)
+import Effect.Console as Console
+import Effect.Exception (Error)
+import Effect.Exception as Error
+import Node.Encoding (Encoding(..))
+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.Spec as Spec
+import Test.Spec (SpecT)
+import Test.Spec.Config (defaultConfig)
+import Test.Spec.Reporter (consoleReporter)
+import Test.Spec.Result (Result(..))
+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
+
+main :: Effect Unit
+main = launchAff_ do
+  let cfg = defaultConfig { timeout = Nothing, exit = false }
+  run <- liftEffect $ runSpecT cfg [ consoleReporter ] specs
+  res <- (map (join <<< map (foldl Array.snoc [])) run) :: Aff (Array Result)
+  let
+    getError = case _ of
+      Failure e -> Just e
+      _ -> Nothing
+  let errs = filterMap getError res
+  liftEffect $ foreachE errs \e -> do
+    _ <- Writable.writeString Process.stdout UTF8 $ Error.message e
+    _ <- Writable.writeString Process.stdout UTF8 "\n"
+    _ <- Writable.writeString Process.stdout UTF8 $ fromMaybe "" $ Error.stack e
+    _ <- Writable.writeString Process.stdout UTF8 "\n"
+    pure unit
+
+  liftEffect $ Process.exit
--- a/test/Test.Util.purs
+++ b/test/Test.Util.purs
@@ -0,0 +1,34 @@
+module Test.Util where
+
+import Prelude
+
+import Control.Alt ((<|>))
+import Control.Monad.Error.Class (liftEither, try)
+import Control.Parallel (parallel, sequential)
+import Data.Either (Either(..))
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Effect.Aff.Class (class MonadAff, liftAff)
+import Effect.Class (class MonadEffect, liftEffect)
+import Puppeteer as Pup
+import Puppeteer.Page.Event as Pup.Page.Event
+import Test.Spec (class Example, SpecT, hoistSpec, it)
+
+test_ :: forall m t arg g g'. Monad m => Example t arg g' => (g' ~> g) -> String -> t -> SpecT g arg m Unit
+test_ gaff s t = hoistSpec identity (\_ -> gaff) $ it s t
+
+test :: forall m t arg g. Monad m => Example t arg g => String -> t -> SpecT g arg m Unit
+test = test_ identity
+
+testE :: forall m t arg g. MonadEffect g => Monad m => Example t arg Effect => String -> t -> SpecT g arg m Unit
+testE = test_ liftEffect
+
+testA :: forall m t arg g. MonadAff g => Monad m => Example t arg Aff => String -> t -> SpecT g arg m Unit
+testA = test_ liftAff
+
+failOnPageError :: forall a. Pup.Page -> Aff a -> Aff a
+failOnPageError p a = let
+    ok = parallel $ try a
+    err = parallel $ Left <$> Pup.Page.Event.once Pup.Page.Event.PageError p
+  in
+    liftEither =<< (sequential $ ok <|> err)