test: finish Puppeteer.Handle.Spec

This commit is contained in:
orion 2023-09-29 22:33:55 -05:00
parent 7528e0d121
commit e3eb4924d0
Signed by: orion
GPG Key ID: 6D4165AE4C928719
9 changed files with 291 additions and 84 deletions

View File

@ -3,19 +3,6 @@
import { ElementHandle } from 'puppeteer'
import { JSHandle } from 'puppeteer'
/** @type {<T>(_: { remoteObject: (_0: string) => T, primitive: (_0: unknown) => T }) => (_: JSHandle<unknown>) => () => T} */
export const _id =
({ remoteObject, primitive }) =>
h =>
() => {
const oid = h.remoteObject().objectId
if (oid) {
return remoteObject(oid)
} else {
return primitive(h.remoteObject().value)
}
}
/** @type {(_: string) => (_: ElementHandle<HTMLElement>) => Promise<Array<ElementHandle<Node>>>} */
export const _find = s => h => h.$$(s)
@ -28,9 +15,6 @@ export const _boundingBox = h => h.boundingBox()
/** @type {(_: ElementHandle<HTMLElement>) => Promise<unknown>} */
export const _boxModel = h => h.boxModel()
/** @type {(_: ElementHandle<HTMLElement>) => Promise<void>} */
export const _focus = h => h.focus()
/** @type {(_: ElementHandle<HTMLElement>) => Promise<void>} */
export const _hover = h => h.hover()
@ -43,9 +27,6 @@ export const _isVisible = h => h.isVisible()
/** @type {(_: ElementHandle<HTMLElement>) => Promise<boolean>} */
export const _isIntersectingViewport = h => h.isIntersectingViewport()
/** @type {(_: ElementHandle<HTMLElement> | {x: number, y: number}) => (_: ElementHandle<HTMLElement>) => Promise<void>} */
export const _drag = c => h => h.drag(c).then(() => {})
/** @type {(_: ElementHandle<HTMLElement>) => (_: ElementHandle<HTMLElement>) => Promise<void>} */
export const _drop = from => to => to.drop(from)

View File

