diff --git a/src/Puppeteer.Handle.js b/src/Puppeteer.Handle.js index 4366a2e..3b79e6f 100644 --- a/src/Puppeteer.Handle.js +++ b/src/Puppeteer.Handle.js @@ -3,19 +3,6 @@ import { ElementHandle } from 'puppeteer' import { JSHandle } from 'puppeteer' -/** @type {(_: { remoteObject: (_0: string) => T, primitive: (_0: unknown) => T }) => (_: JSHandle) => () => 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) => Promise>>} */ export const _find = s => h => h.$$(s) @@ -28,9 +15,6 @@ export const _boundingBox = h => h.boundingBox() /** @type {(_: ElementHandle) => Promise} */ export const _boxModel = h => h.boxModel() -/** @type {(_: ElementHandle) => Promise} */ -export const _focus = h => h.focus() - /** @type {(_: ElementHandle) => Promise} */ export const _hover = h => h.hover() @@ -43,9 +27,6 @@ export const _isVisible = h => h.isVisible() /** @type {(_: ElementHandle) => Promise} */ export const _isIntersectingViewport = h => h.isIntersectingViewport() -/** @type {(_: ElementHandle | {x: number, y: number}) => (_: ElementHandle) => Promise} */ -export const _drag = c => h => h.drag(c).then(() => {}) - /** @type {(_: ElementHandle) => (_: ElementHandle) => Promise} */ export const _drop = from => to => to.drop(from) diff --git a/src/Puppeteer.Handle.purs b/src/Puppeteer.Handle.purs index 75ba53d..5c8966a 100644 --- a/src/Puppeteer.Handle.purs +++ b/src/Puppeteer.Handle.purs @@ -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 diff --git a/src/Puppeteer.Screenshot.purs b/src/Puppeteer.Screenshot.purs index 486997e..03d68cb 100644 --- a/src/Puppeteer.Screenshot.purs +++ b/src/Puppeteer.Screenshot.purs @@ -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 diff --git a/src/Puppeteer.Selector.purs b/src/Puppeteer.Selector.purs index 648d4a8..6a02bea 100644 --- a/src/Puppeteer.Selector.purs +++ b/src/Puppeteer.Selector.purs @@ -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 diff --git a/src/Puppeteer.purs b/src/Puppeteer.purs index 37c7a92..ee542d6 100644 --- a/src/Puppeteer.purs +++ b/src/Puppeteer.purs @@ -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 diff --git a/test/Puppeteer.Handle.Spec.purs b/test/Puppeteer.Handle.Spec.purs new file mode 100644 index 0000000..1d871eb --- /dev/null +++ b/test/Puppeteer.Handle.Spec.purs @@ -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 = + """ + + + Handle test + + + +
+ + + + + +
+ Hello, world! + +
+
+
+
+
+ + +""" + +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 diff --git a/test/Puppeteer.Selector.purs b/test/Puppeteer.Selector.Spec.purs similarity index 69% rename from test/Puppeteer.Selector.purs rename to test/Puppeteer.Selector.Spec.purs index 0ee8bef..08c85f2 100644 --- a/test/Puppeteer.Selector.purs +++ b/test/Puppeteer.Selector.Spec.purs @@ -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 diff --git a/test/Puppeteer.Spec.purs b/test/Puppeteer.Spec.purs index 24cb101..68908d1 100644 --- a/test/Puppeteer.Spec.purs +++ b/test/Puppeteer.Spec.purs @@ -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 diff --git a/test/Test.Main.purs b/test/Test.Main.purs index ea2ffd8..2511673 100644 --- a/test/Test.Main.purs +++ b/test/Test.Main.purs @@ -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(..))