git.iko.soy/rowtype-yoga/purescript-lunapark
on main help sign in
added all endpoints
commitac7f5fff7e6e0771f2bda249e5990b2e2b5979b1 authorMaxim Zimaliev <zimaliev@gmail.com> dateMon 16 Apr 2018, 11:47 (8 years ago) parent6335fd6
8 files changed+238−37
compare with main
unifiedsplit
chromedriver.exe geckodriver.exe src/Lunapark/API.purs+3−3 src/Lunapark/Affjax.purs+130−5 src/Lunapark/Helpers.purs+49−2 src/Lunapark/Starter.purs+1−1 src/Lunapark/Types.purs+29−8 src/Main.purs+26−18
chromedriver.exedeleted

Binary file not shown.

geckodriver.exedeleted

Binary file not shown.

src/Lunapark/API.purs+3−3
@@ -18,7 +18,7 @@ import Lunapark.Error as LE
1818import Lunapark.Types as LT
1919import Network.HTTP.Affjax (AJAX)
2020
21−import Debug.Trace (traceAnyM)
21+import Debug.Trace as DT
2222
2323type Config =
2424 { session ∷ LT.SessionId
@@ -413,7 +413,7 @@ performActions req = do
413413 void $ rethrow $ LA.performActions
414414 r.baseURI
415415 (un LT.SessionId r.session)
416− (LT.encodeActionRequest req)
416+ (DT.spy $ LT.encodeActionRequest req)
417417
418418releaseActions ∷ ∀ m e. LunaparkConstraints e m (m Unit)
419419releaseActions = do
@@ -455,7 +455,7 @@ takeScreenshot = do
455455takeElementScreenshot ∷ ∀ m e. LunaparkConstraints e m (LT.Element → m LT.Screenshot)
456456takeElementScreenshot el = do
457457 r ← ask
458− res ← rethrow $ traceAnyM =<< LA.takeElementScreenshot
458+ res ← rethrow $ LA.takeElementScreenshot
459459 r.baseURI
460460 (un LT.SessionId r.session)
461461 (un LT.Element el)
src/Lunapark/Affjax.purs+130−5
@@ -12,13 +12,13 @@ import Network.HTTP.Affjax (AJAX)
1212import Network.HTTP.Affjax as N
1313import Network.HTTP.StatusCode (StatusCode(..))
1414import Lunapark.Error as LE
15−import Debug.Trace (traceAnyM)
1615
1716-- | This two type synonims are used only here
1817-- | this is the lowest level of bindings this lib provides
1918type URI = String
2019type SessionId = String
2120type ElementId = String
21+type WindowHandle = String
2222
2323handleAPIError ∷ N.AffjaxResponse Json → Either LE.Error Json
2424handleAPIError r = case r.status of
@@ -71,8 +71,8 @@ getTitle ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error
7171getTitle uri sessId =
7272 map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/title")
7373
74−getWindowHandle ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
75−getWindowHandle uri sessId =
74+getWindow ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
75+getWindow uri sessId =
7676 map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/window")
7777
7878closeWindow ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
@@ -240,14 +240,139 @@ takeScreenshot uri sessId =
240240
241241takeElementScreenshot ∷ ∀ e. URI → SessionId → ElementId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
242242takeElementScreenshot uri sessId elId =
243− map handleAPIError $ traceAnyM =<< N.get (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/screenshot")
243+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/screenshot")
244244
245245-- Recomended by W3C
246246isDisplayed ∷ ∀ e. URI → SessionId → ElementId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
247247isDisplayed uri sessId elId = do
248248 map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/displayed")
249249
250−-- JsonWire legacy
250+-- JsonWire legacy, note this wouldn't envolve thing like local storage or geolocation
251+-- because you always could do it via async script _OR_ you couldn't do it via W3C
251252getSession ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
252253getSession uri sessId =
253254 map handleAPIError $ N.get (uri <> "/session/" <> sessId)
255+
256+getSessions ∷ ∀ e. URI → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
257+getSessions uri =
258+ map handleAPIError $ N.get (uri <> "/sessions")
259+
260+setAsyncScriptTimeout ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
261+setAsyncScriptTimeout uri sessId obj =
262+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/timeouts/async_script") obj
263+
264+getWindowHandle ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
265+getWindowHandle uri sessId =
266+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/window_handle")
267+
268+getWindowHandlesLegacy ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
269+getWindowHandlesLegacy uri sessId =
270+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/window_handles")
271+
272+execute ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
273+execute uri sessId obj =
274+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/execute") obj
275+
276+executeAsync ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
277+executeAsync uri sessId obj =
278+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/execute_async") obj
279+
280+setWindowSize ∷ ∀ e. URI → SessionId → WindowHandle → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
281+setWindowSize uri sessId win obj =
282+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/window/" <> win <> "/size") obj
283+
284+getWindowSize ∷ ∀ e. URI → SessionId → WindowHandle → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
285+getWindowSize uri sessId win =
286+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/window/" <> win <> "/size")
287+
288+setWindowPosition ∷ ∀ e. URI → SessionId → WindowHandle → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
289+setWindowPosition uri sessId win obj =
290+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/window/" <> win <> "/position") obj
291+
292+getWindowPosition ∷ ∀ e. URI → SessionId → WindowHandle → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
293+getWindowPosition uri sessId win =
294+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/window/" <> win <> "/position")
295+
296+elementSubmit ∷ ∀ e. URI → SessionId → ElementId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
297+elementSubmit uri sessId elId =
298+ map handleAPIError $ N.post' (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/submit") (Nothing ∷ Maybe Unit)
299+
300+sendKeys ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
301+sendKeys uri sessId obj =
302+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/keys") obj
303+
304+getElementLocation ∷ ∀ e. URI → SessionId → ElementId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
305+getElementLocation uri sessId elId =
306+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/location")
307+
308+getElementSize ∷ ∀ e. URI → SessionId → ElementId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
309+getElementSize uri sessId elId =
310+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/size")
311+
312+getAlertTextLegacy ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
313+getAlertTextLegacy uri sessId =
314+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/alert_text")
315+
316+setAlertText ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
317+setAlertText uri sessId obj =
318+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/alert_text") obj
319+
320+acceptAlertLegacy ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
321+acceptAlertLegacy uri sessId =
322+ map handleAPIError $ N.post' (uri <> "/session/" <> sessId <> "/accept_alert") (Nothing ∷ Maybe Unit)
323+
324+dismissAlertLegacy ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
325+dismissAlertLegacy uri sessId =
326+ map handleAPIError $ N.post' (uri <> "/session/" <> sessId <> "/dismiss_alert") (Nothing ∷ Maybe Unit)
327+
328+moveTo ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
329+moveTo uri sessId obj =
330+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/moveto") obj
331+
332+sendClick ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
333+sendClick uri sessId obj =
334+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/click") obj
335+
336+sendButtonDown ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
337+sendButtonDown uri sessId obj =
338+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/buttondown") obj
339+
340+sendButtonUp ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
341+sendButtonUp uri sessId obj =
342+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/buttonup") obj
343+
344+sendDoubleClick ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
345+sendDoubleClick uri sessId obj =
346+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/doubleclick") obj
347+
348+sendTouch ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
349+sendTouch uri sessId obj =
350+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/touch/click") obj
351+
352+sendTouchDown ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
353+sendTouchDown uri sessId obj =
354+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/touch/down") obj
355+
356+sendTouchUp ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
357+sendTouchUp uri sessId obj =
358+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/touch/up") obj
359+
360+sendTouchMove ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
361+sendTouchMove uri sessId obj =
362+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/touch/move") obj
363+
364+sendTouchScroll ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
365+sendTouchScroll uri sessId obj =
366+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/touch/scroll") obj
367+
368+sendTouchDoubleClick ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
369+sendTouchDoubleClick uri sessId obj =
370+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/touch/doubleclick") obj
371+
372+sendTouchLongClick ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
373+sendTouchLongClick uri sessId obj =
374+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/touch/longclick") obj
375+
376+sendTouchFlick ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
377+sendTouchFlick uri sessId obj =
378+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/touch/flick") obj
src/Lunapark/Helpers.purs+49−2
@@ -10,12 +10,15 @@ import Control.Monad.Eff.Ref as Ref
1010import Control.Monad.Error.Class as EC
1111import Control.Monad.State.Class as SC
1212import Data.Argonaut as J
13−import Data.Maybe (Maybe(..))
13+import Data.FoldableWithIndex as FI
14+import Data.StrMap as SM
15+import Data.Symbol (SProxy(..))
16+import Data.Time.Duration (Milliseconds(..))
17+import Data.Variant as V
1418import Lunapark.API as LA
1519import Lunapark.Error as LE
1620import Lunapark.Types as LT
1721import Node.Buffer as B
18−import Node.FS (FileFlags(W))
1922import Node.FS.Aff as FS
2023import Node.Path as Path
2124
@@ -112,3 +115,47 @@ elementScreenshot el fp = do
112115 buffer ← liftEff $ B.fromString res.content res.encoding
113116 liftAff do
114117 FS.writeFile fp buffer
118+
119+pause ∷ ∀ e a. a → V.Variant (pause ∷ a|e)
120+pause = V.inj (SProxy ∷ SProxy "pause")
121+
122+keyDown ∷ ∀ e a. a → V.Variant (keyDown ∷ a|e)
123+keyDown = V.inj (SProxy ∷ SProxy "keyDown")
124+
125+keyUp ∷ ∀ e a. a → V.Variant (keyUp ∷ a|e)
126+keyUp = V.inj (SProxy ∷ SProxy "keyUp")
127+
128+pointerUp ∷ ∀ a e. a → V.Variant (pointerUp ∷ a|e)
129+pointerUp = V.inj (SProxy ∷ SProxy "pointerUp")
130+
131+pointerDown ∷ ∀ a e. a → V.Variant (pointerDown ∷ a|e)
132+pointerDown = V.inj (SProxy ∷ SProxy "pointerDown")
133+
134+pointerMove ∷ ∀ a e. a → V.Variant (pointerMove ∷ a|e)
135+pointerMove = V.inj (SProxy ∷ SProxy "pointerMove")
136+
137+click ∷ LT.Button → _ --LT.ActionSequence
138+click btn =
139+ [ pointerDown btn
140+ , pointerUp btn
141+ ]
142+
143+leftClick ∷ _ -- LT.ActionSequence
144+leftClick = click LT.LeftBtn
145+
146+rightClick ∷ _ --LT.ActionSequence
147+rightClick = click LT.RightBtn
148+
149+doubleClick ∷ _ -- LT.ActionSequence
150+doubleClick = LT.Pointer LT.Mouse
151+ [ pointerDown LT.LeftBtn
152+ , pointerUp LT.LeftBtn
153+ , pointerDown LT.LeftBtn
154+ , pointerUp LT.LeftBtn
155+ ]
156+
157+moveToElement ∷ LT.Element → LT.PointerMove
158+moveToElement el = { duration: Milliseconds 100.0, origin: LT.FromElement el, x: 0, y: 0 }
159+
160+performActions ∷ ∀ f s e m. Show s ⇒ FI.FoldableWithIndex s f ⇒ LA.LunaparkConstraints e m (f LT.ActionSequence → m Unit)
161+performActions fs = LA.performActions $ FI.foldlWithIndex (\i acc a → SM.insert (show i) a acc) SM.empty fs
src/Lunapark/Starter.purs+1−1
@@ -23,7 +23,7 @@ start drivers jarPath additionalParams = do
2323 preparedJar ← liftAff $ FS.realpath jarPath
2424 preparedDrivers ← liftAff $ T.traverse FS.realpath drivers
2525
26− liftEff $ CP.execFile
26+ liftEff $ CP.exec
2727 ("java "
2828 <> T.intercalate " " (LT.renderDriverPaths preparedDrivers)
2929 <> " -jar " <> preparedJar <> " "
src/Lunapark/Types.purs+29−8
@@ -270,8 +270,8 @@ type PointerMove =
270270 , y ∷ Int
271271 }
272272
273−encodePointerMove ∷ PointerMove → Json
274−encodePointerMove r = J.encodeJson $ SM.fromFoldable
273+encodePointerMove ∷ PointerMove → SM.StrMap Json
274+encodePointerMove r = SM.fromFoldable
275275 [ Tuple "x" $ J.encodeJson r.x
276276 , Tuple "y" $ J.encodeJson r.y
277277 , Tuple "duration" $ J.encodeJson $ un Milliseconds r.duration
@@ -290,12 +290,33 @@ type Action = V.Variant
290290
291291encodeAction ∷ Action → Json
292292encodeAction = V.match
293− { pause: \ms → J.encodeJson $ SM.singleton "duration" $ J.encodeJson $ un Milliseconds ms
294− , keyDown: \ch → J.encodeJson $ SM.singleton "value" $ J.encodeJson ch
295− , keyUp: \ch → J.encodeJson $ SM.singleton "value" $ J.encodeJson ch
296− , pointerUp: \btn → J.encodeJson $ SM.singleton "button" $ encodeButton btn
297− , pointerDown: \btn → J.encodeJson $ SM.singleton "button" $ encodeButton btn
298− , pointerMove: encodePointerMove
293+ { pause: \ms →
294+ J.encodeJson $ SM.fromFoldable
295+ [ Tuple "duration" $ J.encodeJson $ un Milliseconds ms
296+ , Tuple "type" $ J.encodeJson "pause"
297+ ]
298+ , keyDown: \ch →
299+ J.encodeJson $ SM.fromFoldable
300+ [ Tuple "value" $ J.encodeJson ch
301+ , Tuple "type" $ J.encodeJson "keyDown"
302+ ]
303+ , keyUp: \ch →
304+ J.encodeJson $ SM.fromFoldable
305+ [ Tuple "value" $ J.encodeJson ch
306+ , Tuple "type" $ J.encodeJson "keyUp"
307+ ]
308+ , pointerUp: \btn →
309+ J.encodeJson $ SM.fromFoldable
310+ [ Tuple "button" $ encodeButton btn
311+ , Tuple "type" $ J.encodeJson "pointerUp"
312+ ]
313+ , pointerDown: \btn →
314+ J.encodeJson $ SM.fromFoldable
315+ [ Tuple "button" $ encodeButton btn
316+ , Tuple "type" $ J.encodeJson "pointerDown"
317+ ]
318+ , pointerMove: \pm →
319+ J.encodeJson $ SM.insert "type" (J.encodeJson "pointerMove") $ encodePointerMove pm
299320 }
300321
301322
src/Main.purs+26−18
@@ -5,11 +5,13 @@ import Prelude
55import Control.Monad.Eff (Eff)
66import Control.Monad.Eff.Class (liftEff)
77import Control.Monad.Aff as Aff
8+import Control.Monad.Aff.Class (liftAff)
89import Control.Monad.Except.Trans as ET
910import Control.Monad.Reader.Trans as RT
1011import Control.Monad.State.Trans as ST
1112import Control.Comonad (class Comonad, extract)
1213import Control.Extend (class Extend, extend, (<<=), (=>>))
14+import Data.Array as A
1315import Data.Newtype (wrap)
1416import CSS as CSS
1517import CSS.Selector as Selector
@@ -42,10 +44,10 @@ defaultTimeouts =
4244
4345main ∷ Eff _ Unit
4446main = void $ Aff.launchAff do
45− LS.start (Map.singleton LT.Chrome "ch.exe") "selenium-3.11.0.jar" [ ]
47+-- LS.start (Map.singleton LT.Firefox "gk.exe") "selenium-3.11.0.jar" [ "-port", "5555" ]
4648
4749 let baseURI = "http://localhost:4444/wd/hub"
48− ei ← LA.init baseURI { alwaysMatch: [ ], firstMatch: [ [ LT.BrowserName LT.Chrome ] ] }
50+ ei ← LA.init baseURI { alwaysMatch: [ ], firstMatch: [ [ LT.BrowserName LT.Firefox ] ] }
4951 case ei of
5052 Left err → do
5153 DT.traceAnyA "An error occured"
@@ -54,23 +56,29 @@ main = void $ Aff.launchAff do
5456 Right sr → do
5557 let config = { session: sr.session, baseURI, capabilities: sr.capabilities }
5658 res ←
57−
5859 R.runBaseAff' $ R.runReader config $ R.runExcept $ R.runState {timeouts: defaultTimeouts} do
59−-- flip RT.runReaderT config $ ET.runExceptT $ flip ST.runStateT { timeouts: defaultTimeouts } do
60− LA.go "http://google.com"
61− DT.traceAnyA "TS"
62− LH.getTimeouts >>= DT.traceAnyA
63− el ← LA.findElement $ LT.ByCss $ CSS.fromString "a"
64− LH.setTimeouts { pageLoad: wrap 1000.0, script: wrap 10000.0, implicit: wrap 10000.0 }
65− DT.traceAnyA =<< liftEff Now.now
66− ts ← LH.getTimeouts
67− DT.traceAnyA =<< liftEff Now.now
68− visible ← LH.isVisible el
69− LH.screenshot "./everything.png"
70− LH.elementScreenshot el "./a.png"
71− DT.traceAnyA el
72− DT.traceAnyA visible
60+ LA.go "http://localhost:8080"
61+ LH.localTimeouts (\t → t{implicit = wrap 1000.0}) $ LH.repeatedly do
62+ _ ← LA.findElement $ byAriaLabel "Select healthtrack"
63+ localDir ← LA.findElement $ byAriaLabel "Select local"
64+ DT.traceAnyA localDir
65+ LH.performActions $ A.singleton $ LT.Pointer LT.Mouse
66+ $ [LH.pointerMove $ LH.moveToElement localDir]
67+
68+ LH.performActions $ A.singleton $ LT.Pointer LT.Mouse
69+ $ LH.leftClick
70+ LH.performActions $ A.singleton $ LT.Pointer LT.Mouse
71+ $ LH.leftClick
72+
73+-- LA.elementClick localDir
74+-- LA.elementClick localDir
75+ st ← LA.findElement $ byAriaLabel "Select startup_log"
76+ DT.traceAnyA "startup_log"
77+ DT.traceAnyA st
78+
7379 _ ← R.runBaseAff' $ R.runReader config $ R.runExcept $ R.runState { timeouts: defaultTimeouts } $ LA.quit
74−-- LA.quit
7580 DT.traceAnyA res
7681 void $ liftEff $ PR.exit 0 --CP.kill SIGTERM cp
82+
83+ where
84+ byAriaLabel value = LT.ByCss $ CSS.fromString $ "[aria-label='" <> value <> "']"