@ -1,20 +1,15 @@
module Puppeteer.Handle
( module X
, id
, HandleId(..)
, findOne
, findFirst
, findAll
, click
, clone
, boundingBox
, boxModel
, focus
, hover
, isHidden
, isVisible
, isIntersectingViewport
, dragToElement
, dragToPoint
, drop
, screenshot
, scrollIntoView
@ -34,24 +29,19 @@ import Control.Promise as Promise
import Data.Array (head)
import Data.Map (Map)
import Data.Maybe (Maybe(..))
import Data.Maybe as Maybe
import Data.Nullable (Nullable)
import Data.Nullable as Nullable
import Data.Time (Millisecond)
import Effect (Effect)
import Effect.Aff (Aff)
import Foreign (Foreign, unsafeToForeign)
import Node.Buffer (Buffer)
import Node.Path (FilePath)
import Partial.Unsafe (unsafePartial)
import Puppeteer.Base (Handle) as X
import Puppeteer.Base (class IsElement, Handle)
import Puppeteer.Cartesian (Coord, BoxModel, BoundingBox)
import Puppeteer.Cartesian (Coord)
import Puppeteer.Eval as Eval
import Puppeteer.FFI as FFI
import Puppeteer.Keyboard (Key)
import Puppeteer.Screenshot (ScreenshotOptions, prepareScreenshotOptions)
import Puppeteer.Screenshot as Screenshot
import Puppeteer.Selector (class Selector)
import Puppeteer.Selector as Selector
import Simple.JSON (class ReadForeign, class WriteForeign, writeJSON)
@ -59,33 +49,14 @@ import Unsafe.Coerce (unsafeCoerce)
import Web.HTML (HTMLElement)
import Web.HTML as HTML
id :: forall a. Handle a -> Effect HandleId
id = _id { remoteObject: HandleObject, primitive: HandlePrimitive }
data HandleId
= HandleObject String
| HandlePrimitive Foreign
instance eqHandleId :: Eq HandleId where
eq (HandleObject ida) (HandleObject idb) = ida == idb
eq (HandlePrimitive va) (HandlePrimitive vb) = writeJSON va == writeJSON vb
eq _ _ = false
instance showHandleId :: Show HandleId where
show (HandleObject ida) = "HandleObject " <> show ida
show (HandlePrimitive va) = "HandlePrimitive " <> (show $ writeJSON va)
foreign import _id :: forall a. { remoteObject :: String -> HandleId, primitive :: Foreign -> HandleId } -> Handle a -> Effect HandleId
foreign import _find :: forall a b. String -> Handle a -> Promise (Array (Handle b))
foreign import _click :: forall a. Handle a -> Promise Unit
foreign import _boundingBox :: forall a. Handle a -> Promise (Nullable Foreign)
foreign import _boxModel :: forall a. Handle a -> Promise (Nullable Foreign)
foreign import _focus :: forall a. Handle a -> Promise Unit
foreign import _hover :: forall a. Handle a -> Promise Unit
foreign import _isHidden :: forall a. Handle a -> Promise Boolean
foreign import _isVisible :: forall a. Handle a -> Promise Boolean
foreign import _isIntersectingViewport :: forall a. Handle a -> Promise Boolean
foreign import _drag :: forall a. Foreign -> Handle a -> Promise Unit
foreign import _drop :: forall a b. Handle a -> Handle b -> Promise Unit
foreign import _screenshot :: forall a. Foreign -> Handle a -> Promise Buffer
foreign import _scrollIntoView :: forall a. Handle a -> Promise Unit
@ -99,8 +70,8 @@ foreign import _getProperties :: forall a. Handle a -> Promise (Array { k :: Str
clone :: forall a. WriteForeign a => ReadForeign a => Handle a -> Aff a
clone = Promise.toAff <<< _clone
findOne :: forall a b sel. IsElement a => Selector sel b => sel -> Handle a -> Aff (Maybe (Handle b))
findOne q h = do
findFirst :: forall a b sel. IsElement a => Selector sel b => sel -> Handle a -> Aff (Maybe (Handle b))
findFirst q h = do
els <- findAll q h
pure $ head els
@ -116,9 +87,6 @@ boundingBox = map Nullable.toMaybe <<< Promise.toAff <<< _boundingBox
boxModel :: forall a. IsElement a => Handle a -> Aff (Maybe Foreign)
boxModel = map Nullable.toMaybe <<< Promise.toAff <<< _boxModel
focus :: forall a. IsElement a => Handle a -> Aff Unit
focus = Promise.toAff <<< _focus
hover :: forall a. IsElement a => Handle a -> Aff Unit
hover = Promise.toAff <<< _hover
@ -131,12 +99,6 @@ isVisible = Promise.toAff <<< _isVisible
isIntersectingViewport :: forall a. IsElement a => Handle a -> Aff Boolean
isIntersectingViewport = Promise.toAff <<< _isIntersectingViewport
dragToPoint :: forall a. IsElement a => Coord -> Handle a -> Aff Unit
dragToPoint c = Promise.toAff <<< _drag (unsafeToForeign $ c)
dragToElement :: forall a b. IsElement a => IsElement b => Handle a -> Handle b -> Aff Unit
dragToElement from to = Promise.toAff $ _drag (unsafeToForeign from) to
drop :: forall a b. IsElement a => IsElement b => Handle a -> Handle b -> Aff Unit
drop a = Promise.toAff <<< _drop a

View File

@ -1,8 +1,13 @@
module Puppeteer.Screenshot (ScreenshotFormat(..), ScreenshotOptions, prepareScreenshotOptions) where
module Puppeteer.Screenshot
( ScreenshotFormat(..)
, ScreenshotOptions
, prepareScreenshotOptions
, defaultScreenshot
) where
import Prelude
import Data.Maybe (Maybe)
import Data.Maybe (Maybe(..))
import Foreign (Foreign)
import Puppeteer.FFI as FFI
import Simple.JSON (writeImpl)
@ -30,6 +35,16 @@ type ScreenshotOptions =
, format :: Maybe ScreenshotFormat
}
defaultScreenshot :: ScreenshotOptions
defaultScreenshot =
{ captureBeyondViewport: Nothing
, fullPage: Nothing
, omitBackground: Nothing
, optimizeForSpeed: Nothing
, quality: Nothing
, format: Nothing
}
prepareScreenshotOptions :: ScreenshotOptions -> Foreign
prepareScreenshotOptions
{ captureBeyondViewport

View File

@ -19,14 +19,14 @@ instance selectorArraySel :: Selector s e => Selector (Array s) e where
toCSS = map toCSS >>> String.joinWith ", "
instance selectorHas :: Selector s e => Selector (Has s) e where
toCSS (HasId s id) = toCSS s <> "#" <> id
toCSS (HasClass s cls) = toCSS s <> "." <> cls
toCSS (HasAttrEqualTo s k v) = toCSS s <> "[" <> show k <> "=" <> show v <> "]"
toCSS (HasAttrListContaining s k v) = toCSS s <> "[" <> show k <> "~=" <> show v <> "]"
toCSS (HasAttrStartsWith s k v) = toCSS s <> "[" <> show k <> "^=" <> show v <> "]"
toCSS (HasAttrEndsWith s k v) = toCSS s <> "[" <> show k <> "$=" <> show v <> "]"
toCSS (HasAttrContaining s k v) = toCSS s <> "[" <> show k <> "*=" <> show v <> "]"
toCSS (HasAttr s k) = toCSS s <> "[" <> show k <> "]"
toCSS (HasId s' id) = toCSS s' <> "#" <> id
toCSS (HasClass s' cls) = toCSS s' <> "." <> cls
toCSS (HasAttrEqualTo s' k v) = toCSS s' <> "[" <> k <> " = " <> show v <> "]"
toCSS (HasAttrListContaining s' k v) = toCSS s' <> "[" <> k <> " ~= " <> show v <> "]"
toCSS (HasAttrStartsWith s' k v) = toCSS s' <> "[" <> k <> " ^= " <> show v <> "]"
toCSS (HasAttrEndsWith s' k v) = toCSS s' <> "[" <> k <> " $= " <> show v <> "]"
toCSS (HasAttrContaining s' k v) = toCSS s' <> "[" <> k <> " *= " <> show v <> "]"
toCSS (HasAttr s' k) = toCSS s' <> "[" <> k <> "]"
instance selectorSelectorRefine :: Selector s e => Selector (SelectorRefine s) e where
toCSS (SelectorActive a) = toCSS a <> ":active"
@ -263,9 +263,9 @@ instance selectorTagH6 :: Selector TagH6 HTMLHeadingElement where
toCSS _ = "h6"
--| HTMLHtmlElement
data TagHtml = TagHtml
data TagHtmlRoot = TagHtmlRoot
instance selectorTagHtml :: Selector TagHtml HTMLHtmlElement where
instance selectorTagHtmlRoot :: Selector TagHtmlRoot HTMLHtmlElement where
toCSS _ = "html"
--| HTMLIFrameElement
@ -502,12 +502,32 @@ data TagVideo = TagVideo
instance selectorTagVideo :: Selector TagVideo HTMLVideoElement where
toCSS _ = "video"
--| HTMLElement
data TagHtml
= TagI
| TagB
| TagS
instance selectorTagHtml :: Selector TagHtml HTMLElement where
toCSS TagI = "i"
toCSS TagB = "b"
toCSS TagS = "s"
wild :: TagWild
wild = TagWild
none :: TagNone
none = TagNone
i :: TagHtml
i = TagI
b :: TagHtml
b = TagB
s :: TagHtml
s = TagS
anchor :: TagAnchor
anchor = TagAnchor
@ -571,8 +591,8 @@ h5 = TagH5
h6 :: TagH6
h6 = TagH6
html :: TagHtml
html = TagHtml
html :: TagHtmlRoot
html = TagHtmlRoot
iframe :: TagIFrame
iframe = TagIFrame

View File

@ -24,7 +24,8 @@ import Effect.Aff (Aff)
import Effect.Unsafe (unsafePerformEffect)
import Foreign (Foreign)
import Puppeteer.Base (Puppeteer)
import Puppeteer.Base (class BrowserAccess, class IsElement, class PageProducer, class Plugin, Browser, BrowserContext, Context(..), Frame, Handle, Keyboard, LifecycleEvent(..), Page, Puppeteer, Request, Response, URL, Viewport, closeContext, prepareLifecycleEvent, timeout, use) as X
import Puppeteer.Base as X
import Puppeteer.Screenshot as X
import Puppeteer.Browser (Browser)
import Puppeteer.Browser as Browser
import Puppeteer.FFI as FFI

View File

@ -0,0 +1,216 @@
module Puppeteer.Handle.Spec where
import Prelude
import Control.Monad.Error.Class (liftMaybe)
import Control.Monad.Rec.Class (Step(..), tailRecM)
import Data.Array as Array
import Data.Map as Map
import Data.Set as Set
import Data.Maybe (isJust)
import Data.Newtype (wrap)
import Data.Tuple.Nested ((/\))
import Effect (Effect)
import Effect.Aff (Aff, forkAff, joinFiber)
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Node.Buffer as Buffer
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
import Puppeteer.Handle.HTML as Pup.Handle.HTML
import Puppeteer.Page as Pup.Page
import Puppeteer.Page.Event as Pup.Page.Event
import Puppeteer.Page.Event.ConsoleMessage as ConsoleMessage
import Puppeteer.Selector as S
import Test.Spec (SpecT, aroundWith, describe)
import Test.Spec.Assertions (shouldEqual)
import Test.Util (failOnPageError, test)
html :: String
html =
"""
<html>
<head>
<title>Handle test</title>
<script>
document.addEventListener(
'DOMContentLoaded',
() => {
const selectme = document.querySelector('#selectme')
const clickme = document.querySelector('#clickme')
const dragme = document.querySelector('#dragme')
const dropme = document.querySelector('#dropme')
selectme.addEventListener('change', e => {
console.log('select(' + e.target.value + ')')
})
clickme.addEventListener('click', () => {
console.log('clicked!')
})
dragme.addEventListener('drag', () => {
console.log('drag')
})
dragme.addEventListener('dragend', () => {
console.log('dragend')
})
dropme.addEventListener('dragenter', e => {
e.preventDefault()
console.log('dragenter')
})
dropme.addEventListener('dragover', e => {
e.preventDefault()
console.log('dragover')
})
},
)
</script>
</head>
<body>
<div id="foo">
<input type="text" id="input-a"></input>
<input type="text" id="input-b"></input>
<input type="file" id="input-c"></input>
<select id="selectme">
<option value="foo">foo</option>
<option value="bar">bar</option>
<option value="baz">baz</option>
</select>
<button id="clickme">click me!</button>
<div id="bar">
<span class="text">Hello, world!</span>
<i style="visibility: hidden;" id="111abc222" name="frankie hobarth" cheeses="muenster cheddar brie"></i>
</div>
<div style="height: 100px; width: 100px; border: black solid 1px;" id="dragme" draggable="true"></div>
<div style="height: 100px; width: 100px; border: red solid 1px;" id="dropme"></div>
<div id="gone" style="position: fixed; top: 0; left: -100px; width: 10px; height: 10px;"></div>
</div>
</body>
</html>
"""
withPage :: SpecT Aff Pup.Page Effect Unit -> SpecT Aff Unit Effect Unit
withPage =
let
withPage' spec' _ = do
pup <- Pup.puppeteer unit
b <- Pup.launch_ pup
page <- Pup.Page.new b
failOnPageError page do
-- Pup.Page.Event.connectPageConsole page
Pup.Page.setContent html Pup.Load page
spec' page
Pup.Browser.close b
in
aroundWith withPage'
spec :: SpecT Aff Unit Effect Unit
spec = withPage $ describe "Handle" do
test "findAll" \p -> do
body <- liftMaybe (error "body not found!") =<< Pup.Page.findFirst S.body p
divs <- Pup.Handle.findAll S.div body
Array.length divs `shouldEqual` 5
let
findFirstOrHtmlEquals p = do
body <- liftMaybe (error "body not found!") =<< Pup.Page.findFirst S.body p
foo <- liftMaybe (error "div#foo not found!") =<< Pup.Handle.findFirst (S.div `S.hasId` "foo") body
firstDiv <- liftMaybe (error "no divs not found!") =<< Pup.Handle.findFirst S.div body
shouldEqual true =<< Pup.Handle.HTML.equals foo firstDiv
let
i =
S.i
`S.hasAttrStartsWith` ("id" /\ "111")
`S.hasAttrEndsWith` ("id" /\ "222")
`S.hasAttrContaining` ("id" /\ "abc")
`S.hasAttrListContaining` ("cheeses" /\ "muenster")
void $ liftMaybe (error "i not found!") =<< Pup.Handle.findFirst i body
test "findFirst" findFirstOrHtmlEquals
let
clickOrTap f p =
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
ConsoleMessage.text log' `shouldEqual` "clicked!"
test "click" $ clickOrTap Pup.Handle.click
test "tap" $ clickOrTap Pup.Handle.tap
test "clone" \p -> do
aHandle <- Pup.Eval.unsafeRunJsHandle0 "() => ({a: 1, b: 'foo', c: ['a']})" p
a <- Pup.Handle.clone aHandle
a `shouldEqual` { a: 1, b: "foo", c: [ "a" ] }
test "hover" \p -> do
body <- liftMaybe (error "body not found!") =<< Pup.Page.findFirst S.body p
shouldEqual false <=< map isJust <<< Pup.Handle.findFirst (S.hover S.button) $ body
btn <- liftMaybe (error "input not found!") =<< Pup.Handle.findFirst S.button body
Pup.Handle.hover btn
shouldEqual true <=< map isJust <<< Pup.Handle.findFirst (S.hover S.button) $ body
test "isHidden" \p -> do
body <- liftMaybe (error "body not found!") =<< Pup.Page.findFirst S.body p
shouldEqual false <=< map isJust <<< Pup.Handle.findFirst (S.hover S.button) $ body
i <- liftMaybe (error "input not found!") =<< Pup.Handle.findFirst S.i body
shouldEqual true =<< Pup.Handle.isHidden i
test "isVisible" \p -> do
body <- liftMaybe (error "body not found!") =<< Pup.Page.findFirst S.body p
shouldEqual false <=< map isJust <<< Pup.Handle.findFirst (S.hover S.button) $ body
i <- liftMaybe (error "input not found!") =<< Pup.Handle.findFirst S.i body
div <- liftMaybe (error "input not found!") =<< Pup.Handle.findFirst S.div body
shouldEqual false =<< Pup.Handle.isVisible i
shouldEqual true =<< Pup.Handle.isVisible div
test "isIntersectingViewport" \p -> do
body <- liftMaybe (error "body not found!") =<< Pup.Page.findFirst S.body p
shouldEqual false <=< map isJust <<< Pup.Handle.findFirst (S.hover S.button) $ body
foo <- liftMaybe (error "input not found!") =<< Pup.Handle.findFirst (S.div `S.hasId` "foo") body
gone <- liftMaybe (error "input not found!") =<< Pup.Handle.findFirst (S.div `S.hasId` "gone") body
shouldEqual true =<< Pup.Handle.isIntersectingViewport foo
shouldEqual false =<< Pup.Handle.isIntersectingViewport gone
test "dragToElement" \p -> do
body <- liftMaybe (error "body not found!") =<< Pup.Page.findFirst S.body p
dragme <- liftMaybe (error "dragme not found!") =<< Pup.Handle.findFirst (S.div `S.hasId` "dragme") body
dropme <- liftMaybe (error "dropme not found!") =<< Pup.Handle.findFirst (S.div `S.hasId` "dropme") body
let
collectLogs as = do
log <- Pup.Page.Event.once Pup.Page.Event.Console p
let as' = as <> [ log ]
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
(ConsoleMessage.text <$> logs') `shouldEqual` [ "drag", "dragenter", "dragover", "dragend" ]
test "screenshot" \p -> do
body <- liftMaybe (error "body not found!") =<< Pup.Page.findFirst S.body p
buf <- Pup.Handle.screenshot Pup.defaultScreenshot body
void $ liftEffect $ Buffer.size buf
test "select" \p -> 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
ConsoleMessage.text log' `shouldEqual` "select(foo)"
test "getProperties" \p -> do
o <- Pup.Eval.unsafeRunJsHandle0 "() => ({foo: 'foo', bar: 'bar', baz: 'baz'})" p
props <- Pup.Handle.getProperties o
Map.keys props `shouldEqual` Set.fromFoldable [ "foo", "bar", "baz" ]
describe "HTML" do
test "equals" findFirstOrHtmlEquals

View File

@ -19,7 +19,8 @@ spec = describe "Selector" do
let
s = S.toCSS
$ isButton
$ S.button
$
S.button
`S.hasId` "foo"
`S.hasClass` "bar"
`S.hasAttr` "disabled"
@ -29,10 +30,24 @@ spec = describe "Selector" do
`S.hasAttrEndsWith` ("name" /\ "johnson")
`S.isDescendantOf` S.body
`S.isChildOf` S.html
`S.not` (S.enabled S.none)
`S.has` (S.div `S.isChildOf` S.none)
# S.focus
# S.disabled
# S.active
let
expected = fold
[ "html > body button"
, "#foo.bar"
, """["disabled"]["ident"*="abc"]["feet"~="left_foot"]["name"^="frank"]["name"$="johnson"]"""
, """[disabled]"""
, """[ident *= "abc"]"""
, """[feet ~= "left_foot"]"""
, """[name ^= "frank"]"""
, """[name $= "johnson"]"""
, ":not(:enabled)"
, ":has( > div)"
, ":focus"
, ":disabled"
, ":active"
]
s `shouldEqual` expected

View File

@ -9,6 +9,7 @@ import Effect.Class (liftEffect)
import Puppeteer as Pup
import Puppeteer.Browser as Pup.Browser
import Puppeteer.Browser.Spec as Spec.Browser
import Puppeteer.Handle.Spec as Spec.Handle
import Puppeteer.Page.Spec as Spec.Page
import Puppeteer.Selector.Spec as Spec.Selector
import Test.Spec (SpecT, describe, mapSpecTree, parallel)
@ -37,4 +38,5 @@ spec = describe "Puppeteer" do
Spec.Browser.spec
Spec.Page.spec
Spec.Handle.spec
mapSpecTree (pure <<< unwrap) identity Spec.Selector.spec

View File

@ -4,22 +4,17 @@ import Prelude
import Data.Array as Array
import Data.Filterable (filterMap)
import Data.Foldable (findMap, fold, foldl)
import Data.Foldable (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(..))