git.iko.soy/rowtype-yoga/purescript-lunapark
on main help sign in
Merge pull request #13 from srghma/master

update to argonaut 7 and affjax 11

commitaf9a883b960e4d52f5c2f4c53d4cd3a8a086a16a authorMaxim Zimaliev <zimaliev@gmail.com> dateThu 19 Nov 2020, 20:25 (6 years ago) parent0e294518e3918f
14 files changed+414−350
compare with main
unifiedsplit
.travis.yml+2−2 bower.json+2−2 package.json+7−7 packages.dhall+4 spago.dhall+15 src/Lunapark.purs+6−4 src/Lunapark/API.purs+80−76 src/Lunapark/ActionF.purs+17−16 src/Lunapark/Endpoint.purs+18−9 src/Lunapark/Error.purs+31−120 src/Lunapark/LunaparkF.purs+56−56 src/Lunapark/Types.purs+53−53 src/Lunapark/Utils.purs+6−5 src/Lunapark/WebDriverError.purs+117
.travis.yml+2−2
@@ -4,8 +4,8 @@ sudo: required
44node_js: stable
55install:
66 - npm install
7− - npm install -g bower
8− - bower install --production
7+ - npm install -g spago
8+ - spago install
99script:
1010 - npm run -s build
1111after_success:
bower.json+2−2
@@ -25,8 +25,8 @@
2525 "vendor"
2626 ],
2727 "dependencies": {
28− "purescript-affjax": "^9.0.0",
29− "purescript-argonaut-codecs": "^6.0.0",
28+ "purescript-affjax": "^11.0.0",
29+ "purescript-argonaut-codecs": "^7.0.0",
3030 "purescript-argonaut-core": "^5.0.0",
3131 "purescript-css": "^4.0.0",
3232 "purescript-node-fs-aff": "^6.0.0",
package.json+7−7
@@ -2,16 +2,16 @@
22 "name": "purescript-lunapark",
33 "private": true,
44 "scripts": {
5− "build": "pulp build -- --strict --stash",
6− "build:non-strict": "pulp build",
5+ "build": "spago build --purs-args '--censor-lib --strict'",
6+ "build:non-strict": "spago build",
77 "ide": "purs ide server"
88 },
99 "license": "Apache-2.0",
1010 "dependencies": {
11− "chromedriver": "^2.37.0",
12− "pulp": "^12.2.0",
13− "purescript": "^0.12.3",
14− "purescript-psa": "^0.7.3",
15− "xhr2": "^0.1.4"
11+ "chromedriver": "^86.0.0",
12+ "pulp": "^15.0.0",
13+ "purescript": "^0.13.8",
14+ "purescript-psa": "^0.8.0",
15+ "xhr2": "^0.2.0"
1616 }
1717}
packages.dhallnew file+4
@@ -0,0 +1,4 @@
1+let upstream =
2+ https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20201021/packages.dhall sha256:55ebdbda1bd6ede4d5307fbc1ef19988c80271b4225d833c8d6fb9b6fb1aa6d8
3+
4+in upstream
spago.dhallnew file+15
@@ -0,0 +1,15 @@
1+{ name = "lunapark"
2+, dependencies =
3+ [ "argonaut-core"
4+ , "argonaut-codecs"
5+ , "affjax"
6+ , "console"
7+ , "css"
8+ , "effect"
9+ , "node-fs-aff"
10+ , "psci-support"
11+ , "run"
12+ ]
13+, packages = ./packages.dhall
14+, sources = [ "src/**/*.purs" ]
15+}
src/Lunapark.purs+6−4
@@ -3,10 +3,12 @@ module Lunapark
33 , module Lunapark.Error
44 , module Lunapark.ActionF
55 , module Lunapark.LunaparkF
6+ , module Lunapark.WebDriverError
67 ) where
78
89
9−import Lunapark.API (Interpreter(..), runInterpreter, BaseRun, HandleLunaparkInput, Lunapark, handleLunapark, init, interpret, interpretW3CActions, jsonWireActions, runLunapark, runLunaparkActions, w3cActions)
10−import Lunapark.Error (Error, ErrorType(..), fromJson, fromStringCode, toStringCode, unknownError)
11−import Lunapark.ActionF (ActionF(..), LUNAPARK_ACTIONS, TouchF(..), WithAction, _lunaparkActions, buttonDown, buttonUp, click, doubleClick, doubleTap, flick, liftAction, longTap, moveTo, pause, scroll, sendKeys, tap, touchDown, touchUp)
12−import Lunapark.LunaparkF (ElementF(..), LUNAPARK, LunaparkF(..), WithLunapark, _lunapark, acceptAlert, addCookie, back, childElement, childElements, clearElement, clickElement, closeWindow, deleteAllCookies, deleteCookie, dismissAlert, elementScreenshot, executeScript, executeScriptAsync, findElement, findElements, forward, fullscreenWindow, getAlertText, getAllCookies, getAttribute, getCookie, getCss, getProperty, getRectangle, getTagName, getText, getTimeouts, getTitle, getUrl, getWindowHandle, getWindowHandles, getWindowRectangle, go, isDisplayed, isEnabled, isSelected, liftLunapark, maximizeWindow, minimizeWindow, performActions, quit, refresh, releaseActions, screenshot, sendAlertText, sendKeysElement, setTimeouts, setWindowRectangle, status, submitElement, switchToFrame, switchToParentFrame, switchToWindow)
10+import Lunapark.API (Lunapark, Interpreter(..), runInterpreter, BaseEffects, HandleLunaparkInput, handleLunapark, init, interpret, interpretW3CActions, jsonWireActions, runLunapark, runLunaparkActions, w3cActions)
11+import Lunapark.Error (Error(..), CachingError(..), printError)
12+import Lunapark.ActionF (ActionF(..), LUNAPARK_ACTIONS, TouchF(..), ActionsEffect, _lunaparkActions, buttonDown, buttonUp, click, doubleClick, doubleTap, flick, liftAction, longTap, moveTo, pause, scroll, sendKeys, tap, touchDown, touchUp)
13+import Lunapark.LunaparkF (ElementF(..), LUNAPARK, LunaparkF(..), LunaparkEffect, _lunapark, acceptAlert, addCookie, back, childElement, childElements, clearElement, clickElement, closeWindow, deleteAllCookies, deleteCookie, dismissAlert, elementScreenshot, executeScript, executeScriptAsync, findElement, findElements, forward, fullscreenWindow, getAlertText, getAllCookies, getAttribute, getCookie, getCss, getProperty, getRectangle, getTagName, getText, getTimeouts, getTitle, getUrl, getWindowHandle, getWindowHandles, getWindowRectangle, go, isDisplayed, isEnabled, isSelected, liftLunapark, maximizeWindow, minimizeWindow, performActions, quit, refresh, releaseActions, screenshot, sendAlertText, sendKeysElement, setTimeouts, setWindowRectangle, status, submitElement, switchToFrame, switchToParentFrame, switchToWindow)
14+import Lunapark.WebDriverError (WebDriverError, WebDriverErrorType(..), fromJson, fromStringCode, toStringCode)
src/Lunapark/API.purs+80−76
@@ -22,20 +22,25 @@ import Effect.Aff.Class (class MonadAff, liftAff)
2222import Effect.Class (liftEffect)
2323import Effect.Ref as Ref
2424import Foreign.Object as FO
25−import Lunapark.ActionF (_lunaparkActions, LUNAPARK_ACTIONS, ActionF(..), TouchF(..))
25+import Lunapark.ActionF (_lunaparkActions, ActionF(..), TouchF(..), ActionsEffect)
2626import Lunapark.Endpoint as LP
2727import Lunapark.Error as LE
28−import Lunapark.LunaparkF (_lunapark, LUNAPARK, ElementF(..), LunaparkF(..), performActions, findElement)
28+import Lunapark.LunaparkF (_lunapark, ElementF(..), LunaparkF(..), LunaparkEffect, performActions, findElement)
2929import Lunapark.Types as LT
30−import Lunapark.Utils (liftAndRethrow, throwLeft, catch)
30+import Lunapark.Utils (liftAndRethrow, rethrowAsJsonDecodeError, catch)
3131import Node.Buffer as B
3232import Node.FS.Aff as FS
33+import Run (Run)
3334import Run as R
3435import Run.Except (EXCEPT)
36+import Type.Row (type (+))
37+import Run.Except as RE
3538
36−newtype Interpreter r = Interpreter (Lunapark r ~> BaseRun r)
39+type Lunapark r a = Run (BaseEffects + LunaparkEffect + ActionsEffect + r) a
3740
38−runInterpreter ∷ ∀ r. Interpreter r → Lunapark r ~> BaseRun r
41+newtype Interpreter r = Interpreter (Run (BaseEffects + LunaparkEffect + ActionsEffect + r) ~> Run (BaseEffects r))
42+
43+runInterpreter ∷ ∀ r. Interpreter r → Run (BaseEffects + LunaparkEffect + ActionsEffect + r) ~> Run (BaseEffects r)
3944runInterpreter (Interpreter f) = f
4045
4146init
@@ -54,7 +59,7 @@ init uri caps = do
5459 let
5560 sessionResponse = do
5661 sessObj ← res
57− lmap LE.unknownError $ LT.decodeCreateSessionResponse sessObj
62+ lmap LE.JsonDecodeError $ LT.decodeCreateSessionResponse sessObj
5863
5964 T.for sessionResponse \{ session, capabilities } → do
6065 timeoutsRef ←
@@ -88,24 +93,24 @@ init uri caps = do
8893interpret
8994 ∷ ∀ r
9095 . HandleLunaparkInput
91− → Lunapark r
92− ~> BaseRun r
96+ → Run (BaseEffects + LunaparkEffect + ActionsEffect + r )
97+ ~> Run (BaseEffects r)
9398interpret input = runLunapark input <<< runLunaparkActions input
9499
95−
96−type Lunapark r = BaseRun (lunapark ∷ LUNAPARK, lunaparkActions ∷ LUNAPARK_ACTIONS|r)
97−
98−type BaseRun r = R.Run
100+type BaseEffects r =
99101 ( except ∷ EXCEPT LE.Error
100102 , aff ∷ R.AFF
101103 , effect ∷ R.EFFECT
102104 | r)
103105
104−runLunapark ∷ ∀ r. HandleLunaparkInput → BaseRun (lunapark ∷ LUNAPARK|r) ~> BaseRun r
106+runLunapark ∷ ∀ r. HandleLunaparkInput → Run (BaseEffects + LunaparkEffect + r) ~> Run (BaseEffects r)
105107runLunapark input = do
106108 R.interpretRec (R.on _lunapark (handleLunapark input) R.send)
107109
108−runLunaparkActions ∷ ∀ r. HandleLunaparkInput → Lunapark r ~> BaseRun (lunapark ∷ LUNAPARK|r)
110+runLunaparkActions
111+ ∷ ∀ r. HandleLunaparkInput
112+ → Run (BaseEffects + LunaparkEffect + ActionsEffect + r )
113+ ~> Run (BaseEffects + LunaparkEffect + r)
109114runLunaparkActions input
110115 | input.actionsEnabled = interpretW3CActions Nil
111116 | otherwise = R.interpretRec (R.on _lunaparkActions (jsonWireActions input) R.send)
@@ -113,8 +118,8 @@ runLunaparkActions input
113118interpretW3CActions
114119 ∷ ∀ r
115120 . List LT.ActionSequence
116− → Lunapark r
117− ~> BaseRun (lunapark ∷ LUNAPARK|r)
121+ → Run (BaseEffects + LunaparkEffect + ActionsEffect + r )
122+ ~> Run (BaseEffects + LunaparkEffect + r )
118123interpretW3CActions acc as = case R.peel as of
119124 Left la → case tag la of
120125 Left a → w3cActions acc interpretW3CActions a
@@ -130,11 +135,11 @@ w3cActions
130135 ∷ ∀ r a
131136 . List LT.ActionSequence
132137 → ( List LT.ActionSequence
133− → Lunapark r
134− ~> BaseRun (lunapark ∷ LUNAPARK|r)
138+ → Run (BaseEffects + LunaparkEffect + ActionsEffect + r )
139+ ~> Run (BaseEffects + LunaparkEffect + r)
135140 )
136− → ActionF (Lunapark r a)
137− → BaseRun (lunapark ∷ LUNAPARK|r) a
141+ → ActionF (Run (BaseEffects + LunaparkEffect + ActionsEffect + r ) a)
142+ → Run (BaseEffects + LunaparkEffect + r) a
138143w3cActions acc loop = case _ of
139144 Click btn next →
140145 let seq = [ LT.pointerDown btn, LT.pointerUp btn ]
@@ -219,7 +224,7 @@ type HandleLunaparkInput =
219224 , actionsEnabled ∷ Boolean
220225 }
221226
222−jsonWireActions ∷ ∀ r. HandleLunaparkInput → ActionF ~> BaseRun (lunapark ∷ LUNAPARK|r)
227+jsonWireActions ∷ ∀ r. HandleLunaparkInput → ActionF ~> Run (BaseEffects + LunaparkEffect + r)
223228jsonWireActions inp = case _ of
224229 Click btn next → do
225230 _ ← post (LP.Click : Nil) (LT.encodeButton btn)
@@ -232,7 +237,7 @@ jsonWireActions inp = case _ of
232237 pure next
233238 DoubleClick btn next → do
234239 _ ← case btn of
235− LT.LeftBtn → post_ (LP.DoubleClick : Nil)
240+ LT.LeftBtn → post' (LP.DoubleClick : Nil)
236241 other → do
237242 _ ← post (LP.Click : Nil) (LT.encodeButton btn)
238243 post (LP.Click : Nil) (LT.encodeButton btn)
@@ -253,16 +258,16 @@ jsonWireActions inp = case _ of
253258 pure next
254259 InTouch tch → case tch of
255260 Tap next → do
256− _ ← post_ (LP.Touch : LP.Click : Nil)
261+ _ ← post' (LP.Touch : LP.Click : Nil)
257262 pure next
258263 TouchDown next → do
259− _ ← post_ (LP.Touch : LP.Down : Nil)
264+ _ ← post' (LP.Touch : LP.Down : Nil)
260265 pure next
261266 TouchUp next → do
262− _ ← post_ (LP.Touch : LP.Up : Nil)
267+ _ ← post' (LP.Touch : LP.Up : Nil)
263268 pure next
264269 LongClick next → do
265− _ ← post_ (LP.Touch : LP.LongClick : Nil)
270+ _ ← post' (LP.Touch : LP.LongClick : Nil)
266271 pure next
267272 Flick move next → do
268273 element ← case move.origin of
@@ -281,23 +286,23 @@ jsonWireActions inp = case _ of
281286 _ ← post (LP.Touch : LP.Scroll : Nil) (LT.encodeMoveToRequest req)
282287 pure next
283288 DoubleTap next → do
284− _ ← post_ (LP.Touch : LP.DoubleClick : Nil)
289+ _ ← post' (LP.Touch : LP.DoubleClick : Nil)
285290 pure next
286291 where
287292 post a b = liftAndRethrow $ LP.post inp.uri (inSession : a) b
288− post_ a = liftAndRethrow $ LP.post_ inp.uri (inSession : a)
293+ post' a = liftAndRethrow $ LP.post' inp.uri (inSession : a)
289294
290295 inSession ∷ LP.EndpointPart
291296 inSession = LP.InSession inp.session
292297
293−handleLunapark ∷ ∀ r. HandleLunaparkInput → LunaparkF ~> BaseRun r
298+handleLunapark ∷ ∀ r. HandleLunaparkInput → LunaparkF ~> Run (BaseEffects r)
294299handleLunapark inp = case _ of
295300 Quit next → do
296301 _ ← delete $ inSession : Nil
297302 pure next
298303 Status cont → do
299304 res ← get $ LP.Status : Nil
300− ss ← throwLeft $ LT.decodeServerStatus res
305+ ss ← rethrowAsJsonDecodeError $ LT.decodeServerStatus res
301306 pure $ cont ss
302307 GetTimeouts cont → do
303308 res ← R.liftEffect $ Ref.read inp.timeoutsRef
@@ -314,31 +319,31 @@ handleLunapark inp = case _ of
314319 pure next
315320 GetUrl cont → do
316321 res ← get $ inSession : LP.Url : Nil
317− map cont $ throwLeft $ J.decodeJson res
322+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
318323 Back next → do
319− _ ← post_ (inSession : LP.Back : Nil)
324+ _ ← post' (inSession : LP.Back : Nil)
320325 pure next
321326 Forward next → do
322− _ ← post_ (inSession : LP.Forward : Nil)
327+ _ ← post' (inSession : LP.Forward : Nil)
323328 pure next
324329 Refresh next → do
325− _ ← post_ (inSession : LP.Refresh : Nil)
330+ _ ← post' (inSession : LP.Refresh : Nil)
326331 pure next
327332 GetTitle cont → do
328333 res ← get (inSession : LP.Title : Nil)
329− map cont $ throwLeft $ J.decodeJson res
334+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
330335 GetWindowHandle cont → do
331336 res ← tryAndCache "get window handle"
332337 [ get (inSession : LP.Window : Nil)
333338 , get (inSession : LP.WindowHandle : Nil)
334339 ]
335− map cont $ throwLeft $ LT.decodeWindowHandle res
340+ map cont $ rethrowAsJsonDecodeError $ LT.decodeWindowHandle res
336341 GetWindowHandles cont → do
337342 res ← tryAndCache "get window handles"
338343 [ get (inSession : LP.Window : LP.Handles : Nil)
339344 , get (inSession : LP.WindowHandles : Nil)
340345 ]
341− map cont $ throwLeft $ T.traverse LT.decodeWindowHandle =<< J.decodeJson res
346+ map cont $ rethrowAsJsonDecodeError $ T.traverse LT.decodeWindowHandle =<< J.decodeJson res
342347 CloseWindow next → do
343348 _ ← delete (inSession : LP.Window : Nil)
344349 pure next
@@ -349,15 +354,15 @@ handleLunapark inp = case _ of
349354 _ ← post (inSession : LP.Frame : Nil) (LT.encodeFrameId fid)
350355 pure next
351356 SwitchToParentFrame next → do
352− _ ← post_ (inSession : LP.Frame : LP.Parent : Nil)
357+ _ ← post' (inSession : LP.Frame : LP.Parent : Nil)
353358 pure next
354359 GetWindowRectangle cont → do
355360 res ← tryAndCache "get window rectangle"
356361 [ do res ← get (inSession : LP.Window : LP.Rect : Nil)
357− throwLeft $ LT.decodeRectangle res
362+ rethrowAsJsonDecodeError $ LT.decodeRectangle res
358363 , do position ← get (inSession : LP.Window : LP.Position : Nil)
359364 size ← get (inSession : LP.Window : LP.Size : Nil)
360− throwLeft $ LT.decodeRectangleLegacy { position, size }
365+ rethrowAsJsonDecodeError $ LT.decodeRectangleLegacy { position, size }
361366 ]
362367 pure $ cont res
363368 SetWindowRectangle r next → do
@@ -369,13 +374,13 @@ handleLunapark inp = case _ of
369374 ]
370375 pure next
371376 MaximizeWindow next → do
372− _ ← post_ (inSession : LP.Window : LP.Maximize : Nil)
377+ _ ← post' (inSession : LP.Window : LP.Maximize : Nil)
373378 pure next
374379 MinimizeWindow next → do
375− _ ← post_ (inSession : LP.Window : LP.Minimize : Nil)
380+ _ ← post' (inSession : LP.Window : LP.Minimize : Nil)
376381 pure next
377382 FullscreenWindow next → do
378− _ ← post_ (inSession : LP.Window : LP.Fullscreen : Nil)
383+ _ ← post' (inSession : LP.Window : LP.Fullscreen : Nil)
379384 pure next
380385 ExecuteScript script cont → do
381386 map cont $ tryAndCache "execute script"
@@ -389,10 +394,10 @@ handleLunapark inp = case _ of
389394 ]
390395 GetAllCookies cont → do
391396 res ← get (inSession : LP.Cookies : Nil)
392− map cont $ throwLeft $ T.traverse LT.decodeCookie =<< J.decodeJson res
397+ map cont $ rethrowAsJsonDecodeError $ T.traverse LT.decodeCookie =<< J.decodeJson res
393398 GetCookie name cont → do
394399 res ← get (inSession : LP.Cookie name : Nil)
395− map cont $ throwLeft $ LT.decodeCookie res
400+ map cont $ rethrowAsJsonDecodeError $ LT.decodeCookie res
396401 DeleteAllCookies next → do
397402 _ ← delete (inSession : LP.Cookies : Nil)
398403 pure next
@@ -404,14 +409,14 @@ handleLunapark inp = case _ of
404409 pure next
405410 DismissAlert next → do
406411 _ ← tryAndCache "dismiss alert"
407− [ post_ (inSession : LP.Alert : LP.Dismiss : Nil)
408− , post_ (inSession : LP.DismissAlert : Nil)
412+ [ post' (inSession : LP.Alert : LP.Dismiss : Nil)
413+ , post' (inSession : LP.DismissAlert : Nil)
409414 ]
410415 pure next
411416 AcceptAlert next → do
412417 _ ← tryAndCache "accept alert"
413− [ post_ (inSession : LP.Alert : LP.Accept : Nil)
414− , post_ (inSession : LP.AcceptAlert : Nil)
418+ [ post' (inSession : LP.Alert : LP.Accept : Nil)
419+ , post' (inSession : LP.AcceptAlert : Nil)
415420 ]
416421 pure next
417422 GetAlertText cont → do
@@ -419,7 +424,7 @@ handleLunapark inp = case _ of
419424 [ get (inSession : LP.Alert : LP.Text : Nil)
420425 , get (inSession : LP.AlertText : Nil)
421426 ]
422− map cont $ throwLeft $ J.decodeJson res
427+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
423428 SendAlertText str next → do
424429 _ ← tryAndCache "send alert text"
425430 [ post (inSession : LP.Alert : LP.Text : Nil) (LT.encodeSendKeysRequest str)
@@ -428,19 +433,19 @@ handleLunapark inp = case _ of
428433 pure next
429434 Screenshot fp next → do
430435 res ← get (inSession : LP.Screenshot : Nil)
431− screenshotPack ← throwLeft $ LT.decodeScreenshot res
436+ screenshotPack ← rethrowAsJsonDecodeError $ LT.decodeScreenshot res
432437 buffer ← R.liftEffect $ B.fromString screenshotPack.content screenshotPack.encoding
433438 R.liftAff $ FS.writeFile fp buffer
434439 pure next
435440 FindElement loc cont → do
436441 res ← post (inSession : LP.Element : Nil) (LT.encodeLocator loc)
437− map cont $ throwLeft $ LT.decodeElement res
442+ map cont $ rethrowAsJsonDecodeError $ LT.decodeElement res
438443 FindElements loc cont → do
439444 res ← post (inSession : LP.Elements : Nil) (LT.encodeLocator loc)
440− map cont $ throwLeft $ T.traverse LT.decodeElement =<< J.decodeJson res
445+ map cont $ rethrowAsJsonDecodeError $ T.traverse LT.decodeElement =<< J.decodeJson res
441446 GetActiveElement cont → do
442447 res ← get (inSession : LP.Element : LP.Active : Nil)
443− map cont $ throwLeft $ LT.decodeElement res
448+ map cont $ rethrowAsJsonDecodeError $ LT.decodeElement res
444449 PerformActions req next → do
445450 when inp.actionsEnabled
446451 $ void $ post
@@ -455,53 +460,53 @@ handleLunapark inp = case _ of
455460 in case elF of
456461 ChildElement loc cont → do
457462 res ← post (inSession : inElement : LP.Element : Nil) (LT.encodeLocator loc)
458− map cont $ throwLeft $ LT.decodeElement res
463+ map cont $ rethrowAsJsonDecodeError $ LT.decodeElement res
459464 ChildElements loc cont → do
460465 res ← post (inSession : inElement : LP.Elements : Nil) (LT.encodeLocator loc)
461− map cont $ throwLeft $ T.traverse LT.decodeElement =<< J.decodeJson res
466+ map cont $ rethrowAsJsonDecodeError $ T.traverse LT.decodeElement =<< J.decodeJson res
462467 ScreenshotEl fp next → do
463468 res ← get (inSession : inElement : LP.Screenshot : Nil)
464− screenshotPack ← throwLeft $ LT.decodeScreenshot res
469+ screenshotPack ← rethrowAsJsonDecodeError $ LT.decodeScreenshot res
465470 buffer ← R.liftEffect $ B.fromString screenshotPack.content screenshotPack.encoding
466471 R.liftAff $ FS.writeFile fp buffer
467472 pure next
468473 IsSelected cont → do
469474 res ← get (inSession : inElement : LP.Selected : Nil)
470− map cont $ throwLeft $ J.decodeJson res
475+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
471476 GetAttribute attr cont → do
472477 res ← get (inSession : inElement : LP.Attribute attr : Nil)
473− map cont $ throwLeft $ J.decodeJson res
478+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
474479 GetProperty prop cont → do
475480 map cont $ get (inSession : inElement : LP.Property prop : Nil)
476481 GetCss css cont → do
477482 res ← get (inSession : inElement : LP.CssValue css : Nil)
478− map cont $ throwLeft $ J.decodeJson res
483+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
479484 GetText cont → do
480485 res ← get (inSession : inElement : LP.Text : Nil)
481− map cont $ throwLeft $ J.decodeJson res
486+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
482487 GetTagName cont → do
483488 res ← get (inSession : inElement : LP.Name : Nil)
484− map cont $ throwLeft $ J.decodeJson res
489+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
485490 GetRectangle cont →
486491 map cont $ tryAndCache "get element rectangle"
487492 [ do res ← get (inSession : inElement : LP.Rect : Nil)
488− throwLeft $ LT.decodeRectangle res
493+ rethrowAsJsonDecodeError $ LT.decodeRectangle res
489494 , do position ← get (inSession : inElement : LP.Position : Nil)
490495 size ← get (inSession : inElement : LP.Size : Nil)
491− throwLeft $ LT.decodeRectangleLegacy { position, size }
496+ rethrowAsJsonDecodeError $ LT.decodeRectangleLegacy { position, size }
492497 ]
493498 IsEnabled cont → do
494499 res ← get (inSession : inElement : LP.Enabled : Nil)
495− map cont $ throwLeft $ J.decodeJson res
500+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
496501 ClickEl next → do
497502 _ ← tryAndCache "chromedriver75 update clickElement"
498− [ post_ (inSession : inElement : LP.Click : Nil)
503+ [ post' (inSession : inElement : LP.Click : Nil)
499504 , post (inSession : inElement : LP.Click : Nil) $ LT.encodeElement el
500505 ]
501506 pure next
502507 ClearEl next → do
503508 _ ← tryAndCache "chromedriver75 update clearElement"
504− [ post_ (inSession : inElement : LP.Clear : Nil)
509+ [ post' (inSession : inElement : LP.Clear : Nil)
505510 , post (inSession : inElement : LP.Click : Nil) $ LT.encodeElement el
506511 ]
507512 pure next
@@ -521,10 +526,10 @@ handleLunapark inp = case _ of
521526 }
522527 handleLunapark inp $ ExecuteScript script identity
523528 ]
524− map cont $ throwLeft $ J.decodeJson res
529+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
525530 Submit next → do
526531 _ ← tryAndCache "chromedriver75 update submit form"
527− [ post_ (inSession : inElement : LP.Submit : Nil)
532+ [ post' (inSession : inElement : LP.Submit : Nil)
528533 , post (inSession: inElement : LP.Submit : Nil) $ LT.encodeElement el
529534 ]
530535 pure next
@@ -533,18 +538,17 @@ handleLunapark inp = case _ of
533538 delete a = liftAndRethrow $ LP.delete inp.uri a
534539 post a b = liftAndRethrow $ LP.post inp.uri a b
535540 get a = liftAndRethrow $ LP.get inp.uri a
536− post_ a = liftAndRethrow $ LP.post_ inp.uri a
541+ post' a = liftAndRethrow $ LP.post' inp.uri a
537542
538− tryAndCache ∷ ∀ a. String → Array (BaseRun r a) → BaseRun r a
543+ -- | It caches an index of an action that is valid for current webdriver implementation.
544+ -- | So you don't need to search correct one by tring them each time
545+ tryAndCache ∷ ∀ a. String → Array (Run (BaseEffects r) a) → Run (BaseEffects r) a
539546 tryAndCache key actions = do
540− let emptyCases = throwLeft $ Left $ "No valid cases for " <> key <> " caching"
541− let incorrectCache = throwLeft $ Left $ "Fallback for " <> key <> " error"
542−
543547 mp ← R.liftEffect $ Ref.read inp.requestMapRef
544548 case Map.lookup key mp of
545549 Just ix → case A.index actions ix of
546550 Just action → action
547− Nothing → incorrectCache
551+ Nothing → RE.throw $ LE.CachingError $ LE.IncorrectCache key
548552 Nothing →
549553 let
550554 go ix acc act =
@@ -554,7 +558,7 @@ handleLunapark inp = case _ of
554558 pure a
555559 in catch try' \_ → acc
556560 in
557− FI.foldlWithIndex go emptyCases actions
561+ FI.foldlWithIndex go (RE.throw $ LE.CachingError $ LE.EmptyCases key) actions
558562
559563 inSession ∷ LP.EndpointPart
560564 inSession = LP.InSession inp.session
src/Lunapark/ActionF.purs+17−16
@@ -5,6 +5,7 @@ import Prelude
55import Data.Symbol (SProxy(..))
66import Data.Time.Duration (Milliseconds)
77import Lunapark.Types as LT
8+import Run (Run)
89import Run as R
910
1011
@@ -32,49 +33,49 @@ derive instance functorTouchF ∷ Functor TouchF
3233
3334_lunaparkActions = SProxy ∷ SProxy "lunaparkActions"
3435type LUNAPARK_ACTIONS = R.FProxy ActionF
35−type WithAction r = R.Run (lunaparkActions ∷ LUNAPARK_ACTIONS|r) Unit
36+type ActionsEffect r = ( lunaparkActions ∷ LUNAPARK_ACTIONS | r )
3637
37−liftAction ∷ ∀ r. ActionF Unit → WithAction r
38+liftAction ∷ ∀ r. ActionF Unit → Run (ActionsEffect r) Unit
3839liftAction = R.lift _lunaparkActions
3940
40−click ∷ ∀ r. LT.Button → WithAction r
41+click ∷ ∀ r. LT.Button → Run (ActionsEffect r) Unit
4142click btn = liftAction $ Click btn unit
4243
43−buttonDown ∷ ∀ r. LT.Button → WithAction r
44+buttonDown ∷ ∀ r. LT.Button → Run (ActionsEffect r) Unit
4445buttonDown btn = liftAction $ ButtonDown btn unit
4546
46−buttonUp ∷ ∀ r. LT.Button → WithAction r
47+buttonUp ∷ ∀ r. LT.Button → Run (ActionsEffect r) Unit
4748buttonUp btn = liftAction $ ButtonUp btn unit
4849
49−doubleClick ∷ ∀ r. LT.Button → WithAction r
50+doubleClick ∷ ∀ r. LT.Button → Run (ActionsEffect r) Unit
5051doubleClick btn = liftAction $ DoubleClick btn unit
5152
52−sendKeys ∷ ∀ r. String → WithAction r
53+sendKeys ∷ ∀ r. String → Run (ActionsEffect r) Unit
5354sendKeys txt = liftAction $ SendKeys txt unit
5455
55−moveTo ∷ ∀ r. LT.PointerMove → WithAction r
56+moveTo ∷ ∀ r. LT.PointerMove → Run (ActionsEffect r) Unit
5657moveTo move = liftAction $ MoveTo move unit
5758
58−pause ∷ ∀ r. Milliseconds → WithAction r
59+pause ∷ ∀ r. Milliseconds → Run (ActionsEffect r) Unit
5960pause ms = liftAction $ Pause ms unit
6061
61−tap ∷ ∀ r. WithAction r
62+tap ∷ ∀ r. Run (ActionsEffect r) Unit
6263tap = liftAction $ InTouch $ Tap unit
6364
64−touchDown ∷ ∀ r. WithAction r
65+touchDown ∷ ∀ r. Run (ActionsEffect r) Unit
6566touchDown = liftAction $ InTouch $ TouchDown unit
6667
67−touchUp ∷ ∀ r. WithAction r
68+touchUp ∷ ∀ r. Run (ActionsEffect r) Unit
6869touchUp = liftAction $ InTouch $ TouchUp unit
6970
70−longTap ∷ ∀ r. WithAction r
71+longTap ∷ ∀ r. Run (ActionsEffect r) Unit
7172longTap = liftAction $ InTouch $ LongClick unit
7273
73−flick ∷ ∀ r. LT.PointerMove → WithAction r
74+flick ∷ ∀ r. LT.PointerMove → Run (ActionsEffect r) Unit
7475flick move = liftAction $ InTouch $ Flick move unit
7576
76−scroll ∷ ∀ r. LT.PointerMove → WithAction r
77+scroll ∷ ∀ r. LT.PointerMove → Run (ActionsEffect r) Unit
7778scroll move = liftAction $ InTouch $ Scroll move unit
7879
79−doubleTap ∷ ∀ r. WithAction r
80+doubleTap ∷ ∀ r. Run (ActionsEffect r) Unit
8081doubleTap = liftAction $ InTouch $ DoubleTap unit
src/Lunapark/Endpoint.purs+18−9
@@ -3,7 +3,14 @@
33-- | So, to have something like `/session/:sessId/element/:elId/doubleclick` we have
44-- | `InSession sessId : InElement elId : DoubleClick : Nil`
55-- | This is not as typesafe as it could be, but at least it saves from typos.
6−module Lunapark.Endpoint where
6+module Lunapark.Endpoint
7+ ( delete
8+ , get
9+ , post
10+ , post'
11+ , EndpointPart(..)
12+ )
13+ where
714
815import Prelude
916
@@ -23,6 +30,7 @@ import Data.Newtype (un)
2330import Effect.Aff (Aff)
2431import Lunapark.Error as LE
2532import Lunapark.Types as LT
33+import Lunapark.WebDriverError as LWE
2634
2735data EndpointPart
2836 = Session
@@ -169,23 +177,24 @@ printPart = case _ of
169177 Flick → "flick"
170178
171179handleAPIError
172− ∷ N.Response (Either N.ResponseFormatError Json)
180+ ∷ Either N.Error (N.Response Json)
173181 → Either LE.Error Json
174−handleAPIError r = case r.status of
175− StatusCode 200 → lmap LE.unknownError do
176− obj ← J.decodeJson =<< lmap N.printResponseFormatError r.body
182+handleAPIError (Left error) = Left $ LE.AffjaxError error
183+handleAPIError (Right r) = case r.status of
184+ StatusCode 200 → lmap LE.JsonDecodeError do
185+ obj ← J.decodeJson r.body
177186 obj J..: "value"
178187 code →
179− Left $ either (LE.unknownError <<< N.printResponseFormatError) LE.fromJson r.body
188+ Left $ either LE.JsonDecodeError LE.WebDriverError $ LWE.fromJson r.body
180189
181190get ∷ String → Endpoint → Aff (Either LE.Error Json)
182191get uri ep = map handleAPIError $ N.get NR.json (uri <> print ep)
183192
184193post ∷ String → Endpoint → Json → Aff (Either LE.Error Json)
185−post uri ep obj = map handleAPIError $ N.post NR.json (uri <> print ep) $ NQ.json obj
194+post uri ep obj = map handleAPIError $ N.post NR.json (uri <> print ep) $ Just (NQ.json obj)
186195
187−post_ ∷ String → Endpoint → Aff (Either LE.Error Json)
188−post_ uri ep = map handleAPIError $ N.post' NR.json (uri <> print ep) Nothing
196+post' ∷ String → Endpoint → Aff (Either LE.Error Json)
197+post' uri ep = map handleAPIError $ N.post NR.json (uri <> print ep) Nothing
189198
190199delete ∷ String → Endpoint → Aff (Either LE.Error Json)
191200delete uri ep = map handleAPIError $ N.delete NR.json (uri <> print ep)
src/Lunapark/Error.purs+31−120
@@ -1,123 +1,34 @@
11module Lunapark.Error where
22
33import Prelude
4−
5−import Data.Argonaut.Core (Json) as J
6−import Data.Argonaut.Decode.Combinators ((.:)) as J
7−import Data.Argonaut.Decode.Class (decodeJson) as J
8−import Data.Either (Either(..), either)
9−
10−data ErrorType
11− = ElementClickIntercepted
12− | ElementNotSelectable
13− | ElementNotInteractable
14− | InsecureCertificate
15− | InvalidArgument
16− | InvalidCookieDomain
17− | InvalidCoordinates
18− | InvalidElementState
19− | InvalidSelector
20− | InvalidSessionId
21− | JavaScriptError
22− | MoveTargetOutOfBounds
23− | NoSuchAlert
24− | NoSuchCookie
25− | NoSuchElement
26− | NoSuchFrame
27− | NoSuchWindow
28− | ScriptTimeout
29− | SessionNotCreated
30− | StaleElementReference
31− | Timeout
32− | UnableToSetCookie
33− | UnableToCaptureScreen
34− | UnexpectedAlertOpen
35− | UnknownCommand
36− | UnknownError
37− | UnknownMethod
38− | UnsupportedOperation
39−
40−fromStringCode ∷ String → Either String ErrorType
41−fromStringCode = case _ of
42− "element click intercepted" → Right ElementClickIntercepted
43− "element not selectable" → Right ElementNotSelectable
44− "element not interactable" → Right ElementNotInteractable
45− "insecure certificate" → Right InsecureCertificate
46− "invalid argument" → Right InvalidArgument
47− "invalid cookie domain" → Right InvalidCookieDomain
48− "invalid coordinates" → Right InvalidCoordinates
49− "invalid element state" → Right InvalidElementState
50− "invalid selector" → Right InvalidSelector
51− "invalid session id" → Right InvalidSessionId
52− "javascript error" → Right JavaScriptError
53− "move target out of bounds" → Right MoveTargetOutOfBounds
54− "no such alert" → Right NoSuchAlert
55− "no such cookie" → Right NoSuchCookie
56− "no such element" → Right NoSuchElement
57− "no such frame" → Right NoSuchFrame
58− "no such window" → Right NoSuchWindow
59− "script timeout" → Right ScriptTimeout
60− "session not created" → Right SessionNotCreated
61− "stale element reference" → Right StaleElementReference
62− "timeout" → Right Timeout
63− "unable to set cookie" → Right UnableToSetCookie
64− "unable to capture screen" → Right UnableToCaptureScreen
65− "unexpected alert open" → Right UnexpectedAlertOpen
66− "unknown command" → Right UnknownCommand
67− "unknown error" → Right UnknownError
68− "unknown method" → Right UnknownMethod
69− "unsupported operation" → Right UnsupportedOperation
70− s → Left s
71−
72−toStringCode ∷ ErrorType → String
73−toStringCode = case _ of
74− ElementClickIntercepted → "element click intercepted"
75− ElementNotSelectable → "element not selectable"
76− ElementNotInteractable → "element not interactable"
77− InsecureCertificate → "insecure certificate"
78− InvalidArgument → "invalid argument"
79− InvalidCookieDomain → "invalid cookie domain"
80− InvalidCoordinates → "invalid coordinates"
81− InvalidElementState → "invalid element state"
82− InvalidSelector → "invalid selector"
83− InvalidSessionId → "invalid session id"
84− JavaScriptError → "javascript error"
85− MoveTargetOutOfBounds → "move target out of bounds"
86− NoSuchAlert → "no such alert"
87− NoSuchCookie → "no such cookie"
88− NoSuchElement → "no such element"
89− NoSuchFrame → "no such frame"
90− NoSuchWindow → "no such window"
91− ScriptTimeout → "script timeout"
92− SessionNotCreated → "session not created"
93− StaleElementReference → "stale element reference"
94− Timeout → "timeout"
95− UnableToSetCookie → "unable to set cookie"
96− UnableToCaptureScreen → "unable to capture screen"
97− UnexpectedAlertOpen → "unexpected alert open"
98− UnknownCommand → "unknown command"
99− UnknownError → "unknown error"
100− UnknownMethod → "unknown method"
101− UnsupportedOperation → "unsupported operation"
102−
103−type Error =
104− { error ∷ ErrorType
105− , message ∷ String
106− , stacktrace ∷ String
107− }
108−
109−fromJson ∷ J.Json → Error
110−fromJson js = either unknownError identity do
111− obj ← J.decodeJson js
112− value ← obj J..: "value"
113− error ← fromStringCode =<< value J..: "error"
114− message ← value J..: "message"
115− stacktrace ← value J..: "stacktrace"
116− pure { error, message, stacktrace }
117−
118−unknownError ∷ String → Error
119−unknownError message =
120− { error: UnknownError
121− , message
122− , stacktrace: ""
123− }
4+import Affjax as N
5+import Lunapark.WebDriverError as LWE
6+import Data.Argonaut.Decode (JsonDecodeError, printJsonDecodeError) as J
7+
8+data CachingError
9+ = EmptyCases String
10+ | IncorrectCache String
11+
12+data Error
13+ = JsonDecodeError J.JsonDecodeError
14+ | WebDriverError LWE.WebDriverError
15+ | AffjaxError N.Error
16+ | CachingError CachingError
17+
18+printError ∷ Error → String
19+printError = case _ of
20+ JsonDecodeError jsonDecodeError →
21+ J.printJsonDecodeError jsonDecodeError
22+ WebDriverError webdriverError →
23+ "Response with error message:\n"
24+ <> " error type: " <> LWE.toStringCode webdriverError.error <> "\n"
25+ <> " message: " <> webdriverError.message <> "\n"
26+ <> " stacktrace: " <> webdriverError.stacktrace
27+ AffjaxError affjaxError →
28+ N.printError affjaxError
29+ CachingError cachingError →
30+ "Error during caching:\n " <> printCachingError cachingError
31+ where
32+ printCachingError = case _ of
33+ EmptyCases key → "There is no working implementation for " <> key <> " action."
34+ IncorrectCache key → "Trying another implementation for " <> key <> " action."
src/Lunapark/LunaparkF.purs+56−56
@@ -5,6 +5,7 @@ import Prelude
55import Data.Argonaut.Core as J
66import Data.Symbol (SProxy(..))
77import Lunapark.Types as LT
8+import Run (Run)
89import Run as R
910
1011data LunaparkF a
@@ -71,167 +72,166 @@ derive instance functorElementF ∷ Functor ElementF
7172
7273_lunapark = SProxy ∷ SProxy "lunapark"
7374type LUNAPARK = R.FProxy LunaparkF
74−type WithLunapark r a = R.Run (lunapark ∷ LUNAPARK|r) a
75+type LunaparkEffect r = ( lunapark ∷ LUNAPARK | r )
7576
76−
77−liftLunapark ∷ ∀ a r. LunaparkF a → WithLunapark r a
77+liftLunapark ∷ ∀ a r. LunaparkF a → Run (LunaparkEffect r) a
7878liftLunapark = R.lift _lunapark
7979
80−quit ∷ ∀ r. WithLunapark r Unit
80+quit ∷ ∀ r. Run (LunaparkEffect r) Unit
8181quit = liftLunapark $ Quit unit
8282
83−status ∷ ∀ r. WithLunapark r LT.ServerStatus
83+status ∷ ∀ r. Run (LunaparkEffect r) LT.ServerStatus
8484status = liftLunapark $ Status identity
8585
86−setTimeouts ∷ ∀ r. LT.Timeouts → WithLunapark r Unit
86+setTimeouts ∷ ∀ r. LT.Timeouts → Run (LunaparkEffect r) Unit
8787setTimeouts ts = liftLunapark $ SetTimeouts ts unit
8888
89−getTimeouts ∷ ∀ r. WithLunapark r LT.Timeouts
89+getTimeouts ∷ ∀ r. Run (LunaparkEffect r) LT.Timeouts
9090getTimeouts = liftLunapark $ GetTimeouts identity
9191
92−go ∷ ∀ r. String → WithLunapark r Unit
92+go ∷ ∀ r. String → Run (LunaparkEffect r) Unit
9393go uri = liftLunapark $ GoTo uri unit
9494
95−getUrl ∷ ∀ r. WithLunapark r String
95+getUrl ∷ ∀ r. Run (LunaparkEffect r) String
9696getUrl = liftLunapark $ GetUrl identity
9797
98−forward ∷ ∀ r. WithLunapark r Unit
98+forward ∷ ∀ r. Run (LunaparkEffect r) Unit
9999forward = liftLunapark $ Forward unit
100100
101−back ∷ ∀ r. WithLunapark r Unit
101+back ∷ ∀ r. Run (LunaparkEffect r) Unit
102102back = liftLunapark $ Back unit
103103
104−refresh ∷ ∀ r. WithLunapark r Unit
104+refresh ∷ ∀ r. Run (LunaparkEffect r) Unit
105105refresh = liftLunapark $ Refresh unit
106106
107−getTitle ∷ ∀ r. WithLunapark r String
107+getTitle ∷ ∀ r. Run (LunaparkEffect r) String
108108getTitle = liftLunapark $ GetTitle identity
109109
110−getWindowHandle ∷ ∀ r. WithLunapark r LT.WindowHandle
110+getWindowHandle ∷ ∀ r. Run (LunaparkEffect r) LT.WindowHandle
111111getWindowHandle = liftLunapark $ GetWindowHandle identity
112112
113−getWindowHandles ∷ ∀ r. WithLunapark r (Array LT.WindowHandle)
113+getWindowHandles ∷ ∀ r. Run (LunaparkEffect r) (Array LT.WindowHandle)
114114getWindowHandles = liftLunapark $ GetWindowHandles identity
115115
116−closeWindow ∷ ∀ r. WithLunapark r Unit
116+closeWindow ∷ ∀ r. Run (LunaparkEffect r) Unit
117117closeWindow = liftLunapark $ CloseWindow unit
118118
119−switchToWindow ∷ ∀ r. LT.WindowHandle → WithLunapark r Unit
119+switchToWindow ∷ ∀ r. LT.WindowHandle → Run (LunaparkEffect r) Unit
120120switchToWindow w = liftLunapark $ SwitchToWindow w unit
121121
122−switchToFrame ∷ ∀ r. LT.FrameId → WithLunapark r Unit
122+switchToFrame ∷ ∀ r. LT.FrameId → Run (LunaparkEffect r) Unit
123123switchToFrame f = liftLunapark $ SwitchToFrame f unit
124124
125−switchToParentFrame ∷ ∀ r. WithLunapark r Unit
125+switchToParentFrame ∷ ∀ r. Run (LunaparkEffect r) Unit
126126switchToParentFrame = liftLunapark $ SwitchToParentFrame unit
127127
128−getWindowRectangle ∷ ∀ r. WithLunapark r LT.Rectangle
128+getWindowRectangle ∷ ∀ r. Run (LunaparkEffect r) LT.Rectangle
129129getWindowRectangle = liftLunapark $ GetWindowRectangle identity
130130
131−setWindowRectangle ∷ ∀ r. LT.Rectangle → WithLunapark r Unit
131+setWindowRectangle ∷ ∀ r. LT.Rectangle → Run (LunaparkEffect r) Unit
132132setWindowRectangle r = liftLunapark $ SetWindowRectangle r unit
133133
134−maximizeWindow ∷ ∀ r. WithLunapark r Unit
134+maximizeWindow ∷ ∀ r. Run (LunaparkEffect r) Unit
135135maximizeWindow = liftLunapark $ MaximizeWindow unit
136136
137−minimizeWindow ∷ ∀ r. WithLunapark r Unit
137+minimizeWindow ∷ ∀ r. Run (LunaparkEffect r) Unit
138138minimizeWindow = liftLunapark $ MinimizeWindow unit
139139
140−fullscreenWindow ∷ ∀ r. WithLunapark r Unit
140+fullscreenWindow ∷ ∀ r. Run (LunaparkEffect r) Unit
141141fullscreenWindow = liftLunapark $ FullscreenWindow unit
142142
143−executeScript ∷ ∀ r. LT.Script → WithLunapark r J.Json
143+executeScript ∷ ∀ r. LT.Script → Run (LunaparkEffect r) J.Json
144144executeScript script = liftLunapark $ ExecuteScript script identity
145145
146−executeScriptAsync ∷ ∀ r. LT.Script → WithLunapark r J.Json
146+executeScriptAsync ∷ ∀ r. LT.Script → Run (LunaparkEffect r) J.Json
147147executeScriptAsync script = liftLunapark $ ExecuteScriptAsync script identity
148148
149−getAllCookies ∷ ∀ r. WithLunapark r (Array LT.Cookie)
149+getAllCookies ∷ ∀ r. Run (LunaparkEffect r) (Array LT.Cookie)
150150getAllCookies = liftLunapark $ GetAllCookies identity
151151
152−getCookie ∷ ∀ r. String → WithLunapark r LT.Cookie
152+getCookie ∷ ∀ r. String → Run (LunaparkEffect r) LT.Cookie
153153getCookie name = liftLunapark $ GetCookie name identity
154154
155−addCookie ∷ ∀ r. LT.Cookie → WithLunapark r Unit
155+addCookie ∷ ∀ r. LT.Cookie → Run (LunaparkEffect r) Unit
156156addCookie cookie = liftLunapark $ AddCookie cookie unit
157157
158−deleteCookie ∷ ∀ r. String → WithLunapark r Unit
158+deleteCookie ∷ ∀ r. String → Run (LunaparkEffect r) Unit
159159deleteCookie name = liftLunapark $ DeleteCookie name unit
160160
161−deleteAllCookies ∷ ∀ r. WithLunapark r Unit
161+deleteAllCookies ∷ ∀ r. Run (LunaparkEffect r) Unit
162162deleteAllCookies = liftLunapark $ DeleteAllCookies unit
163163
164−dismissAlert ∷ ∀ r. WithLunapark r Unit
164+dismissAlert ∷ ∀ r. Run (LunaparkEffect r) Unit
165165dismissAlert = liftLunapark $ DismissAlert unit
166166
167−acceptAlert ∷ ∀ r. WithLunapark r Unit
167+acceptAlert ∷ ∀ r. Run (LunaparkEffect r) Unit
168168acceptAlert = liftLunapark $ AcceptAlert unit
169169
170−getAlertText ∷ ∀ r. WithLunapark r String
170+getAlertText ∷ ∀ r. Run (LunaparkEffect r) String
171171getAlertText = liftLunapark $ GetAlertText identity
172172
173−sendAlertText ∷ ∀ r. String → WithLunapark r Unit
173+sendAlertText ∷ ∀ r. String → Run (LunaparkEffect r) Unit
174174sendAlertText txt = liftLunapark $ SendAlertText txt unit
175175
176−screenshot ∷ ∀ r. String → WithLunapark r Unit
176+screenshot ∷ ∀ r. String → Run (LunaparkEffect r) Unit
177177screenshot fp = liftLunapark $ Screenshot fp unit
178178
179−elementScreenshot ∷ ∀ r. LT.Element → String → WithLunapark r Unit
179+elementScreenshot ∷ ∀ r. LT.Element → String → Run (LunaparkEffect r) Unit
180180elementScreenshot el fp = liftLunapark $ OnElement el $ ScreenshotEl fp unit
181181
182−findElement ∷ ∀ r. LT.Locator → WithLunapark r LT.Element
182+findElement ∷ ∀ r. LT.Locator → Run (LunaparkEffect r) LT.Element
183183findElement l = liftLunapark $ FindElement l identity
184184
185−findElements ∷ ∀ r. LT.Locator → WithLunapark r (Array LT.Element)
185+findElements ∷ ∀ r. LT.Locator → Run (LunaparkEffect r) (Array LT.Element)
186186findElements l = liftLunapark $ FindElements l identity
187187
188−childElement ∷ ∀ r. LT.Element → LT.Locator → WithLunapark r LT.Element
188+childElement ∷ ∀ r. LT.Element → LT.Locator → Run (LunaparkEffect r) LT.Element
189189childElement el l = liftLunapark $ OnElement el $ ChildElement l identity
190190
191−childElements ∷ ∀ r. LT.Element → LT.Locator → WithLunapark r (Array LT.Element)
191+childElements ∷ ∀ r. LT.Element → LT.Locator → Run (LunaparkEffect r) (Array LT.Element)
192192childElements el l = liftLunapark $ OnElement el $ ChildElements l identity
193193
194−isSelected ∷ ∀ r. LT.Element → WithLunapark r Boolean
194+isSelected ∷ ∀ r. LT.Element → Run (LunaparkEffect r) Boolean
195195isSelected el = liftLunapark $ OnElement el $ IsSelected identity
196196
197−getAttribute ∷ ∀ r. LT.Element → String → WithLunapark r String
197+getAttribute ∷ ∀ r. LT.Element → String → Run (LunaparkEffect r) String
198198getAttribute el name = liftLunapark $ OnElement el $ GetAttribute name identity
199199
200−getProperty ∷ ∀ r. LT.Element → String → WithLunapark r J.Json
200+getProperty ∷ ∀ r. LT.Element → String → Run (LunaparkEffect r) J.Json
201201getProperty el name = liftLunapark $ OnElement el $ GetProperty name identity
202202
203−getCss ∷ ∀ r. LT.Element → String → WithLunapark r String
203+getCss ∷ ∀ r. LT.Element → String → Run (LunaparkEffect r) String
204204getCss el name = liftLunapark $ OnElement el $ GetCss name identity
205205
206−getText ∷ ∀ r. LT.Element → WithLunapark r String
206+getText ∷ ∀ r. LT.Element → Run (LunaparkEffect r) String
207207getText el = liftLunapark $ OnElement el $ GetText identity
208208
209−getTagName ∷ ∀ r. LT.Element → WithLunapark r String
209+getTagName ∷ ∀ r. LT.Element → Run (LunaparkEffect r) String
210210getTagName el = liftLunapark $ OnElement el $ GetTagName identity
211211
212−getRectangle ∷ ∀ r. LT.Element → WithLunapark r LT.Rectangle
212+getRectangle ∷ ∀ r. LT.Element → Run (LunaparkEffect r) LT.Rectangle
213213getRectangle el = liftLunapark $ OnElement el $ GetRectangle identity
214214
215−isEnabled ∷ ∀ r. LT.Element → WithLunapark r Boolean
215+isEnabled ∷ ∀ r. LT.Element → Run (LunaparkEffect r) Boolean
216216isEnabled el = liftLunapark $ OnElement el $ IsEnabled identity
217217
218−clickElement ∷ ∀ r. LT.Element → WithLunapark r Unit
218+clickElement ∷ ∀ r. LT.Element → Run (LunaparkEffect r) Unit
219219clickElement el = liftLunapark $ OnElement el $ ClickEl unit
220220
221−clearElement ∷ ∀ r. LT.Element → WithLunapark r Unit
221+clearElement ∷ ∀ r. LT.Element → Run (LunaparkEffect r) Unit
222222clearElement el = liftLunapark $ OnElement el $ ClearEl unit
223223
224−sendKeysElement ∷ ∀ r. LT.Element → String → WithLunapark r Unit
224+sendKeysElement ∷ ∀ r. LT.Element → String → Run (LunaparkEffect r) Unit
225225sendKeysElement el txt = liftLunapark $ OnElement el $ SendKeysEl txt unit
226226
227−isDisplayed ∷ ∀ r. LT.Element → WithLunapark r Boolean
227+isDisplayed ∷ ∀ r. LT.Element → Run (LunaparkEffect r) Boolean
228228isDisplayed el = liftLunapark $ OnElement el $ IsDisplayed identity
229229
230−submitElement ∷ ∀ r. LT.Element → WithLunapark r Unit
230+submitElement ∷ ∀ r. LT.Element → Run (LunaparkEffect r) Unit
231231submitElement el = liftLunapark $ OnElement el $ Submit unit
232232
233−performActions ∷ ∀ r. LT.ActionRequest → WithLunapark r Unit
233+performActions ∷ ∀ r. LT.ActionRequest → Run (LunaparkEffect r) Unit
234234performActions req = liftLunapark $ PerformActions req unit
235235
236−releaseActions ∷ ∀ r. WithLunapark r Unit
236+releaseActions ∷ ∀ r. Run (LunaparkEffect r) Unit
237237releaseActions = liftLunapark $ ReleaseActions unit
src/Lunapark/Types.purs+53−53
@@ -1,5 +1,5 @@
11-- | This module contains types for requests and response.
2−-- | Most of them are records with `α → Json` and `Json → Either String α` functions
2+-- | Most of them are records with `α → J.Json` and `J.Json → Either J.JsonDecodeError α` functions
33-- | not newtypes with `Encode|DecodeJson` instances.
44module Lunapark.Types where
55
@@ -7,8 +7,8 @@ import Prelude
77
88import CSS as CSS
99import Control.Alt ((<|>))
10−import Data.Argonaut.Core (Json)
11−import Data.Argonaut.Core (Json, jsonEmptyObject, jsonNull) as J
10+import Data.Argonaut.Core (Json, jsonEmptyObject, jsonNull, fromString) as J
11+import Data.Argonaut.Decode (JsonDecodeError(..)) as J
1212import Data.Argonaut.Decode.Class (decodeJson) as J
1313import Data.Argonaut.Decode.Combinators ((.:))
1414import Data.Argonaut.Encode.Class (class EncodeJson, encodeJson) as J
@@ -54,17 +54,17 @@ derive instance newtypeElement ∷ Newtype Element _
5454derive newtype instance eqElement ∷ Eq Element
5555derive newtype instance ordElement ∷ Ord Element
5656
57−decodeElement ∷ Json → Either String Element
57+decodeElement ∷ J.Json → Either J.JsonDecodeError Element
5858decodeElement = J.decodeJson >=> \obj →
5959 map Element $ obj .: "element-6066-11e4-a52e-4f735466cecf" <|> obj .: "ELEMENT"
6060
61−encodeElement ∷ Element → Json
61+encodeElement ∷ Element → J.Json
6262encodeElement (Element eid) = J.encodeJson $ FO.fromFoldable
6363 [ Tuple "element-6066-11e4-a52e-4f735466cecf" eid
6464 , Tuple "ELEMENT" eid
6565 ]
6666
67−decodeSessionId ∷ Json → Either String SessionId
67+decodeSessionId ∷ J.Json → Either J.JsonDecodeError SessionId
6868decodeSessionId = map SessionId <<< J.decodeJson
6969
7070type CreateSessionResponse =
@@ -72,7 +72,7 @@ type CreateSessionResponse =
7272 , capabilities ∷ Array Capability
7373 }
7474
75−decodeCreateSessionResponse ∷ Json → Either String CreateSessionResponse
75+decodeCreateSessionResponse ∷ J.Json → Either J.JsonDecodeError CreateSessionResponse
7676decodeCreateSessionResponse = J.decodeJson >=> \obj → do
7777 session ← decodeSessionId =<< obj .: "sessionId"
7878 capabilities ← decodeCapabilities =<< obj .: "capabilities"
@@ -83,7 +83,7 @@ type ServerStatus =
8383 , message ∷ String
8484 }
8585
86−decodeServerStatus ∷ Json → Either String ServerStatus
86+decodeServerStatus ∷ J.Json → Either J.JsonDecodeError ServerStatus
8787decodeServerStatus = J.decodeJson >=> \obj → { ready: _, message: _ } <$> obj .: "ready" <*> obj .: "message"
8888
8989type Timeouts =
@@ -92,37 +92,37 @@ type Timeouts =
9292 , implicit ∷ Milliseconds
9393 }
9494
95−decodeTimeouts ∷ Json → Either String Timeouts
95+decodeTimeouts ∷ J.Json → Either J.JsonDecodeError Timeouts
9696decodeTimeouts = J.decodeJson >=> \obj → do
9797 script ← map Milliseconds $ obj .: "script"
9898 pageLoad ← map Milliseconds $ obj .: "pageLoad"
9999 implicit ← map Milliseconds $ obj .: "implicit"
100100 pure { script, pageLoad, implicit }
101101
102−encodeTimeouts ∷ Timeouts → Json
102+encodeTimeouts ∷ Timeouts → J.Json
103103encodeTimeouts r = J.encodeJson $ FO.fromFoldable
104104 [ Tuple "script" (un Milliseconds r.script)
105105 , Tuple "pageLoad" (un Milliseconds r.pageLoad)
106106 , Tuple "implicit" (un Milliseconds r.implicit)
107107 ]
108108
109−encodeLegacyTimeouts ∷ Timeouts → Array Json
109+encodeLegacyTimeouts ∷ Timeouts → Array J.Json
110110encodeLegacyTimeouts r =
111111 [ J.encodeJson $ FO.singleton "script" $ un Milliseconds r.script
112112 , J.encodeJson $ FO.singleton "implicit" $ un Milliseconds r.implicit
113113 , J.encodeJson $ FO.singleton "page load" $ un Milliseconds r.pageLoad
114114 ]
115115
116−encodeGoRequest ∷ String → Json
116+encodeGoRequest ∷ String → J.Json
117117encodeGoRequest url = J.encodeJson $ FO.fromFoldable [ Tuple "url" url ]
118118
119−decodeWindowHandle ∷ Json → Either String WindowHandle
119+decodeWindowHandle ∷ J.Json → Either J.JsonDecodeError WindowHandle
120120decodeWindowHandle = map WindowHandle <<< J.decodeJson
121121
122−encodeSwitchToWindowRequest ∷ WindowHandle → Json
122+encodeSwitchToWindowRequest ∷ WindowHandle → J.Json
123123encodeSwitchToWindowRequest w = J.encodeJson $ FO.fromFoldable [ Tuple "handle" $ un WindowHandle w ]
124124
125−encodeFrameId ∷ FrameId → Json
125+encodeFrameId ∷ FrameId → J.Json
126126encodeFrameId fid = J.encodeJson $ FO.fromFoldable [ Tuple "id" encoded ]
127127 where
128128 encoded = case fid of
@@ -137,7 +137,7 @@ type Rectangle =
137137 , y ∷ Int
138138 }
139139
140−decodeRectangle ∷ Json → Either String Rectangle
140+decodeRectangle ∷ J.Json → Either J.JsonDecodeError Rectangle
141141decodeRectangle = J.decodeJson >=> \obj → do
142142 width ← obj .: "width"
143143 height ← obj .: "height"
@@ -145,7 +145,7 @@ decodeRectangle = J.decodeJson >=> \obj → do
145145 y ← obj .: "y"
146146 pure { width, height, x, y }
147147
148−decodeRectangleLegacy ∷ { size ∷ Json, position ∷ Json } → Either String Rectangle
148+decodeRectangleLegacy ∷ { size ∷ J.Json, position ∷ J.Json } → Either J.JsonDecodeError Rectangle
149149decodeRectangleLegacy { size, position } = do
150150 sobj ← J.decodeJson size
151151 pobj ← J.decodeJson position
@@ -155,13 +155,13 @@ decodeRectangleLegacy { size, position } = do
155155 height ← sobj .: "height"
156156 pure { width, height, x, y }
157157
158−encodeRectangleLegacy ∷ Rectangle → { size ∷ Json, position ∷ Json }
158+encodeRectangleLegacy ∷ Rectangle → { size ∷ J.Json, position ∷ J.Json }
159159encodeRectangleLegacy r =
160160 { size: J.encodeJson $ FO.fromFoldable [ Tuple "width" r.width, Tuple "height" r.height ]
161161 , position: J.encodeJson $ FO.fromFoldable [ Tuple "x" r.x, Tuple "y" r.y ]
162162 }
163163
164−encodeRectangle ∷ Rectangle → Json
164+encodeRectangle ∷ Rectangle → J.Json
165165encodeRectangle r = J.encodeJson $ FO.fromFoldable
166166 [ Tuple "width" r.width
167167 , Tuple "height" r.height
@@ -182,7 +182,7 @@ type RawLocator =
182182 , value ∷ String
183183 }
184184
185−encodeLocator ∷ Locator → Json
185+encodeLocator ∷ Locator → J.Json
186186encodeLocator l = J.encodeJson $ FO.fromFoldable case l of
187187 ByCss sel →
188188 [ Tuple "using" "css selector"
@@ -209,15 +209,15 @@ encodeLocator l = J.encodeJson $ FO.fromFoldable case l of
209209 , Tuple "value" r.value
210210 ]
211211
212−encodeSendKeysRequest ∷ String → Json
212+encodeSendKeysRequest ∷ String → J.Json
213213encodeSendKeysRequest txt = J.encodeJson $ FO.fromFoldable [ Tuple "text" txt ]
214214
215215type Script =
216216 { script ∷ String
217− , args ∷ Array Json
217+ , args ∷ Array J.Json
218218 }
219219
220−encodeScript ∷ Script → Json
220+encodeScript ∷ Script → J.Json
221221encodeScript r = J.encodeJson $ FO.fromFoldable
222222 [ Tuple "script" $ J.encodeJson r.script
223223 , Tuple "args" $ J.encodeJson r.args
@@ -233,7 +233,7 @@ type Cookie =
233233 , expiry ∷ Maybe Int
234234 }
235235
236−encodeCookie ∷ Cookie → Json
236+encodeCookie ∷ Cookie → J.Json
237237encodeCookie r = J.encodeJson $ FO.fromFoldable
238238 [ Tuple "cookie" $ FO.fromFoldable
239239 $ [ Tuple "name" $ J.encodeJson r.name
@@ -249,7 +249,7 @@ encodeCookie r = J.encodeJson $ FO.fromFoldable
249249 maybeToAOfPair ∷ ∀ a. J.EncodeJson a ⇒ String → Maybe a → Array (Tuple String J.Json)
250250 maybeToAOfPair key mb = F.foldMap (A.singleton <<< Tuple key <<< J.encodeJson) mb
251251
252−decodeCookie ∷ Json → Either String Cookie
252+decodeCookie ∷ J.Json → Either J.JsonDecodeError Cookie
253253decodeCookie = J.decodeJson >=> \obj → do
254254 name ← obj .: "name"
255255 value ← obj .: "value"
@@ -277,13 +277,13 @@ type Screenshot =
277277 , encoding ∷ NE.Encoding
278278 }
279279
280−decodeScreenshot ∷ Json → Either String Screenshot
280+decodeScreenshot ∷ J.Json → Either J.JsonDecodeError Screenshot
281281decodeScreenshot j =
282282 { content: _, encoding: NE.Base64 } <$> J.decodeJson j
283283
284284data Button = LeftBtn | MiddleBtn | RightBtn
285285
286−encodeButton ∷ Button → Json
286+encodeButton ∷ Button → J.Json
287287encodeButton = J.encodeJson <<< case _ of
288288 LeftBtn → 0
289289 MiddleBtn → 1
@@ -294,7 +294,7 @@ data PointerMoveOrigin
294294 | FromPointer
295295 | FromElement Element
296296
297−encodeOrigin ∷ PointerMoveOrigin → Json
297+encodeOrigin ∷ PointerMoveOrigin → J.Json
298298encodeOrigin = case _ of
299299 FromViewport → J.encodeJson "viewport"
300300 FromPointer → J.encodeJson "pointer"
@@ -307,7 +307,7 @@ type PointerMove =
307307 , y ∷ Int
308308 }
309309
310−encodePointerMove ∷ PointerMove → FO.Object Json
310+encodePointerMove ∷ PointerMove → FO.Object J.Json
311311encodePointerMove r = FO.fromFoldable
312312 [ Tuple "x" $ J.encodeJson r.x
313313 , Tuple "y" $ J.encodeJson r.y
@@ -343,7 +343,7 @@ pointerDown = V.inj (SProxy ∷ SProxy "pointerDown")
343343pointerMove ∷ ∀ r a. a → V.Variant (pointerMove ∷ a|r)
344344pointerMove = V.inj (SProxy ∷ SProxy "pointerMove")
345345
346−encodeAction ∷ Action → Json
346+encodeAction ∷ Action → J.Json
347347encodeAction = V.match
348348 { pause: \ms →
349349 J.encodeJson $ FO.fromFoldable
@@ -394,17 +394,17 @@ data ActionSequence
394394-- Right, this is not an `Array` but `StrMap` because all `ActionSequence`s are tagged with unique id's
395395type ActionRequest = FO.Object ActionSequence
396396
397−encodeActionRequest ∷ ActionRequest → Json
397+encodeActionRequest ∷ ActionRequest → J.Json
398398encodeActionRequest sm = J.encodeJson $ FO.singleton "actions" $ map encodePair arrayOfPairs
399399 where
400400 arrayOfPairs ∷ Array (Tuple String ActionSequence)
401401 arrayOfPairs = FO.toUnfoldable sm
402402
403− encodePair ∷ Tuple String ActionSequence → Json
403+ encodePair ∷ Tuple String ActionSequence → J.Json
404404 encodePair (Tuple identifier sequence) =
405405 J.encodeJson $ FO.insert "id" (J.encodeJson identifier) $ encodeSequence sequence
406406
407− encodeSequence ∷ ActionSequence → FO.Object Json
407+ encodeSequence ∷ ActionSequence → FO.Object J.Json
408408 encodeSequence = case _ of
409409 NoSource as → FO.fromFoldable
410410 [ Tuple "type" $ J.encodeJson "none"
@@ -462,10 +462,10 @@ data Capability
462462 | PageLoadStrategy PageLoad
463463 | DesiredTimeouts Timeouts
464464 | UnhandledPromptBehavior UnhandledPrompt
465− | CustomCapability String Json
465+ | CustomCapability String J.Json
466466
467467
468−encodeCapability ∷ Capability → Tuple String Json
468+encodeCapability ∷ Capability → Tuple String J.Json
469469encodeCapability = case _ of
470470 BrowserName bn → Tuple "browserName" $ J.encodeJson case bn of
471471 MSEdge → "MicrosoftEdge"
@@ -488,50 +488,50 @@ encodeCapability = case _ of
488488 Dismiss → "dismiss"
489489 CustomCapability k v → Tuple k v
490490
491−encodeCapabilities ∷ ∀ f. F.Foldable f ⇒ f Capability → Json
491+encodeCapabilities ∷ ∀ f. F.Foldable f ⇒ f Capability → J.Json
492492encodeCapabilities = F.foldl (\b a → J.extend (encodeCapability a) b) J.jsonEmptyObject
493493
494−decodeCapabilities ∷ Json → Either String (Array Capability)
494+decodeCapabilities ∷ J.Json → Either J.JsonDecodeError (Array Capability)
495495decodeCapabilities = J.decodeJson >=> \obj →
496496 F.for (FO.toUnfoldable obj) \l@(Tuple key val) →
497497 decodeCapability l <|> Right (CustomCapability key val)
498498 where
499− decodeCapability ∷ Tuple String Json → Either String Capability
499+ decodeCapability ∷ Tuple String J.Json → Either J.JsonDecodeError Capability
500500 decodeCapability (Tuple key val) = case key of
501− "browserName" → BrowserName <$> decodeBrowserName val
501+ "browserName" → BrowserName <$> decodeBrowserType val
502502 "browserVersion" → BrowserVersion <$> J.decodeJson val
503503 "acceptInsecureCerts" → AcceptInsecureCerts <$> J.decodeJson val
504− "pageLoadStrategy" → PageLoadStrategy <$> decodePageLoadStrategy val
504+ "pageLoadStrategy" → PageLoadStrategy <$> decodePageLoad val
505505 "timeouts" → DesiredTimeouts <$> decodeTimeouts val
506− "unhandledPromptBehaviour" → UnhandledPromptBehavior <$> decodePrompt val
507− _ → Left "unhandled"
506+ "unhandledPromptBehaviour" → UnhandledPromptBehavior <$> decodeUnhandledPrompt val
507+ other → Left $ J.Named "Capability" $ J.UnexpectedValue (J.fromString other)
508508
509− decodeBrowserName ∷ Json → Either String BrowserType
510− decodeBrowserName = J.decodeJson >=> \str → case Str.toLower str of
509+ decodeBrowserType ∷ J.Json → Either J.JsonDecodeError BrowserType
510+ decodeBrowserType = J.decodeJson >=> \str → case Str.toLower str of
511511 "microsoftedge" → Right MSEdge
512512 "chrome" → Right Chrome
513513 "firefox" → Right Firefox
514− _ → Left "unhandled"
514+ other → Left $ J.Named "BrowserType" $ J.UnexpectedValue (J.fromString other)
515515
516− decodePageLoadStrategy ∷ Json → Either String PageLoad
517− decodePageLoadStrategy = J.decodeJson >=> \str → case Str.toLower str of
516+ decodePageLoad ∷ J.Json → Either J.JsonDecodeError PageLoad
517+ decodePageLoad = J.decodeJson >=> \str → case Str.toLower str of
518518 "none" → Right Immediate
519519 "normal" → Right Normal
520520 "eager" → Right Eager
521− _ → Left "unhandled"
521+ other → Left $ J.Named "PageLoad" $ J.UnexpectedValue (J.fromString other)
522522
523− decodePrompt ∷ Json → Either String UnhandledPrompt
524− decodePrompt = J.decodeJson >=> \str → case Str.toLower str of
523+ decodeUnhandledPrompt ∷ J.Json → Either J.JsonDecodeError UnhandledPrompt
524+ decodeUnhandledPrompt = J.decodeJson >=> \str → case Str.toLower str of
525525 "accept" → Right Accept
526526 "dismiss" → Right Dismiss
527− _ → Left "unhandled"
527+ other → Left $ J.Named "UnhandledPrompt" $ J.UnexpectedValue (J.fromString other)
528528
529529type CapabilitiesRequest =
530530 { alwaysMatch ∷ Array Capability
531531 , firstMatch ∷ Array (Array Capability)
532532 }
533533
534−encodeCapabilitiesRequest ∷ CapabilitiesRequest → Json
534+encodeCapabilitiesRequest ∷ CapabilitiesRequest → J.Json
535535encodeCapabilitiesRequest r = J.encodeJson $ FO.singleton "capabilities" $ FO.fromFoldable
536536 [ Tuple "alwaysMatch" $ encodeCapabilities r.alwaysMatch
537537 , Tuple "firstMatch" $ J.encodeJson $ map encodeCapabilities r.firstMatch
@@ -543,7 +543,7 @@ type MoveToRequest =
543543 , yoffset ∷ Int
544544 }
545545
546−encodeMoveToRequest ∷ MoveToRequest → Json
546+encodeMoveToRequest ∷ MoveToRequest → J.Json
547547encodeMoveToRequest r = J.encodeJson $ FO.fromFoldable
548548 [ Tuple "element" $ case r.element of
549549 Nothing → J.jsonNull
src/Lunapark/Utils.purs+6−5
@@ -2,9 +2,10 @@ module Lunapark.Utils where
22
33import Prelude
44
5−import Effect.Aff (Aff)
5+import Data.Argonaut.Decode (JsonDecodeError) as J
66import Data.Bifunctor (lmap)
77import Data.Either (Either)
8+import Effect.Aff (Aff)
89import Lunapark.Error as LE
910import Run as R
1011import Run.Except as RE
@@ -18,12 +19,12 @@ liftAndRethrow a = do
1819 res ← R.liftAff a
1920 RE.rethrow res
2021
21−throwLeft
22+rethrowAsJsonDecodeError
2223 ∷ ∀ r
23− . Either String
24+ . Either J.JsonDecodeError
2425 ~> R.Run (except ∷ RE.EXCEPT LE.Error|r)
25−throwLeft =
26− RE.rethrow <<< lmap LE.unknownError
26+rethrowAsJsonDecodeError =
27+ RE.rethrow <<< lmap LE.JsonDecodeError
2728
2829-- Safe, since we actually want handler and result have same rows not, remove except
2930catch
src/Lunapark/WebDriverError.pursnew file+117
@@ -0,0 +1,117 @@
1+module Lunapark.WebDriverError where
2+
3+import Prelude
4+
5+import Data.Argonaut.Core (Json, fromString) as J
6+import Data.Argonaut.Decode (JsonDecodeError(..)) as J
7+import Data.Argonaut.Decode.Combinators ((.:)) as J
8+import Data.Argonaut.Decode.Class (decodeJson) as J
9+import Data.Either (Either(..))
10+
11+data WebDriverErrorType
12+ = ElementClickIntercepted
13+ | ElementNotSelectable
14+ | ElementNotInteractable
15+ | InsecureCertificate
16+ | InvalidArgument
17+ | InvalidCookieDomain
18+ | InvalidCoordinates
19+ | InvalidElementState
20+ | InvalidSelector
21+ | InvalidSessionId
22+ | JavaScriptError
23+ | MoveTargetOutOfBounds
24+ | NoSuchAlert
25+ | NoSuchCookie
26+ | NoSuchElement
27+ | NoSuchFrame
28+ | NoSuchWindow
29+ | ScriptTimeout
30+ | SessionNotCreated
31+ | StaleElementReference
32+ | Timeout
33+ | UnableToSetCookie
34+ | UnableToCaptureScreen
35+ | UnexpectedAlertOpen
36+ | UnknownCommand
37+ | UnknownError
38+ | UnknownMethod
39+ | UnsupportedOperation
40+
41+fromStringCode ∷ String → Either J.JsonDecodeError WebDriverErrorType
42+fromStringCode = case _ of
43+ "element click intercepted" → Right ElementClickIntercepted
44+ "element not selectable" → Right ElementNotSelectable
45+ "element not interactable" → Right ElementNotInteractable
46+ "insecure certificate" → Right InsecureCertificate
47+ "invalid argument" → Right InvalidArgument
48+ "invalid cookie domain" → Right InvalidCookieDomain
49+ "invalid coordinates" → Right InvalidCoordinates
50+ "invalid element state" → Right InvalidElementState
51+ "invalid selector" → Right InvalidSelector
52+ "invalid session id" → Right InvalidSessionId
53+ "javascript error" → Right JavaScriptError
54+ "move target out of bounds" → Right MoveTargetOutOfBounds
55+ "no such alert" → Right NoSuchAlert
56+ "no such cookie" → Right NoSuchCookie
57+ "no such element" → Right NoSuchElement
58+ "no such frame" → Right NoSuchFrame
59+ "no such window" → Right NoSuchWindow
60+ "script timeout" → Right ScriptTimeout
61+ "session not created" → Right SessionNotCreated
62+ "stale element reference" → Right StaleElementReference
63+ "timeout" → Right Timeout
64+ "unable to set cookie" → Right UnableToSetCookie
65+ "unable to capture screen" → Right UnableToCaptureScreen
66+ "unexpected alert open" → Right UnexpectedAlertOpen
67+ "unknown command" → Right UnknownCommand
68+ "unknown error" → Right UnknownError
69+ "unknown method" → Right UnknownMethod
70+ "unsupported operation" → Right UnsupportedOperation
71+ s → Left $ J.Named "WebDriverErrorType" $ J.UnexpectedValue $ J.fromString s
72+
73+toStringCode ∷ WebDriverErrorType → String
74+toStringCode = case _ of
75+ ElementClickIntercepted → "element click intercepted"
76+ ElementNotSelectable → "element not selectable"
77+ ElementNotInteractable → "element not interactable"
78+ InsecureCertificate → "insecure certificate"
79+ InvalidArgument → "invalid argument"
80+ InvalidCookieDomain → "invalid cookie domain"
81+ InvalidCoordinates → "invalid coordinates"
82+ InvalidElementState → "invalid element state"
83+ InvalidSelector → "invalid selector"
84+ InvalidSessionId → "invalid session id"
85+ JavaScriptError → "javascript error"
86+ MoveTargetOutOfBounds → "move target out of bounds"
87+ NoSuchAlert → "no such alert"
88+ NoSuchCookie → "no such cookie"
89+ NoSuchElement → "no such element"
90+ NoSuchFrame → "no such frame"
91+ NoSuchWindow → "no such window"
92+ ScriptTimeout → "script timeout"
93+ SessionNotCreated → "session not created"
94+ StaleElementReference → "stale element reference"
95+ Timeout → "timeout"
96+ UnableToSetCookie → "unable to set cookie"
97+ UnableToCaptureScreen → "unable to capture screen"
98+ UnexpectedAlertOpen → "unexpected alert open"
99+ UnknownCommand → "unknown command"
100+ UnknownError → "unknown error"
101+ UnknownMethod → "unknown method"
102+ UnsupportedOperation → "unsupported operation"
103+
104+type WebDriverError =
105+ { error ∷ WebDriverErrorType
106+ , message ∷ String
107+ , stacktrace ∷ String
108+ }
109+
110+fromJson ∷ J.Json → Either J.JsonDecodeError WebDriverError
111+fromJson js = do
112+ obj ← J.decodeJson js
113+ value ← obj J..: "value"
114+ error ← fromStringCode =<< value J..: "error"
115+ message ← value J..: "message"
116+ stacktrace ← value J..: "stacktrace"
117+ pure { error, message, stacktrace }