git.iko.soy/rowtype-yoga/purescript-lunapark
on main help sign in
swap
620d8a72 ahead, 0 behind
9 files changed+266−222
since splitsnapshots
unifiedsplit
spago.yaml+30−30 src/Lunapark.purs−1 src/Lunapark/API.purs+178−134 src/Lunapark/ActionF.purs+1−1 src/Lunapark/Endpoint.purs+2−3 src/Lunapark/Error.purs+11−6 src/Lunapark/LunaparkF.purs+1−1 src/Lunapark/Types.purs+42−45 src/Lunapark/Utils.purs+1−1
spago.yaml+30−30
@@ -1,36 +1,36 @@
11package:
22 name: lunapark
33 dependencies:
4− - aff
5− - affjax
6− - affjax-node
7− - argonaut-codecs
8− - argonaut-core
9− - arrays
10− - bifunctors
11− - control
12− - css
13− - datetime
14− - effect
15− - either
16− - foldable-traversable
17− - foreign-object
18− - lists
19− - maybe
20− - newtype
21− - node-buffer
22− - node-fs
23− - node-path
24− - ordered-collections
25− - prelude
26− - refs
27− - run
28− - strings
29− - tailrec
30− - tuples
31− - typelevel-prelude
32− - unsafe-coerce
33− - variant
4+ - aff: ">=8.0.0 <9.0.0"
5+ - affjax: ">=13.0.0 <14.0.0"
6+ - affjax-node: ">=1.0.0 <2.0.0"
7+ - argonaut-codecs: ">=9.1.0 <10.0.0"
8+ - argonaut-core: ">=7.0.0 <8.0.0"
9+ - arrays: ">=7.3.0 <8.0.0"
10+ - bifunctors: ">=6.0.0 <7.0.0"
11+ - control: ">=6.0.0 <7.0.0"
12+ - css: ">=6.0.0 <7.0.0"
13+ - datetime: ">=6.1.0 <7.0.0"
14+ - effect: ">=4.0.0 <5.0.0"
15+ - either: ">=6.1.0 <7.0.0"
16+ - foldable-traversable: ">=6.0.0 <7.0.0"
17+ - foreign-object: ">=4.1.0 <5.0.0"
18+ - lists: ">=7.0.0 <8.0.0"
19+ - maybe: ">=6.0.0 <7.0.0"
20+ - newtype: ">=5.0.0 <6.0.0"
21+ - node-buffer: ">=9.0.0 <10.0.0"
22+ - node-fs: ">=9.2.0 <10.0.0"
23+ - node-path: ">=5.0.0 <6.0.0"
24+ - ordered-collections: ">=3.2.0 <4.0.0"
25+ - prelude: ">=6.0.1 <7.0.0"
26+ - refs: ">=6.0.0 <7.0.0"
27+ - run: ">=5.0.0 <6.0.0"
28+ - strings: ">=6.0.1 <7.0.0"
29+ - tailrec: ">=6.1.0 <7.0.0"
30+ - tuples: ">=7.0.0 <8.0.0"
31+ - typelevel-prelude: ">=7.0.0 <8.0.0"
32+ - unsafe-coerce: ">=6.0.0 <7.0.0"
33+ - variant: ">=8.0.0 <9.0.0"
3434 test:
3535 main: Test.Main
3636 dependencies:
src/Lunapark.purs−1
@@ -7,7 +7,6 @@ module Lunapark
77 , module Lunapark.Types
88 ) where
99
10−
1110import Lunapark.API (Lunapark, Interpreter(..), runInterpreter, BASE_EFFECTS, HandleLunaparkInput, handleLunapark, init, interpret, interpretW3CActions, jsonWireActions, runLunapark, runLunaparkActions, w3cActions)
1211import Lunapark.Error (Error(..), CachingError(..), printError)
1312import Lunapark.ActionF (ActionF(..), LUNAPARK_ACTIONS, TouchF(..), _lunaparkActions, buttonDown, buttonUp, click, doubleClick, doubleTap, flick, liftAction, longTap, moveTo, pause, scroll, sendKeys, tap, touchDown, touchUp)
src/Lunapark/API.purs+178−134
@@ -74,8 +74,9 @@ init uri caps = do
7474 actionsEnabled ←
7575 map isRight
7676 $ liftAff
77− $ LP.post uri (LP.InSession session : LP.Actions : Nil)
78− $ LT.encodeActionRequest $ FO.singleton "action-test"
77+ $ LP.post uri (LP.InSession session : LP.Actions : Nil)
78+ $ LT.encodeActionRequest
79+ $ FO.singleton "action-test"
7980 $ LT.NoSource [ LT.pause $ Milliseconds 0.0 ]
8081
8182 let
@@ -93,8 +94,8 @@ init uri caps = do
9394interpret
9495 ∷ ∀ r
9596 . HandleLunaparkInput
96− → Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r )
97− ~> Run (BASE_EFFECTS r)
97+ → Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r)
98+ ~> Run (BASE_EFFECTS r)
9899interpret input = runLunapark input <<< runLunaparkActions input
99100
100101type BASE_EFFECTS r = EXCEPT LE.Error + R.AFF + R.EFFECT + r
@@ -104,9 +105,10 @@ runLunapark input = do
104105 R.interpretRec (R.on _lunapark (handleLunapark input) R.send)
105106
106107runLunaparkActions
107− ∷ ∀ r. HandleLunaparkInput
108− → Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r )
109− ~> Run (BASE_EFFECTS + LUNAPARK + r)
108+ ∷ ∀ r
109+ . HandleLunaparkInput
110+ → Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r)
111+ ~> Run (BASE_EFFECTS + LUNAPARK + r)
110112runLunaparkActions input
111113 | input.actionsEnabled = interpretW3CActions Nil
112114 | otherwise = R.interpretRec (R.on _lunaparkActions (jsonWireActions input) R.send)
@@ -114,8 +116,8 @@ runLunaparkActions input
114116interpretW3CActions
115117 ∷ ∀ r
116118 . List LT.ActionSequence
117− → Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r )
118− ~> Run (BASE_EFFECTS + LUNAPARK + r )
119+ → Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r)
120+ ~> Run (BASE_EFFECTS + LUNAPARK + r)
119121interpretW3CActions acc as = case R.peel as of
120122 Left la → case tag la of
121123 Left a → w3cActions acc interpretW3CActions a
@@ -131,55 +133,83 @@ w3cActions
131133 ∷ ∀ r a
132134 . List LT.ActionSequence
133135 → ( List LT.ActionSequence
134− → Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r )
135− ~> Run (BASE_EFFECTS + LUNAPARK + r)
136+ → Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r)
137+ ~> Run (BASE_EFFECTS + LUNAPARK + r)
136138 )
137− → ActionF (Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r ) a)
139+ → ActionF (Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r) a)
138140 → Run (BASE_EFFECTS + LUNAPARK + r) a
139141w3cActions acc loop = case _ of
140142 Click btn next →
141− let seq = [ LT.pointerDown btn, LT.pointerUp btn ]
142− in loop (inMouse seq) next
143+ let
144+ seq = [ LT.pointerDown btn, LT.pointerUp btn ]
145+ in
146+ loop (inMouse seq) next
143147 ButtonDown btn next →
144− let seq = [ LT.pointerDown btn ]
145− in loop (inMouse seq) next
148+ let
149+ seq = [ LT.pointerDown btn ]
150+ in
151+ loop (inMouse seq) next
146152 ButtonUp btn next →
147− let seq = [ LT.pointerUp btn ]
148− in loop (inMouse seq) next
153+ let
154+ seq = [ LT.pointerUp btn ]
155+ in
156+ loop (inMouse seq) next
149157 DoubleClick btn next →
150− let seq = [ LT.pointerDown btn, LT.pointerUp btn, LT.pointerDown btn, LT.pointerUp btn ]
151− in loop (inMouse seq) next
158+ let
159+ seq = [ LT.pointerDown btn, LT.pointerUp btn, LT.pointerDown btn, LT.pointerUp btn ]
160+ in
161+ loop (inMouse seq) next
152162 MoveTo move next →
153− let seq = [ LT.pointerMove move ]
154− in loop (inPointer seq) next
163+ let
164+ seq = [ LT.pointerMove move ]
165+ in
166+ loop (inPointer seq) next
155167 SendKeys txt next →
156− let seq = T.foldMap (\ch → [ LT.keyDown ch, LT.keyUp ch ]) $ Str.toCharArray txt
157− in loop (inKeys seq) next
168+ let
169+ seq = T.foldMap (\ch → [ LT.keyDown ch, LT.keyUp ch ]) $ Str.toCharArray txt
170+ in
171+ loop (inKeys seq) next
158172 Pause ms next →
159− let seq = [ LT.pause ms ]
160− in loop (anywhere seq) next
173+ let
174+ seq = [ LT.pause ms ]
175+ in
176+ loop (anywhere seq) next
161177 InTouch tch → case tch of
162178 Tap next →
163− let seq = [ LT.pointerDown LT.LeftBtn, LT.pointerUp LT.LeftBtn ]
164− in loop (inTouch seq) next
179+ let
180+ seq = [ LT.pointerDown LT.LeftBtn, LT.pointerUp LT.LeftBtn ]
181+ in
182+ loop (inTouch seq) next
165183 TouchDown next →
166− let seq = [ LT.pointerDown LT.LeftBtn ]
167− in loop (inTouch seq) next
184+ let
185+ seq = [ LT.pointerDown LT.LeftBtn ]
186+ in
187+ loop (inTouch seq) next
168188 TouchUp next →
169− let seq = [ LT.pointerUp LT.LeftBtn ]
170− in loop (inTouch seq) next
189+ let
190+ seq = [ LT.pointerUp LT.LeftBtn ]
191+ in
192+ loop (inTouch seq) next
171193 LongClick next →
172− let seq = [ LT.pointerDown LT.LeftBtn, LT.pause (Milliseconds 3000.0), LT.pointerUp LT.LeftBtn ]
173− in loop (inTouch seq) next
194+ let
195+ seq = [ LT.pointerDown LT.LeftBtn, LT.pause (Milliseconds 3000.0), LT.pointerUp LT.LeftBtn ]
196+ in
197+ loop (inTouch seq) next
174198 Flick move next →
175− let seq = [ LT.pointerMove move ]
176− in loop (inTouch seq) next
199+ let
200+ seq = [ LT.pointerMove move ]
201+ in
202+ loop (inTouch seq) next
177203 Scroll move next →
178− let seq = [ LT.pointerMove move ]
179− in loop (inTouch seq) next
204+ let
205+ seq = [ LT.pointerMove move ]
206+ in
207+ loop (inTouch seq) next
180208 DoubleTap next →
181− let seq = [ LT.pointerDown LT.LeftBtn, LT.pointerUp LT.LeftBtn, LT.pointerDown LT.LeftBtn, LT.pointerUp LT.LeftBtn ]
182− in loop (inTouch seq) next
209+ let
210+ seq = [ LT.pointerDown LT.LeftBtn, LT.pointerUp LT.LeftBtn, LT.pointerDown LT.LeftBtn, LT.pointerUp LT.LeftBtn ]
211+ in
212+ loop (inTouch seq) next
183213 where
184214 unconsed = L.uncons acc
185215
@@ -354,19 +384,22 @@ handleLunapark inp = case _ of
354384 pure next
355385 GetWindowRectangle cont → do
356386 res ← tryAndCache "get window rectangle"
357− [ do res ← get (inSession : LP.Window : LP.Rect : Nil)
358− rethrowAsJsonDecodeError $ LT.decodeRectangle res
359− , do position ← get (inSession : LP.Window : LP.Position : Nil)
360− size ← get (inSession : LP.Window : LP.Size : Nil)
361− rethrowAsJsonDecodeError $ LT.decodeRectangleLegacy { position, size }
387+ [ do
388+ res ← get (inSession : LP.Window : LP.Rect : Nil)
389+ rethrowAsJsonDecodeError $ LT.decodeRectangle res
390+ , do
391+ position ← get (inSession : LP.Window : LP.Position : Nil)
392+ size ← get (inSession : LP.Window : LP.Size : Nil)
393+ rethrowAsJsonDecodeError $ LT.decodeRectangleLegacy { position, size }
362394 ]
363395 pure $ cont res
364396 SetWindowRectangle r next → do
365397 tryAndCache "set window rectangle"
366398 [ void $ post (inSession : LP.Window : LP.Rect : Nil) (LT.encodeRectangle r)
367− , do let js = LT.encodeRectangleLegacy r
368− _ ← post (inSession : LP.Window : LP.Size : Nil) js.size
369− void $ post (inSession : LP.Window : LP.Position : Nil) js.position
399+ , do
400+ let js = LT.encodeRectangleLegacy r
401+ _ ← post (inSession : LP.Window : LP.Size : Nil) js.size
402+ void $ post (inSession : LP.Window : LP.Position : Nil) js.position
370403 ]
371404 pure next
372405 MaximizeWindow next → do
@@ -444,91 +477,100 @@ handleLunapark inp = case _ of
444477 map cont $ rethrowAsJsonDecodeError $ LT.decodeElement res
445478 PerformActions req next → do
446479 when inp.actionsEnabled
447− $ void $ post
448− (inSession : LP.Actions : Nil)
449− (LT.encodeActionRequest req)
480+ $ void
481+ $ post
482+ (inSession : LP.Actions : Nil)
483+ (LT.encodeActionRequest req)
450484 pure next
451485 ReleaseActions next → do
452486 when inp.actionsEnabled $ void $ delete (inSession : LP.Actions : Nil)
453487 pure next
454488 OnElement el elF →
455− let inElement = LP.InElement el
456− in case elF of
457− ChildElement loc cont → do
458− res ← post (inSession : inElement : LP.Element : Nil) (LT.encodeLocator loc)
459− map cont $ rethrowAsJsonDecodeError $ LT.decodeElement res
460− ChildElements loc cont → do
461− res ← post (inSession : inElement : LP.Elements : Nil) (LT.encodeLocator loc)
462− map cont $ rethrowAsJsonDecodeError $ T.traverse LT.decodeElement =<< J.decodeJson res
463− ScreenshotEl fp next → do
464− res ← get (inSession : inElement : LP.Screenshot : Nil)
465− screenshotPack ← rethrowAsJsonDecodeError $ LT.decodeScreenshot res
466− buffer ← R.liftEffect $ B.fromString screenshotPack.content screenshotPack.encoding
467− R.liftAff $ FS.writeFile fp buffer
468− pure next
469− IsSelected cont → do
470− res ← get (inSession : inElement : LP.Selected : Nil)
471− map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
472− GetAttribute attr cont → do
473− res ← get (inSession : inElement : LP.Attribute attr : Nil)
474− map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
475− GetProperty prop cont → do
476− map cont $ get (inSession : inElement : LP.Property prop : Nil)
477− GetCss css cont → do
478− res ← get (inSession : inElement : LP.CssValue css : Nil)
479− map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
480− GetText cont → do
481− res ← get (inSession : inElement : LP.Text : Nil)
482− map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
483− GetTagName cont → do
484− res ← get (inSession : inElement : LP.Name : Nil)
485− map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
486− GetRectangle cont →
487− map cont $ tryAndCache "get element rectangle"
488− [ do res ← get (inSession : inElement : LP.Rect : Nil)
489− rethrowAsJsonDecodeError $ LT.decodeRectangle res
490− , do position ← get (inSession : inElement : LP.Position : Nil)
491− size ← get (inSession : inElement : LP.Size : Nil)
492− rethrowAsJsonDecodeError $ LT.decodeRectangleLegacy { position, size }
493− ]
494− IsEnabled cont → do
495− res ← get (inSession : inElement : LP.Enabled : Nil)
496− map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
497− ClickEl next → do
498− _ ← tryAndCache "chromedriver75 update clickElement"
499− [ post' (inSession : inElement : LP.Click : Nil)
500− , post (inSession : inElement : LP.Click : Nil) $ LT.encodeElement el
501− ]
502− pure next
503− ClearEl next → do
504− _ ← tryAndCache "chromedriver75 update clearElement"
505− [ post' (inSession : inElement : LP.Clear : Nil)
506− , post (inSession : inElement : LP.Click : Nil) $ LT.encodeElement el
507− ]
508− pure next
509− SendKeysEl txt next → do
510− _ ← tryAndCache "send keys chromedriver hack"
511− [ post (inSession : inElement : LP.Value : Nil) (LT.encodeSendKeysRequest txt)
512− , post (inSession : inElement : LP.Value : Nil)
513− $ J.encodeJson $ FO.singleton "value" $ Str.toCharArray txt
514− ]
515− pure next
516− IsDisplayed cont → do
517− res ← tryAndCache "is element displayed"
518− [ get (inSession : inElement : LP.Displayed : Nil)
519− , do let script =
520− { script: """var el = arguments[0]; return el.offsetHeight > 0 && el.offsetWidth > 0"""
521− , args: [ LT.encodeElement el ]
522− }
523− handleLunapark inp $ ExecuteScript script identity
524− ]
525− map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
526− Submit next → do
527− _ ← tryAndCache "chromedriver75 update submit form"
528− [ post' (inSession : inElement : LP.Submit : Nil)
529− , post (inSession: inElement : LP.Submit : Nil) $ LT.encodeElement el
530− ]
531− pure next
489+ let
490+ inElement = LP.InElement el
491+ in
492+ case elF of
493+ ChildElement loc cont → do
494+ res ← post (inSession : inElement : LP.Element : Nil) (LT.encodeLocator loc)
495+ map cont $ rethrowAsJsonDecodeError $ LT.decodeElement res
496+ ChildElements loc cont → do
497+ res ← post (inSession : inElement : LP.Elements : Nil) (LT.encodeLocator loc)
498+ map cont $ rethrowAsJsonDecodeError $ T.traverse LT.decodeElement =<< J.decodeJson res
499+ ScreenshotEl fp next → do
500+ res ← get (inSession : inElement : LP.Screenshot : Nil)
501+ screenshotPack ← rethrowAsJsonDecodeError $ LT.decodeScreenshot res
502+ buffer ← R.liftEffect $ B.fromString screenshotPack.content screenshotPack.encoding
503+ R.liftAff $ FS.writeFile fp buffer
504+ pure next
505+ IsSelected cont → do
506+ res ← get (inSession : inElement : LP.Selected : Nil)
507+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
508+ GetAttribute attr cont → do
509+ res ← get (inSession : inElement : LP.Attribute attr : Nil)
510+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
511+ GetProperty prop cont → do
512+ map cont $ get (inSession : inElement : LP.Property prop : Nil)
513+ GetCss css cont → do
514+ res ← get (inSession : inElement : LP.CssValue css : Nil)
515+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
516+ GetText cont → do
517+ res ← get (inSession : inElement : LP.Text : Nil)
518+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
519+ GetTagName cont → do
520+ res ← get (inSession : inElement : LP.Name : Nil)
521+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
522+ GetRectangle cont →
523+ map cont $ tryAndCache "get element rectangle"
524+ [ do
525+ res ← get (inSession : inElement : LP.Rect : Nil)
526+ rethrowAsJsonDecodeError $ LT.decodeRectangle res
527+ , do
528+ position ← get (inSession : inElement : LP.Position : Nil)
529+ size ← get (inSession : inElement : LP.Size : Nil)
530+ rethrowAsJsonDecodeError $ LT.decodeRectangleLegacy { position, size }
531+ ]
532+ IsEnabled cont → do
533+ res ← get (inSession : inElement : LP.Enabled : Nil)
534+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
535+ ClickEl next → do
536+ _ ← tryAndCache "chromedriver75 update clickElement"
537+ [ post' (inSession : inElement : LP.Click : Nil)
538+ , post (inSession : inElement : LP.Click : Nil) $ LT.encodeElement el
539+ ]
540+ pure next
541+ ClearEl next → do
542+ _ ← tryAndCache "chromedriver75 update clearElement"
543+ [ post' (inSession : inElement : LP.Clear : Nil)
544+ , post (inSession : inElement : LP.Click : Nil) $ LT.encodeElement el
545+ ]
546+ pure next
547+ SendKeysEl txt next → do
548+ _ ← tryAndCache "send keys chromedriver hack"
549+ [ post (inSession : inElement : LP.Value : Nil) (LT.encodeSendKeysRequest txt)
550+ , post (inSession : inElement : LP.Value : Nil)
551+ $ J.encodeJson
552+ $ FO.singleton "value"
553+ $ Str.toCharArray txt
554+ ]
555+ pure next
556+ IsDisplayed cont → do
557+ res ← tryAndCache "is element displayed"
558+ [ get (inSession : inElement : LP.Displayed : Nil)
559+ , do
560+ let
561+ script =
562+ { script: """var el = arguments[0]; return el.offsetHeight > 0 && el.offsetWidth > 0"""
563+ , args: [ LT.encodeElement el ]
564+ }
565+ handleLunapark inp $ ExecuteScript script identity
566+ ]
567+ map cont $ rethrowAsJsonDecodeError $ J.decodeJson res
568+ Submit next → do
569+ _ ← tryAndCache "chromedriver75 update submit form"
570+ [ post' (inSession : inElement : LP.Submit : Nil)
571+ , post (inSession : inElement : LP.Submit : Nil) $ LT.encodeElement el
572+ ]
573+ pure next
532574
533575 where
534576 delete a = liftAndRethrow $ LP.delete inp.uri a
@@ -548,13 +590,15 @@ handleLunapark inp = case _ of
548590 Nothing →
549591 let
550592 go ix acc act =
551− let try' = do
552− a ← act
553− R.liftEffect $ Ref.modify_ (Map.insert key ix) inp.requestMapRef
554− pure a
555− in catch try' \_ → acc
593+ let
594+ try' = do
595+ a ← act
596+ R.liftEffect $ Ref.modify_ (Map.insert key ix) inp.requestMapRef
597+ pure a
598+ in
599+ catch try' \_ → acc
556600 in
557− FI.foldlWithIndex go (RE.throw $ LE.CachingError $ LE.EmptyCases key) actions
601+ FI.foldlWithIndex go (RE.throw $ LE.CachingError $ LE.EmptyCases key) actions
558602
559603 inSession ∷ LP.EndpointPart
560604 inSession = LP.InSession inp.session
src/Lunapark/ActionF.purs+1−1
@@ -31,7 +31,7 @@ derive instance functorActionF ∷ Functor ActionF
3131derive instance functorTouchF ∷ Functor TouchF
3232
3333_lunaparkActions = Proxy ∷ Proxy "lunaparkActions"
34−type LUNAPARK_ACTIONS r = ( lunaparkActions ∷ ActionF | r )
34+type LUNAPARK_ACTIONS r = (lunaparkActions ∷ ActionF | r)
3535
3636liftAction ∷ ∀ r. ActionF Unit → Run (LUNAPARK_ACTIONS r) Unit
3737liftAction = R.lift _lunaparkActions
src/Lunapark/Endpoint.purs+2−3
@@ -9,8 +9,7 @@ module Lunapark.Endpoint
99 , post
1010 , post'
1111 , EndpointPart(..)
12− )
13− where
12+ ) where
1413
1514import Prelude
1615
@@ -188,7 +187,7 @@ handleAPIError (Right r) = case r.status of
188187 Left $ either LE.JsonDecodeError LE.WebDriverError $ LWE.fromJson r.body
189188
190189get ∷ String → Endpoint → Aff (Either LE.Error Json)
191−get uri ep = map handleAPIError $ N.get NR.json (uri <> print ep)
190+get uri ep = map handleAPIError $ N.get NR.json (uri <> print ep)
192191
193192post ∷ String → Endpoint → Json → Aff (Either LE.Error Json)
194193post uri ep obj = map handleAPIError $ N.post NR.json (uri <> print ep) $ Just (NQ.json obj)
src/Lunapark/Error.purs+11−6
@@ -21,14 +21,19 @@ printError = case _ of
2121 J.printJsonDecodeError jsonDecodeError
2222 WebDriverError webdriverError →
2323 "Response with error message:\n"
24− <> " error type: " <> LWE.toStringCode webdriverError.error <> "\n"
25− <> " message: " <> webdriverError.message <> "\n"
26− <> " stacktrace: " <> webdriverError.stacktrace
24+ <> " error type: "
25+ <> LWE.toStringCode webdriverError.error
26+ <> "\n"
27+ <> " message: "
28+ <> webdriverError.message
29+ <> "\n"
30+ <> " stacktrace: "
31+ <> webdriverError.stacktrace
2732 AffjaxError affjaxError →
2833 N.printError affjaxError
2934 CachingError cachingError →
3035 "Error during caching:\n " <> printCachingError cachingError
3136 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."
37+ printCachingError = case _ of
38+ EmptyCases key → "There is no working implementation for " <> key <> " action."
39+ IncorrectCache key → "Trying another implementation for " <> key <> " action."
src/Lunapark/LunaparkF.purs+1−1
@@ -72,7 +72,7 @@ derive instance functorElementF ∷ Functor ElementF
7272
7373_lunapark = Proxy ∷ Proxy "lunapark"
7474
75−type LUNAPARK r = ( lunapark ∷ LunaparkF | r )
75+type LUNAPARK r = (lunapark ∷ LunaparkF | r)
7676
7777liftLunapark ∷ ∀ a r. LunaparkF a → Run (LUNAPARK r) a
7878liftLunapark = R.lift _lunapark
src/Lunapark/Types.purs+42−45
@@ -68,9 +68,9 @@ decodeSessionId ∷ J.Json → Either J.JsonDecodeError SessionId
6868decodeSessionId = map SessionId <<< J.decodeJson
6969
7070type CreateSessionResponse =
71− { session ∷ SessionId
72− , capabilities ∷ Array Capability
73− }
71+ { session ∷ SessionId
72+ , capabilities ∷ Array Capability
73+ }
7474
7575decodeCreateSessionResponse ∷ J.Json → Either J.JsonDecodeError CreateSessionResponse
7676decodeCreateSessionResponse = J.decodeJson >=> \obj → do
@@ -145,7 +145,7 @@ decodeRectangle = J.decodeJson >=> \obj → do
145145 y ← obj .: "y"
146146 pure { width, height, x, y }
147147
148−decodeRectangleLegacy ∷ { size ∷ J.Json, position ∷ J.Json } → Either J.JsonDecodeError 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
@@ -236,14 +236,15 @@ type Cookie =
236236encodeCookie ∷ Cookie → J.Json
237237encodeCookie r = J.encodeJson $ FO.fromFoldable
238238 [ Tuple "cookie" $ FO.fromFoldable
239− $ [ Tuple "name" $ J.encodeJson r.name
240− , Tuple "value" $ J.encodeJson r.value
241− ]
242− <> maybeToAOfPair "path" r.path
243− <> maybeToAOfPair "domain" r.domain
244− <> maybeToAOfPair "secure" r.secure
245− <> maybeToAOfPair "httpOnly" r.httpOnly
246− <> maybeToAOfPair "expiry" r.expiry
239+ $
240+ [ Tuple "name" $ J.encodeJson r.name
241+ , Tuple "value" $ J.encodeJson r.value
242+ ]
243+ <> maybeToAOfPair "path" r.path
244+ <> maybeToAOfPair "domain" r.domain
245+ <> maybeToAOfPair "secure" r.secure
246+ <> maybeToAOfPair "httpOnly" r.httpOnly
247+ <> maybeToAOfPair "expiry" r.expiry
247248 ]
248249 where
249250 maybeToAOfPair ∷ ∀ a. J.EncodeJson a ⇒ String → Maybe a → Array (Tuple String J.Json)
@@ -271,7 +272,6 @@ decodeCookie = J.decodeJson >=> \obj → do
271272 maybify ∷ ∀ a b. Either a b → Either a (Maybe b)
272273 maybify e = map Just e <|> Right Nothing
273274
274−
275275type Screenshot =
276276 { content ∷ String
277277 , encoding ∷ NE.Encoding
@@ -315,7 +315,6 @@ encodePointerMove r = FO.fromFoldable
315315 , Tuple "origin" $ encodeOrigin r.origin
316316 ]
317317
318−
319318type Action = V.Variant
320319 ( pause ∷ Milliseconds
321320 , keyDown ∷ Char
@@ -325,56 +324,55 @@ type Action = V.Variant
325324 , pointerMove ∷ PointerMove
326325 )
327326
328−pause ∷ ∀ r a. a → V.Variant (pause ∷ a|r)
327+pause ∷ ∀ r a. a → V.Variant (pause ∷ a | r)
329328pause = V.inj (Proxy ∷ Proxy "pause")
330329
331−keyDown ∷ ∀ r a. a → V.Variant (keyDown ∷ a|r)
330+keyDown ∷ ∀ r a. a → V.Variant (keyDown ∷ a | r)
332331keyDown = V.inj (Proxy ∷ Proxy "keyDown")
333332
334−keyUp ∷ ∀ r a. a → V.Variant (keyUp ∷ a|r)
333+keyUp ∷ ∀ r a. a → V.Variant (keyUp ∷ a | r)
335334keyUp = V.inj (Proxy ∷ Proxy "keyUp")
336335
337−pointerUp ∷ ∀ r a. a → V.Variant (pointerUp ∷ a|r)
336+pointerUp ∷ ∀ r a. a → V.Variant (pointerUp ∷ a | r)
338337pointerUp = V.inj (Proxy ∷ Proxy "pointerUp")
339338
340−pointerDown ∷ ∀ r a. a → V.Variant (pointerDown ∷ a|r)
339+pointerDown ∷ ∀ r a. a → V.Variant (pointerDown ∷ a | r)
341340pointerDown = V.inj (Proxy ∷ Proxy "pointerDown")
342341
343−pointerMove ∷ ∀ r a. a → V.Variant (pointerMove ∷ a|r)
342+pointerMove ∷ ∀ r a. a → V.Variant (pointerMove ∷ a | r)
344343pointerMove = V.inj (Proxy ∷ Proxy "pointerMove")
345344
346345encodeAction ∷ Action → J.Json
347346encodeAction = V.match
348347 { pause: \ms →
349− J.encodeJson $ FO.fromFoldable
350− [ Tuple "duration" $ J.encodeJson $ un Milliseconds ms
351− , Tuple "type" $ J.encodeJson "pause"
352− ]
348+ J.encodeJson $ FO.fromFoldable
349+ [ Tuple "duration" $ J.encodeJson $ un Milliseconds ms
350+ , Tuple "type" $ J.encodeJson "pause"
351+ ]
353352 , keyDown: \ch →
354− J.encodeJson $ FO.fromFoldable
355− [ Tuple "value" $ J.encodeJson ch
356− , Tuple "type" $ J.encodeJson "keyDown"
357− ]
353+ J.encodeJson $ FO.fromFoldable
354+ [ Tuple "value" $ J.encodeJson ch
355+ , Tuple "type" $ J.encodeJson "keyDown"
356+ ]
358357 , keyUp: \ch →
359− J.encodeJson $ FO.fromFoldable
360− [ Tuple "value" $ J.encodeJson ch
361− , Tuple "type" $ J.encodeJson "keyUp"
362− ]
358+ J.encodeJson $ FO.fromFoldable
359+ [ Tuple "value" $ J.encodeJson ch
360+ , Tuple "type" $ J.encodeJson "keyUp"
361+ ]
363362 , pointerUp: \btn →
364− J.encodeJson $ FO.fromFoldable
365− [ Tuple "button" $ encodeButton btn
366− , Tuple "type" $ J.encodeJson "pointerUp"
367− ]
363+ J.encodeJson $ FO.fromFoldable
364+ [ Tuple "button" $ encodeButton btn
365+ , Tuple "type" $ J.encodeJson "pointerUp"
366+ ]
368367 , pointerDown: \btn →
369− J.encodeJson $ FO.fromFoldable
370− [ Tuple "button" $ encodeButton btn
371− , Tuple "type" $ J.encodeJson "pointerDown"
372− ]
368+ J.encodeJson $ FO.fromFoldable
369+ [ Tuple "button" $ encodeButton btn
370+ , Tuple "type" $ J.encodeJson "pointerDown"
371+ ]
373372 , pointerMove: \pm →
374− J.encodeJson $ FO.insert "type" (J.encodeJson "pointerMove") $ encodePointerMove pm
373+ J.encodeJson $ FO.insert "type" (J.encodeJson "pointerMove") $ encodePointerMove pm
375374 }
376375
377−
378376data PointerType = Mouse | Pen | Touch
379377
380378printPointerType ∷ PointerType → String
@@ -464,7 +462,6 @@ data Capability
464462 | UnhandledPromptBehavior UnhandledPrompt
465463 | CustomCapability String J.Json
466464
467−
468465encodeCapability ∷ Capability → Tuple String J.Json
469466encodeCapability = case _ of
470467 BrowserName bn → Tuple "browserName" $ J.encodeJson case bn of
@@ -546,8 +543,8 @@ type MoveToRequest =
546543encodeMoveToRequest ∷ MoveToRequest → J.Json
547544encodeMoveToRequest r = J.encodeJson $ FO.fromFoldable
548545 [ Tuple "element" $ case r.element of
549− Nothing → J.jsonNull
550− Just el → J.encodeJson $ un Element el
546+ Nothing → J.jsonNull
547+ Just el → J.encodeJson $ un Element el
551548 , Tuple "xoffset" $ J.encodeJson r.xoffset
552549 , Tuple "yoffset" $ J.encodeJson r.yoffset
553550 ]
src/Lunapark/Utils.purs+1−1
@@ -23,7 +23,7 @@ liftAndRethrow a = do
2323rethrowAsJsonDecodeError
2424 ∷ ∀ r
2525 . Either J.JsonDecodeError
26− ~> R.Run (RE.EXCEPT LE.Error + r)
26+ ~> R.Run (RE.EXCEPT LE.Error + r)
2727rethrowAsJsonDecodeError =
2828 RE.rethrow <<< lmap LE.JsonDecodeError
2929