test: test selector
This commit is contained in:
parent
ac1b2227d0
commit
7528e0d121
GPG Key ID:
6D4165AE4C928719
@ -26,6 +26,7 @@ to generate this file without the comments in this block.
|
||||
, "filterable"
|
||||
, "foldable-traversable"
|
||||
, "foreign"
|
||||
, "identity"
|
||||
, "integers"
|
||||
, "maybe"
|
||||
, "newtype"
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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)
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
@ -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
|
||||
|
||||
@ -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'
|
||||
}
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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
|
||||
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!"
|
||||
cleanup
|
||||
Pup.closeContext listening
|
||||
|
||||
test "once" \p -> do
|
||||
withPage $ 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
|
||||
_ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline scriptError) p
|
||||
err <- joinFiber errF
|
||||
Error.message err `shouldEqual` "eek!"
|
||||
|
||||
test "Console" \p -> do
|
||||
withPage $ test "Console" \p -> failOnPageError p do
|
||||
logF <- forkAff $ Pup.Page.Event.once Pup.Page.Event.Console p
|
||||
_ <- Pup.Page.addScriptTag (Pup.Page.AddScriptInline Pup.Page.Script scriptLog) 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
|
||||
|
||||
@ -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
|
||||
|
||||
38
test/Puppeteer.Selector.purs
Normal file
38
test/Puppeteer.Selector.purs
Normal file
@ -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
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user