git.iko.soy/rowtype-yoga/purescript-lunapark
on main help sign in
...
ea22a90Maxim Zimaliev
src/Lunapark/API.purs+146
@@ -25,6 +25,8 @@ import Lunapark.Affjax as LA
25import Lunapark.Error as LE
25import Lunapark.Error as LE
26import Lunapark.Types as LT
26import Lunapark.Types as LT
27import Lunapark.Endpoint as LP
27import Lunapark.Endpoint as LP
28+import Node.Buffer as B
29+import Node.FS.Aff as FS
28import Network.HTTP.Affjax (AJAX)
30import Network.HTTP.Affjax (AJAX)
29import Unsafe.Coerce (unsafeCoerce)
31import Unsafe.Coerce (unsafeCoerce)
30import Run as R
32import Run as R
@@ -36,6 +38,8 @@ import Unsafe.Coerce (unsafeCoerce)
36type LunaparkEffects e =
38type LunaparkEffects e =
37 ( ajax ∷ AJAX
39 ( ajax ∷ AJAX
38 , ref ∷ Ref.REF
40 , ref ∷ Ref.REF
41+ , buffer ∷ B.BUFFER
42+ , fs ∷ FS.FS
39 | e)
43 | e)
40
44
41-- | Example
45-- | Example
@@ -94,6 +98,23 @@ data LunaparkF a
94 | MaximizeWindow a
98 | MaximizeWindow a
95 | MinimizeWindow a
99 | MinimizeWindow a
96 | FullscreenWindow a
100 | FullscreenWindow a
101+ | ExecuteScript LT.Script (J.Json → a)
102+ | ExecuteScriptAsync LT.Script (J.Json → a)
103+ | GetAllCookies (Array LT.Cookie → a)
104+ | GetCookie String (LT.Cookie → a)
105+ | DeleteCookie String a
106+ | DeleteAllCookies a
107+ | AddCookie LT.Cookie a
108+ | DismissAlert a
109+ | AcceptAlert a
110+ | GetAlertText (String → a)
111+ | SendAlertText String a
112+ | Screenshot String a
113+ | ElementScreenshot LT.Element String a
114+ | FindElement LT.Locator (LT.Element → a)
115+ | FindElements LT.Locator (Array LT.Element → a)
116+ | FindElementInElement LT.Element LT.Locator (LT.Element → a)
117+ | FindElementsInElement LT.Element LT.Locator (Array LT.Element → a)
97
118
98derive instance functorLunaparkF ∷ Functor LunaparkF
119derive instance functorLunaparkF ∷ Functor LunaparkF
99
120
@@ -102,6 +123,7 @@ type BaseRun r e = R.Run
102 , aff ∷ R.AFF (LunaparkEffects e)
123 , aff ∷ R.AFF (LunaparkEffects e)
103 , eff ∷ R.EFF (LunaparkEffects e)
124 , eff ∷ R.EFF (LunaparkEffects e)
104 | r)
125 | r)
126+
105type RunLunapark e = BaseRun (lunapark ∷ LUNAPARK) e
127type RunLunapark e = BaseRun (lunapark ∷ LUNAPARK) e
106
128
107newtype Lunapark e a = Lunapark (RunLunapark e a)
129newtype Lunapark e a = Lunapark (RunLunapark e a)
@@ -182,6 +204,57 @@ minimizeWindow = liftLunapark $ MinimizeWindow unit
182fullscreenWindow ∷ ∀ e. Lunapark e Unit
204fullscreenWindow ∷ ∀ e. Lunapark e Unit
183fullscreenWindow = liftLunapark $ FullscreenWindow unit
205fullscreenWindow = liftLunapark $ FullscreenWindow unit
184
206
207+executeScript ∷ ∀ e. LT.Script → Lunapark e J.Json
208+executeScript script = liftLunapark $ ExecuteScript script id
209+
210+executeScriptAsync ∷ ∀ e. LT.Script → Lunapark e J.Json
211+executeScriptAsync script = liftLunapark $ ExecuteScriptAsync script id
212+
213+getAllCookies ∷ ∀ e. Lunapark e (Array LT.Cookie)
214+getAllCookies = liftLunapark $ GetAllCookies id
215+
216+getCookie ∷ ∀ e. String → Lunapark e LT.Cookie
217+getCookie name = liftLunapark $ GetCookie name id
218+
219+addCookie ∷ ∀ e. LT.Cookie → Lunapark e Unit
220+addCookie cookie = liftLunapark $ AddCookie cookie unit
221+
222+deleteCookie ∷ ∀ e. String → Lunapark e Unit
223+deleteCookie name = liftLunapark $ DeleteCookie name unit
224+
225+deleteAllCookies ∷ ∀ e. Lunapark e Unit
226+deleteAllCookies = liftLunapark $ DeleteAllCookies unit
227+
228+dismissAlert ∷ ∀ e. Lunapark e Unit
229+dismissAlert = liftLunapark $ DismissAlert unit
230+
231+acceptAlert ∷ ∀ e. Lunapark e Unit
232+acceptAlert = liftLunapark $ AcceptAlert unit
233+
234+getAlertText ∷ ∀ e. Lunapark e String
235+getAlertText = liftLunapark $ GetAlertText id
236+
237+sendAlertText ∷ ∀ e. String → Lunapark e Unit
238+sendAlertText txt = liftLunapark $ SendAlertText txt unit
239+
240+screenshot ∷ ∀ e. String → Lunapark e Unit
241+screenshot fp = liftLunapark $ Screenshot fp unit
242+
243+elementScreenshot ∷ ∀ e. LT.Element → String → Lunapark e Unit
244+elementScreenshot el fp = liftLunapark $ ElementScreenshot el fp unit
245+
246+findElement ∷ ∀ e. LT.Locator → Lunapark e LT.Element
247+findElement l = liftLunapark $ FindElement l id
248+
249+findElements ∷ ∀ e. LT.Locator → Lunapark e (Array LT.Element)
250+findElements l = liftLunapark $ FindElements l id
251+
252+findElementInElement ∷ ∀ e. LT.Element → LT.Locator → Lunapark e LT.Element
253+findElementInElement el l = liftLunapark $ FindElementInElement el l id
254+
255+findElementsInElement ∷ ∀ e. LT.Element → LT.Locator → Lunapark e (Array LT.Element)
256+findElementsInElement el l = liftLunapark $ FindElementsInElement el l id
257+
185runLunapark ∷ ∀ e. String → LT.SessionId → Array LT.Capability → RunLunapark e ~> BaseRun () e
258runLunapark ∷ ∀ e. String → LT.SessionId → Array LT.Capability → RunLunapark e ~> BaseRun () e
186runLunapark uri session capabilities a = do
259runLunapark uri session capabilities a = do
187 timeoutsRef ←
260 timeoutsRef ←
@@ -301,6 +374,79 @@ handleLunapark inp = case _ of
301 FullscreenWindow next → do
374 FullscreenWindow next → do
302 _ ← post_ (inSession : LP.Window : LP.Fullscreen : Nil)
375 _ ← post_ (inSession : LP.Window : LP.Fullscreen : Nil)
303 pure next
376 pure next
377+ ExecuteScript script cont → do
378+ map cont $ withFallback "execute script"
379+ { w3c: post (inSession : LP.Execute : LP.Sync : Nil) (LT.encodeScript script)
380+ , jsonWire: post (inSession : LP.Execute : Nil) (LT.encodeScript script)
381+ }
382+ ExecuteScriptAsync script cont → do
383+ map cont $ withFallback "execute script async"
384+ { w3c: post (inSession : LP.Execute : LP.Async : Nil) (LT.encodeScript script)
385+ , jsonWire: post (inSession : LP.ExecuteAsync : Nil) (LT.encodeScript script)
386+ }
387+ GetAllCookies cont → do
388+ res ← get (inSession : LP.Cookies : Nil)
389+ map cont $ throwLeft $ T.traverse LT.decodeCookie =<< J.decodeJson res
390+ GetCookie name cont → do
391+ res ← get (inSession : LP.Cookie name : Nil)
392+ map cont $ throwLeft $ LT.decodeCookie res
393+ DeleteAllCookies next → do
394+ _ ← delete (inSession : LP.Cookies : Nil)
395+ pure next
396+ DeleteCookie name next → do
397+ _ ← delete (inSession : LP.Cookie name : Nil)
398+ pure next
399+ AddCookie cookie next → do
400+ _ ← post (inSession : LP.Cookies : Nil) (LT.encodeCookie cookie)
401+ pure next
402+ DismissAlert next → do
403+ _ ← withFallback "dismiss alert"
404+ { w3c: post_ (inSession : LP.Alert : LP.Dismiss : Nil)
405+ , jsonWire: post_ (inSession : LP.DismissAlert : Nil)
406+ }
407+ pure next
408+ AcceptAlert next → do
409+ _ ← withFallback "accept alert"
410+ { w3c: post_ (inSession : LP.Alert : LP.Accept : Nil)
411+ , jsonWire: post_ (inSession : LP.AcceptAlert : Nil)
412+ }
413+ pure next
414+ GetAlertText cont → do
415+ res ← withFallback "get alert text"
416+ { w3c: get (inSession : LP.Alert : LP.Text : Nil)
417+ , jsonWire: get (inSession : LP.AlertText : Nil)
418+ }
419+ map cont $ throwLeft $ J.decodeJson res
420+ SendAlertText str next → do
421+ _ ← withFallback "send alert text"
422+ { w3c: post (inSession : LP.Alert : LP.Text : Nil) (LT.encodeSendKeysRequest str)
423+ , jsonWire: post (inSession : LP.AlertText : Nil) (LT.encodeSendKeysRequest str)
424+ }
425+ pure next
426+ Screenshot fp next → do
427+ res ← get (inSession : LP.Screenshot : Nil)
428+ screenshotPack ← throwLeft $ LT.decodeScreenshot res
429+ buffer ← R.liftEff $ B.fromString screenshotPack.content screenshotPack.encoding
430+ R.liftAff $ FS.writeFile fp buffer
431+ pure next
432+ ElementScreenshot el fp next → do
433+ res ← get (inSession : LP.InElement el : LP.Screenshot : Nil)
434+ screenshotPack ← throwLeft $ LT.decodeScreenshot res
435+ buffer ← R.liftEff $ B.fromString screenshotPack.content screenshotPack.encoding
436+ R.liftAff $ FS.writeFile fp buffer
437+ pure next
438+ FindElement loc cont → do
439+ res ← post (inSession : LP.Element : Nil) (LT.encodeLocator loc)
440+ map cont $ throwLeft $ LT.decodeElement res
441+ FindElements loc cont → do
442+ res ← post (inSession : LP.Elements : Nil) (LT.encodeLocator loc)
443+ map cont $ throwLeft $ T.traverse LT.decodeElement =<< J.decodeJson res
444+ FindElementInElement el loc cont → do
445+ res ← post (inSession : LP.InElement el : LP.Element : Nil) (LT.encodeLocator loc)
446+ map cont $ throwLeft $ LT.decodeElement res
447+ FindElementsInElement el loc cont → do
448+ res ← post (inSession : LP.InElement el : LP.Elements : Nil) (LT.encodeLocator loc)
449+ map cont $ throwLeft $ T.traverse LT.decodeElement =<< J.decodeJson res
304
450
305 where
451 where
306 delete a = liftAndRethrow $ LP.delete inp.uri a
452 delete a = liftAndRethrow $ LP.delete inp.uri a