From 7528e0d12194e750f5e6b6f1d71d471c2e2255bd Mon Sep 17 00:00:00 2001 From: Orion Kindel Date: Fri, 29 Sep 2023 17:32:24 -0500 Subject: [PATCH] test: test selector --- spago.dhall | 1 + src/Puppeteer.Base.purs | 7 +- src/Puppeteer.Http.purs | 2 +- src/Puppeteer.Page.Event.ConsoleMessage.purs | 3 +- src/Puppeteer.Page.Event.purs | 6 +- ...uest.js => Puppeteer.Page.HTTP.Request.js} | 0 ....purs => Puppeteer.Page.HTTP.Request.purs} | 34 +++- ...nse.js => Puppeteer.Page.HTTP.Response.js} | 0 ...purs => Puppeteer.Page.HTTP.Response.purs} | 2 +- ...er.Page.Http.js => Puppeteer.Page.HTTP.js} | 0 ...age.Http.purs => Puppeteer.Page.HTTP.purs} | 19 ++- src/Puppeteer.Page.Navigate.purs | 26 +-- src/Puppeteer.Page.purs | 40 +++-- src/Puppeteer.Selector.purs | 71 ++++---- test/Puppeteer.Browser.Spec.purs | 2 +- test/Puppeteer.Page.Event.Spec.purs | 159 ++++++++++++------ test/Puppeteer.Page.Spec.purs | 11 +- test/Puppeteer.Selector.purs | 38 +++++ test/Puppeteer.Spec.purs | 10 +- test/Test.Main.purs | 10 +- 20 files changed, 294 insertions(+), 147 deletions(-) rename src/{Puppeteer.Page.Http.Request.js => Puppeteer.Page.HTTP.Request.js} (100%) rename src/{Puppeteer.Page.Http.Request.purs => Puppeteer.Page.HTTP.Request.purs} (73%) rename src/{Puppeteer.Page.Http.Response.js => Puppeteer.Page.HTTP.Response.js} (100%) rename src/{Puppeteer.Page.Http.Response.purs => Puppeteer.Page.HTTP.Response.purs} (95%) rename src/{Puppeteer.Page.Http.js => Puppeteer.Page.HTTP.js} (100%) rename src/{Puppeteer.Page.Http.purs => Puppeteer.Page.HTTP.purs} (83%) create mode 100644 test/Puppeteer.Selector.purs diff --git a/spago.dhall b/spago.dhall index 260fe2e..847fd92 100644 --- a/spago.dhall +++ b/spago.dhall @@ -26,6 +26,7 @@ to generate this file without the comments in this block. , "filterable" , "foldable-traversable" , "foreign" + , "identity" , "integers" , "maybe" , "newtype" diff --git a/src/Puppeteer.Base.purs b/src/Puppeteer.Base.purs index 5a4ffed..75f23ab 100644 --- a/src/Puppeteer.Base.purs +++ b/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 diff --git a/src/Puppeteer.Http.purs b/src/Puppeteer.Http.purs index 5f67a7b..e76bbf9 100644 --- a/src/Puppeteer.Http.purs +++ b/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 diff --git a/src/Puppeteer.Page.Event.ConsoleMessage.purs b/src/Puppeteer.Page.Event.ConsoleMessage.purs index 707dd90..9c5a5a0 100644 --- a/src/Puppeteer.Page.Event.ConsoleMessage.purs +++ b/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 diff --git a/src/Puppeteer.Page.Event.purs b/src/Puppeteer.Page.Event.purs index abd7ea1..db7cd2b 100644 --- a/src/Puppeteer.Page.Event.purs +++ b/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" diff --git a/src/Puppeteer.Page.Http.Request.js b/src/Puppeteer.Page.HTTP.Request.js similarity index 100% rename from src/Puppeteer.Page.Http.Request.js rename to src/Puppeteer.Page.HTTP.Request.js diff --git a/src/Puppeteer.Page.Http.Request.purs b/src/Puppeteer.Page.HTTP.Request.purs similarity index 73% rename from src/Puppeteer.Page.Http.Request.purs rename to src/Puppeteer.Page.HTTP.Request.purs index 6130d23..6a89bf6 100644 --- a/src/Puppeteer.Page.Http.Request.purs +++ b/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) diff --git a/src/Puppeteer.Page.Http.Response.js b/src/Puppeteer.Page.HTTP.Response.js similarity index 100% rename from src/Puppeteer.Page.Http.Response.js rename to src/Puppeteer.Page.HTTP.Response.js diff --git a/src/Puppeteer.Page.Http.Response.purs b/src/Puppeteer.Page.HTTP.Response.purs similarity index 95% rename from src/Puppeteer.Page.Http.Response.purs rename to src/Puppeteer.Page.HTTP.Response.purs index e1506f4..32af9ef 100644 --- a/src/Puppeteer.Page.Http.Response.purs +++ b/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 diff --git a/src/Puppeteer.Page.Http.js b/src/Puppeteer.Page.HTTP.js similarity index 100% rename from src/Puppeteer.Page.Http.js rename to src/Puppeteer.Page.HTTP.js diff --git a/src/Puppeteer.Page.Http.purs b/src/Puppeteer.Page.HTTP.purs similarity index 83% rename from src/Puppeteer.Page.Http.purs rename to src/Puppeteer.Page.HTTP.purs index b1f12cf..4a4ee39 100644 --- a/src/Puppeteer.Page.Http.purs +++ b/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 p cb = do +interceptNextRequest :: (Context InterceptRequestsHint -> Request -> Aff Unit) -> Page -> Aff Unit +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 diff --git a/src/Puppeteer.Page.Navigate.purs b/src/Puppeteer.Page.Navigate.purs index 5fa5429..e649025 100644 --- a/src/Puppeteer.Page.Navigate.purs +++ b/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 _back :: 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 _forward :: 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 _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 diff --git a/src/Puppeteer.Page.purs b/src/Puppeteer.Page.purs index 447f8b6..d1cb092 100644 --- a/src/Puppeteer.Page.purs +++ b/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 - | AddScriptLocal ScriptType FilePath - | AddScriptRemote ScriptType URL + = AddScriptInline String + | AddScriptLocal FilePath + | 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 - { type: prepareScriptType type' +prepareAddScript (AddScriptInline content') = writeImpl + { type: undefined , content: content' } -prepareAddScript (AddScriptLocal type' path) = writeImpl - { type: prepareScriptType type' +prepareAddScript (AddScriptLocal path) = writeImpl + { type: undefined , path } -prepareAddScript (AddScriptRemote type' url') = writeImpl - { type: prepareScriptType type' +prepareAddScript (AddScriptRemote url') = writeImpl + { 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' } diff --git a/src/Puppeteer.Selector.purs b/src/Puppeteer.Selector.purs index 901a078..648d4a8 100644 --- a/src/Puppeteer.Selector.purs +++ b/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 - toCSS (HavingId id s) = toCSS s <> "#" <> id - toCSS (HavingClass cls s) = toCSS s <> "." <> cls - toCSS (HavingAttrEqualTo k v s) = toCSS s <> "[" <> k <> "=" <> v <> "]" - toCSS (HavingAttrListContaining k v s) = toCSS s <> "[" <> k <> "~=" <> v <> "]" - toCSS (HavingAttrStartsWith k v s) = toCSS s <> "[" <> k <> "^=" <> v <> "]" - toCSS (HavingAttrEndsWith k v s) = toCSS s <> "[" <> k <> "$=" <> v <> "]" - toCSS (HavingAttrContaining k v s) = toCSS s <> "[" <> k <> "*=" <> v <> "]" - toCSS (HavingAttr k s) = toCSS s <> "[" <> k <> "]" +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 <> "]" 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 - = HavingId String a - | HavingClass String a - | HavingAttrEqualTo String String a - | HavingAttrListContaining String String a - | HavingAttrStartsWith String String a - | HavingAttrEndsWith String String a - | HavingAttrContaining String String a - | HavingAttr String a +data Has a + = HasId a String + | HasClass a String + | HasAttrEqualTo a String String + | HasAttrListContaining a String String + | HasAttrStartsWith a String String + | HasAttrEndsWith a String String + | HasAttrContaining a String String + | 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 -havingId = HavingId +hasId :: forall a. a -> String -> Has a +hasId = HasId -havingClass :: forall a. String -> a -> Having a -havingClass = HavingClass +hasClass :: forall a. a -> String -> Has a +hasClass = HasClass -havingAttrEqualTo :: forall a. String -> String -> a -> Having a -havingAttrEqualTo = HavingAttrEqualTo +hasAttrEqualTo :: forall a. a -> Tuple String String -> Has a +hasAttrEqualTo a (Tuple b c) = HasAttrEqualTo a b c -havingAttrListContaining :: forall a. String -> String -> a -> Having a -havingAttrListContaining = HavingAttrListContaining +hasAttrListContaining :: forall a. a -> Tuple String String -> Has a +hasAttrListContaining a (Tuple b c) = HasAttrListContaining a b c -havingAttrStartsWith :: forall a. String -> String -> a -> Having a -havingAttrStartsWith = HavingAttrStartsWith +hasAttrStartsWith :: forall a. a -> Tuple String String -> Has a +hasAttrStartsWith a (Tuple b c) = HasAttrStartsWith a b c -havingAttrEndsWith :: forall a. String -> String -> a -> Having a -havingAttrEndsWith = HavingAttrEndsWith +hasAttrEndsWith :: forall a. a -> Tuple String String -> Has a +hasAttrEndsWith a (Tuple b c) = HasAttrEndsWith a b c -havingAttrContaining :: forall a. String -> String -> a -> Having a -havingAttrContaining = HavingAttrContaining +hasAttrContaining :: forall a. a -> Tuple String String -> Has a +hasAttrContaining a (Tuple b c) = HasAttrContaining a b c -havingAttr :: forall a. String -> a -> Having a -havingAttr = HavingAttr +hasAttr :: forall a. a -> String -> Has a +hasAttr a b = HasAttr a b diff --git a/test/Puppeteer.Browser.Spec.purs b/test/Puppeteer.Browser.Spec.purs index 03ab83e..733ae6c 100644 --- 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) diff --git a/test/Puppeteer.Page.Event.Spec.purs b/test/Puppeteer.Page.Event.Spec.purs index 9423c89..64501dd 100644 --- 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 = + """ + + + + + + +""" + +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 diff --git a/test/Puppeteer.Page.Spec.purs b/test/Puppeteer.Page.Spec.purs index 9915f22..d71474e 100644 --- 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 diff --git a/test/Puppeteer.Selector.purs b/test/Puppeteer.Selector.purs new file mode 100644 index 0000000..0ee8bef --- /dev/null +++ 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 diff --git a/test/Puppeteer.Spec.purs b/test/Puppeteer.Spec.purs index 21921a1..24cb101 100644 --- 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 diff --git a/test/Test.Main.purs b/test/Test.Main.purs index e88408b..ea2ffd8 100644 --- 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