git.iko.soy/rowtype-yoga/purescript-lunapark
on main help sign in
wip
commitb17db2fe21d15c75134f615e5be50c7cc9531a2d authorMaxim Zimaliev <zimaliev@gmail.com> dateFri 6 Apr 2018, 19:42 (9 years ago) parentff6d114
8 files changed+894−1
compare with main
unifiedsplit
bower.json+2−1 src/Lunapark.purs+9 src/Lunapark/.#API.purs+1 src/Lunapark/API.purs+355 src/Lunapark/Affjax.purs+242 src/Lunapark/Error.purs+121 src/Lunapark/Types.purs+160 src/Main.purs+4
bower.json+2−1
@@ -4,6 +4,7 @@
44 "purescript-affjax": "^5.0.0",
55 "purescript-debug": "^3.0.0",
66 "purescript-codec-argonaut": "^5.0.0",
7− "purescript-argonaut": "^3.1.0"
7+ "purescript-argonaut": "^3.1.0",
8+ "purescript-css": "^3.4.0"
89 }
910}
src/Lunapark.pursnew file+9
@@ -0,0 +1,9 @@
1+module Lunapark where
2+
3+import Prelude
4+
5+import Control.Monad.Aff (Aff)
6+import Lunapark.Affjax as LA
7+import Lunapark.Error as LE
8+import Lunapark.Types as LT
9+import Network.HTTP.Affjax (AJAX)
src/Lunapark/.#API.pursnew file+1
@@ -0,0 +1 @@
1+User@DESKTOP-4VI4KLM.9476:1522320097
src/Lunapark/API.pursnew file+355
@@ -0,0 +1,355 @@
1+module Lunapark.API where
2+
3+import Prelude
4+
5+import Control.Monad.Aff (Aff)
6+import Control.Monad.Aff.Class (class MonadAff, liftAff)
7+import Control.Monad.Error.Class (class MonadThrow, throwError)
8+import Control.Monad.Reader.Class (class MonadAsk, ask, asks)
9+import Data.Argonaut as J
10+import Data.Either (Either, either)
11+import Data.Maybe (Maybe(..))
12+import Data.Newtype (un)
13+import Data.Traversable as T
14+import Lunapark.Affjax as LA
15+import Lunapark.Error as LE
16+import Lunapark.Types as LT
17+import Network.HTTP.Affjax (AJAX)
18+
19+type Config =
20+ { session ∷ LT.SessionId
21+ , baseURI ∷ String
22+ , capabilities ∷ LT.Capabilities
23+ }
24+
25+type LunaparkConstraints e m a
26+ = MonadThrow LE.Error m
27+ ⇒ MonadAff (ajax ∷ AJAX|e) m
28+ ⇒ MonadAsk Config m
29+ ⇒ a
30+
31+rethrow
32+ ∷ ∀ m e eff a
33+ . MonadThrow e m
34+ ⇒ MonadAff eff m
35+ ⇒ Aff eff (Either e a)
36+ → m a
37+rethrow a = liftAff a >>= either throwError pure
38+
39+wrapEither ∷ ∀ m a. MonadThrow LE.Error m ⇒ Either String a → m a
40+wrapEither = either (throwError <<< LE.unknownError) pure
41+
42+getSession ∷ ∀ m r. MonadAsk { session ∷ LT.SessionId |r } m ⇒ m LT.SessionId
43+getSession = asks _.session
44+
45+init
46+ ∷ ∀ e m
47+ . MonadAff (ajax ∷ AJAX|e) m
48+ ⇒ MonadThrow LE.Error m
49+ ⇒ String
50+ → LT.Capabilities
51+ → m LT.CreateSessionResponse
52+init uri desiredCapabilities = do
53+ sessObj ← rethrow $ LA.init (uri <> "/session") $ LT.encodeCapabilities desiredCapabilities
54+ wrapEither $ LT.decodeCreateSessionResponse sessObj
55+
56+quit ∷ ∀ e m. LunaparkConstraints e m (m Unit)
57+quit = do
58+ r ← ask
59+ void $ rethrow $ LA.quit r.baseURI $ un LT.SessionId r.session
60+
61+status ∷ ∀ e m. LunaparkConstraints e m (m LT.ServerStatus)
62+status = do
63+ r ← ask
64+ res ← rethrow $ LA.status r.baseURI
65+ wrapEither $ LT.decodeServerStatus res
66+
67+getTimeouts ∷ ∀ e m. LunaparkConstraints e m (m LT.Timeouts)
68+getTimeouts = do
69+ r ← ask
70+ res ← rethrow $ LA.getTimeouts r.baseURI $ un LT.SessionId r.session
71+ wrapEither $ LT.decodeTimeouts res
72+
73+setTimeouts ∷ ∀ e m. LunaparkConstraints e m (LT.Timeouts → m Unit)
74+setTimeouts timeouts = do
75+ r ← ask
76+ void $ rethrow $ LA.setTimeouts
77+ r.baseURI
78+ (un LT.SessionId r.session)
79+ (LT.encodeTimeouts timeouts)
80+
81+go ∷ ∀ e m. LunaparkConstraints e m (String → m Unit)
82+go url = do
83+ r ← ask
84+ void $ rethrow $ LA.go
85+ r.baseURI
86+ (un LT.SessionId r.session)
87+ (LT.encodeGoRequest url)
88+
89+getCurrentUrl ∷ ∀ e m. LunaparkConstraints e m (m String)
90+getCurrentUrl = do
91+ r ← ask
92+ res ← rethrow $ LA.getCurrentUrl r.baseURI $ un LT.SessionId r.session
93+ wrapEither $ J.decodeJson res
94+
95+back ∷ ∀ e m. LunaparkConstraints e m (m Unit)
96+back = do
97+ r ← ask
98+ void $ rethrow $ LA.back r.baseURI $ un LT.SessionId r.session
99+
100+forward ∷ ∀ e m. LunaparkConstraints e m (m Unit)
101+forward = do
102+ r ← ask
103+ void $ rethrow $ LA.forward r.baseURI $ un LT.SessionId r.session
104+
105+refresh ∷ ∀ e m. LunaparkConstraints e m (m Unit)
106+refresh = do
107+ r ← ask
108+ void $ rethrow $ LA.refresh r.baseURI $ un LT.SessionId r.session
109+
110+getTitle ∷ ∀ e m. LunaparkConstraints e m (m String)
111+getTitle = do
112+ r ← ask
113+ res ← rethrow $ LA.getTitle r.baseURI $ un LT.SessionId r.session
114+ wrapEither $ J.decodeJson res
115+
116+getWindowHandle ∷ ∀ e m. LunaparkConstraints e m (m LT.WindowHandle)
117+getWindowHandle = do
118+ r ← ask
119+ res ← rethrow $ LA.getWindowHandle r.baseURI $ un LT.SessionId r.session
120+ wrapEither $ LT.decodeWindowHandle res
121+
122+closeWindow ∷ ∀ e m. LunaparkConstraints e m (m Unit)
123+closeWindow = do
124+ r ← ask
125+ void $ rethrow $ LA.closeWindow r.baseURI $ un LT.SessionId r.session
126+
127+switchToWindow ∷ ∀ e m. LunaparkConstraints e m (LT.WindowHandle → m Unit)
128+switchToWindow wh = do
129+ r ← ask
130+ void $ rethrow $ LA.switchToWindow
131+ r.baseURI
132+ (un LT.SessionId r.session)
133+ (LT.encodeSwitchToWindowRequest wh)
134+
135+getWindowHandles ∷ ∀ e m. LunaparkConstraints e m (m (Array LT.WindowHandle))
136+getWindowHandles = do
137+ r ← ask
138+ res ← rethrow $ LA.getWindowHandles r.baseURI $ un LT.SessionId r.session
139+ wrapEither $ T.traverse LT.decodeWindowHandle =<< J.decodeJson res
140+
141+switchToFrame ∷ ∀ e m. LunaparkConstraints e m (LT.FrameId → m Unit)
142+switchToFrame fid = do
143+ r ← ask
144+ void $ rethrow $ LA.switchToFrame
145+ r.baseURI
146+ (un LT.SessionId r.session)
147+ (LT.encodeFrameId fid)
148+
149+switchToParentFrame ∷ ∀ e m. LunaparkConstraints e m (m Unit)
150+switchToParentFrame = do
151+ r ← ask
152+ void $ rethrow $ LA.switchToParentFrame r.baseURI $ un LT.SessionId r.session
153+
154+getWindowRect ∷ ∀ e m. LunaparkConstraints e m (m LT.Rectangle)
155+getWindowRect = do
156+ r ← ask
157+ res ← rethrow $ LA.getWindowRect r.baseURI $ un LT.SessionId r.session
158+ wrapEither $ LT.decodeRectangle res
159+
160+setWindowRect ∷ ∀ e m. LunaparkConstraints e m (LT.Rectangle → m Unit)
161+setWindowRect rectangle = do
162+ r ← ask
163+ void $ rethrow $ LA.setWindowRect
164+ r.baseURI
165+ (un LT.SessionId r.session)
166+ (LT.encodeRectangle rectangle)
167+
168+maximizeWindow ∷ ∀ e m. LunaparkConstraints e m (m Unit)
169+maximizeWindow = do
170+ r ← ask
171+ void $ rethrow $ LA.maximizeWindow r.baseURI $ un LT.SessionId r.session
172+
173+minimizeWindow ∷ ∀ e m. LunaparkConstraints e m (m Unit)
174+minimizeWindow = do
175+ r ← ask
176+ void $ rethrow $ LA.minimizeWindow r.baseURI $ un LT.SessionId r.session
177+
178+fullscreenWindow ∷ ∀ e m. LunaparkConstraints e m (m Unit)
179+fullscreenWindow = do
180+ r ← ask
181+ void $ rethrow $ LA.fullscreenWindow r.baseURI $ un LT.SessionId r.session
182+
183+findElement ∷ ∀ m e. LunaparkConstraints e m (LT.Locator → m LT.Element)
184+findElement loc = do
185+ r ← ask
186+ res ←
187+ rethrow $ LA.findElement
188+ r.baseURI
189+ (un LT.SessionId r.session)
190+ (LT.encodeLocator loc)
191+ wrapEither $ LT.decodeElement res
192+
193+findElements ∷ ∀ m e. LunaparkConstraints e m (LT.Locator → m (Array LT.Element))
194+findElements loc = do
195+ r ← ask
196+ res ←
197+ rethrow $ LA.findElements
198+ r.baseURI
199+ (un LT.SessionId r.session)
200+ (LT.encodeLocator loc)
201+ wrapEither $ T.traverse LT.decodeElement =<< J.decodeJson res
202+
203+findElementFromElement
204+ ∷ ∀ m e
205+ . LunaparkConstraints e m
206+ ( LT.Element
207+ → LT.Locator
208+ → m LT.Element
209+ )
210+findElementFromElement el loc = do
211+ r ← ask
212+ res ←
213+ rethrow $ LA.findElementFromElement
214+ r.baseURI
215+ (un LT.SessionId r.session)
216+ (un LT.Element el)
217+ (LT.encodeLocator loc)
218+ wrapEither $ LT.decodeElement res
219+
220+findElementsFromElement
221+ ∷ ∀ m e
222+ . LunaparkConstraints e m
223+ ( LT.Element
224+ → LT.Locator
225+ → m (Array LT.Element)
226+ )
227+findElementsFromElement el loc = do
228+ r ← ask
229+ res ←
230+ rethrow $ LA.findElementsFromElement
231+ r.baseURI
232+ (un LT.SessionId r.session)
233+ (un LT.Element el)
234+ (LT.encodeLocator loc)
235+ wrapEither $ T.traverse LT.decodeElement =<< J.decodeJson res
236+
237+getActiveElement ∷ ∀ m e. LunaparkConstraints e m (m LT.Element)
238+getActiveElement = do
239+ r ← ask
240+ res ← rethrow $ LA.getActiveElement r.baseURI $ un LT.SessionId r.session
241+ wrapEither $ LT.decodeElement res
242+
243+isElementSelected ∷ ∀ m e. LunaparkConstraints e m (LT.Element → m Boolean)
244+isElementSelected el = do
245+ r ← ask
246+ res ←
247+ rethrow $ LA.isElementSelected
248+ r.baseURI
249+ (un LT.SessionId r.session)
250+ (un LT.Element el)
251+ wrapEither $ J.decodeJson res
252+
253+getElementAttribute ∷ ∀ m e. LunaparkConstraints e m (LT.Element → String → m (Maybe String))
254+getElementAttribute el attrName = do
255+ r ← ask
256+ res ←
257+ rethrow $ LA.getElementAttribute
258+ r.baseURI
259+ (un LT.SessionId r.session)
260+ (un LT.Element el)
261+ attrName
262+ if J.isNull res
263+ then pure Nothing
264+ else wrapEither $ J.decodeJson res
265+
266+getElementProperty ∷ ∀ m e. LunaparkConstraints e m (LT.Element → String → m J.Json)
267+getElementProperty el propName = do
268+ r ← ask
269+ rethrow $ LA.getElementProperty
270+ r.baseURI
271+ (un LT.SessionId r.session)
272+ (un LT.Element el)
273+ propName
274+
275+getElementCSSValue ∷ ∀ m e. LunaparkConstraints e m (LT.Element → String → m String)
276+getElementCSSValue el cssName = do
277+ r ← ask
278+ res ←
279+ rethrow $ LA.getElementCSSValue
280+ r.baseURI
281+ (un LT.SessionId r.session)
282+ (un LT.Element el)
283+ cssName
284+ wrapEither $ J.decodeJson res
285+
286+getElementText ∷ ∀ m e. LunaparkConstraints e m (LT.Element → m String)
287+getElementText el = do
288+ r ← ask
289+ res ←
290+ rethrow $ LA.getElementText
291+ r.baseURI
292+ (un LT.SessionId r.session)
293+ (un LT.Element el)
294+ wrapEither $ J.decodeJson res
295+
296+getElementTagName ∷ ∀ m e. LunaparkConstraints e m (LT.Element → m String)
297+getElementTagName el = do
298+ r ← ask
299+ res ←
300+ rethrow $ LA.getElementTagName
301+ r.baseURI
302+ (un LT.SessionId r.session)
303+ (un LT.Element el)
304+ wrapEither $ J.decodeJson res
305+
306+getElementRect ∷ ∀ m e. LunaparkConstraints e m (LT.Element → m LT.Rectangle)
307+getElementRect el = do
308+ r ← ask
309+ res ←
310+ rethrow $ LA.getElementRect
311+ r.baseURI
312+ (un LT.SessionId r.session)
313+ (un LT.Element el)
314+ wrapEither $ LT.decodeRectangle res
315+
316+isElementEnabled ∷ ∀ m e. LunaparkConstraints e m (LT.Element → m Boolean)
317+isElementEnabled el = do
318+ r ← ask
319+ res ←
320+ rethrow $ LA.isElementEnabled
321+ r.baseURI
322+ (un LT.SessionId r.session)
323+ (un LT.Element el)
324+ wrapEither $ J.decodeJson res
325+
326+elementClick ∷ ∀ m e. LunaparkConstraints e m (LT.Element → m Unit)
327+elementClick el = do
328+ r ← ask
329+ void $ rethrow $ LA.elementClick
330+ r.baseURI
331+ (un LT.SessionId r.session)
332+ (un LT.Element el)
333+
334+elementClear ∷ ∀ m e. LunaparkConstraints e m (LT.Element → m Unit)
335+elementClear el = do
336+ r ← ask
337+ void $ rethrow $ LA.elementClear
338+ r.baseURI
339+ (un LT.SessionId r.session)
340+ (un LT.Element el)
341+
342+elementSendKeys ∷ ∀ m e. LunaparkConstraints e m (LT.Element → String → m Unit)
343+elementSendKeys el txt = do
344+ r ← ask
345+ void $ rethrow $ LA.elementSendKeys
346+ r.baseURI
347+ (un LT.SessionId r.session)
348+ (un LT.Element el)
349+ (LT.encodeSendKeysRequest txt)
350+
351+getPageSource ∷ ∀ m e. LunaparkConstraints e m (m String)
352+getPageSource = do
353+ r ← ask
354+ res ← rethrow $ LA.getPageSource r.baseURI (un LT.SessionId r.session)
355+ wrapEither $ J.decodeJson res
src/Lunapark/Affjax.pursnew file+242
@@ -0,0 +1,242 @@
1+module Lunapark.Affjax where
2+
3+import Prelude
4+
5+import Control.Monad.Aff (Aff)
6+import Data.Argonaut (Json)
7+import Data.Argonaut as J
8+import Data.Bifunctor (lmap)
9+import Data.Either (Either(..))
10+import Data.Maybe (Maybe(..))
11+import Network.HTTP.Affjax (AJAX)
12+import Network.HTTP.Affjax as N
13+import Network.HTTP.StatusCode (StatusCode(..))
14+import Lunapark.Error as LE
15+
16+-- | This two type synonims are used only here
17+-- | this is the lowest level of bindings this lib provides
18+type URI = String
19+type SessionId = String
20+type ElementId = String
21+
22+handleAPIError ∷ N.AffjaxResponse Json → Either LE.Error Json
23+handleAPIError r = case r.status of
24+ StatusCode 200 → lmap LE.unknownError do
25+ obj ← J.decodeJson r.response
26+ obj J..? "value"
27+ code → Left $ LE.fromJson r.response
28+
29+init ∷ ∀ e. URI → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
30+init uri obj =
31+ map handleAPIError $ N.post (uri <> "/session") obj
32+
33+quit ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
34+quit uri sessId =
35+ map handleAPIError $ N.delete (uri <> "/session/" <> sessId)
36+
37+status ∷ ∀ e. URI → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
38+status uri =
39+ map handleAPIError $ N.get (uri <> "/status")
40+
41+getTimeouts ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
42+getTimeouts uri sessId =
43+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/timeouts")
44+
45+setTimeouts ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
46+setTimeouts uri sessId timeouts =
47+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/timeouts") timeouts
48+
49+go ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
50+go uri sessId obj =
51+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/url") obj
52+
53+getCurrentUrl ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
54+getCurrentUrl uri sessId =
55+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/url")
56+
57+back ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
58+back uri sessId =
59+ map handleAPIError $ N.post' (uri <> "/session/" <> sessId <> "/back") (Nothing ∷ Maybe Unit)
60+
61+forward ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
62+forward uri sessId =
63+ map handleAPIError $ N.post' (uri <> "/session/" <> sessId <> "/forward") (Nothing ∷ Maybe Unit)
64+
65+refresh ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
66+refresh uri sessId =
67+ map handleAPIError $ N.post' (uri <> "/session/" <> sessId <> "/refresh") (Nothing ∷ Maybe Unit)
68+
69+getTitle ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
70+getTitle uri sessId =
71+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/title")
72+
73+getWindowHandle ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
74+getWindowHandle uri sessId =
75+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/window")
76+
77+closeWindow ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
78+closeWindow uri sessId =
79+ map handleAPIError $ N.delete (uri <> "/session/" <> sessId)
80+
81+switchToWindow ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
82+switchToWindow uri sessId obj =
83+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/window") obj
84+
85+getWindowHandles ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
86+getWindowHandles uri sessId =
87+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/window/handles")
88+
89+switchToFrame ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
90+switchToFrame uri sessId obj =
91+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/frame") obj
92+
93+switchToParentFrame ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
94+switchToParentFrame uri sessId =
95+ map handleAPIError $ N.post' (uri <> "/session/" <> sessId <> "/frame/parent") (Nothing ∷ Maybe Unit)
96+
97+getWindowRect ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
98+getWindowRect uri sessId =
99+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/window/rect")
100+
101+setWindowRect ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
102+setWindowRect uri sessId obj =
103+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/window/rect") obj
104+
105+maximizeWindow ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
106+maximizeWindow uri sessId =
107+ map handleAPIError $ N.post' (uri <> "/session/" <> sessId <> "/window/maximize") (Nothing ∷ Maybe Unit)
108+
109+minimizeWindow ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
110+minimizeWindow uri sessId =
111+ map handleAPIError $ N.post' (uri <> "/session/" <> sessId <> "/window/minimize") (Nothing ∷ Maybe Unit)
112+
113+fullscreenWindow ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
114+fullscreenWindow uri sessId =
115+ map handleAPIError $ N.post' (uri <> "/session/" <> sessId <> "/window/fullscreen") (Nothing ∷ Maybe Unit)
116+
117+findElement ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
118+findElement uri sessId obj =
119+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/element") obj
120+
121+findElements ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
122+findElements uri sessId obj =
123+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/elements") obj
124+
125+findElementFromElement ∷ ∀ e. URI → SessionId → ElementId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
126+findElementFromElement uri sessId elId obj =
127+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/element") obj
128+
129+findElementsFromElement ∷ ∀ e. URI → SessionId → ElementId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
130+findElementsFromElement uri sessId elId obj =
131+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/elements") obj
132+
133+getActiveElement ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
134+getActiveElement uri sessId = map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/element/active")
135+
136+isElementSelected ∷ ∀ e. URI → SessionId → ElementId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
137+isElementSelected uri sessId elId =
138+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/selected")
139+
140+getElementAttribute ∷ ∀ e. URI → SessionId → ElementId → String → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
141+getElementAttribute uri sessId elId attrName =
142+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/attribute/" <> attrName)
143+
144+getElementProperty ∷ ∀ e. URI → SessionId → ElementId → String → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
145+getElementProperty uri sessId elId propName =
146+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/property/" <> propName)
147+
148+getElementCSSValue ∷ ∀ e. URI → SessionId → ElementId → String → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
149+getElementCSSValue uri sessId elId cssName =
150+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/css/" <> cssName)
151+
152+getElementText ∷ ∀ e. URI → SessionId → ElementId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
153+getElementText uri sessId elId =
154+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/text")
155+
156+getElementTagName ∷ ∀ e. URI → SessionId → ElementId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
157+getElementTagName uri sessId elId =
158+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/name")
159+
160+getElementRect ∷ ∀ e. URI → SessionId → ElementId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
161+getElementRect uri sessId elId =
162+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/rect")
163+
164+isElementEnabled ∷ ∀ e. URI → SessionId → ElementId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
165+isElementEnabled uri sessId elId =
166+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/enabled")
167+
168+elementClick ∷ ∀ e. URI → SessionId → ElementId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
169+elementClick uri sessId elId =
170+ map handleAPIError $ N.post' (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/click") (Nothing ∷ Maybe Unit)
171+
172+elementClear ∷ ∀ e. URI → SessionId → ElementId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
173+elementClear uri sessId elId =
174+ map handleAPIError $ N.post' (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/clear") (Nothing ∷ Maybe Unit)
175+
176+elementSendKeys ∷ ∀ e. URI → SessionId → ElementId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
177+elementSendKeys uri sessId elId obj =
178+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/value") obj
179+
180+getPageSource ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
181+getPageSource uri sessId =
182+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/source")
183+
184+executeScript ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
185+executeScript uri sessId obj =
186+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/execute/sync") obj
187+
188+executeAsyncScript ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
189+executeAsyncScript uri sessId obj =
190+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/execute/async") obj
191+
192+getAllCookies ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
193+getAllCookies uri sessId =
194+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/cookie")
195+
196+getNamedCookie ∷ ∀ e. URI → SessionId → String → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
197+getNamedCookie uri sessId name =
198+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/cookie/" <> name)
199+
200+addCookie ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
201+addCookie uri sessId obj =
202+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/cookie") obj
203+
204+deleteCookie ∷ ∀ e. URI → SessionId → String → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
205+deleteCookie uri sessId name =
206+ map handleAPIError $ N.delete (uri <> "/session/" <> sessId <> "/cookie/" <> name)
207+
208+deleteAllCookies ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
209+deleteAllCookies uri sessId =
210+ map handleAPIError $ N.delete (uri <> "/session/" <> sessId <> "/cookie")
211+
212+performActions ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
213+performActions uri sessId obj =
214+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/actions") obj
215+
216+releaseActions ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
217+releaseActions uri sessId =
218+ map handleAPIError $ N.delete (uri <> "/session/" <> sessId <> "/actions")
219+
220+dismissAlert ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
221+dismissAlert uri sessId =
222+ map handleAPIError $ N.post' (uri <> "/session/" <> sessId <> "/alert/dismiss") (Nothing ∷ Maybe Unit)
223+
224+acceptAlert ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
225+acceptAlert uri sessId =
226+ map handleAPIError $ N.post' (uri <> "/session/" <> sessId <> "/alert/accept") (Nothing ∷ Maybe Unit)
227+
228+getAlertText ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
229+getAlertText uri sessId =
230+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/alert/text")
231+
232+sendAlertText ∷ ∀ e. URI → SessionId → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
233+sendAlertText uri sessId obj =
234+ map handleAPIError $ N.post (uri <> "/session/" <> sessId <> "/alert/text") obj
235+
236+takeScreenshot ∷ ∀ e. URI → SessionId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
237+takeScreenshot uri sessId =
238+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/screenshot")
239+
240+takeElementScreenshot ∷ ∀ e. URI → SessionId → ElementId → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)
241+takeElementScreenshot uri sessId elId =
242+ map handleAPIError $ N.get (uri <> "/session/" <> sessId <> "/element/" <> elId <> "/screenshot")
src/Lunapark/Error.pursnew file+121
@@ -0,0 +1,121 @@
1+module Lunapark.Error where
2+
3+import Prelude
4+
5+import Data.Argonaut as J
6+import Data.Either (Either(..), either)
7+
8+data ErrorType
9+ = ElementClickIntercepted
10+ | ElementNotSelectable
11+ | ElementNotInteractable
12+ | InsecureCertificate
13+ | InvalidArgument
14+ | InvalidCookieDomain
15+ | InvalidCoordinates
16+ | InvalidElementState
17+ | InvalidSelector
18+ | InvalidSessionId
19+ | JavaScriptError
20+ | MoveTargetOutOfBounds
21+ | NoSuchAlert
22+ | NoSuchCookie
23+ | NoSuchElement
24+ | NoSuchFrame
25+ | NoSuchWindow
26+ | ScriptTimeout
27+ | SessionNotCreated
28+ | StaleElementReference
29+ | Timeout
30+ | UnableToSetCookie
31+ | UnableToCaptureScreen
32+ | UnexpectedAlertOpen
33+ | UnknownCommand
34+ | UnknownError
35+ | UnknownMethod
36+ | UnsupportedOperation
37+
38+fromStringCode ∷ String → Either String ErrorType
39+fromStringCode = case _ of
40+ "element click intercepted" → Right ElementClickIntercepted
41+ "element not selectable" → Right ElementNotSelectable
42+ "element not interactable" → Right ElementNotInteractable
43+ "insecure certificate" → Right InsecureCertificate
44+ "invalid argument" → Right InvalidArgument
45+ "invalid cookie domain" → Right InvalidCookieDomain
46+ "invalid coordinates" → Right InvalidCoordinates
47+ "invalid element state" → Right InvalidElementState
48+ "invalid selector" → Right InvalidSelector
49+ "invalid session id" → Right InvalidSessionId
50+ "javascript error" → Right JavaScriptError
51+ "move target out of bounds" → Right MoveTargetOutOfBounds
52+ "no such alert" → Right NoSuchAlert
53+ "no such cookie" → Right NoSuchCookie
54+ "no such element" → Right NoSuchElement
55+ "no such frame" → Right NoSuchFrame
56+ "no such window" → Right NoSuchWindow
57+ "script timeout" → Right ScriptTimeout
58+ "session not created" → Right SessionNotCreated
59+ "stale element reference" → Right StaleElementReference
60+ "timeout" → Right Timeout
61+ "unable to set cookie" → Right UnableToSetCookie
62+ "unable to capture screen" → Right UnableToCaptureScreen
63+ "unexpected alert open" → Right UnexpectedAlertOpen
64+ "unknown command" → Right UnknownCommand
65+ "unknown error" → Right UnknownError
66+ "unknown method" → Right UnknownMethod
67+ "unsupported operation" → Right UnsupportedOperation
68+ s → Left s
69+
70+toStringCode ∷ ErrorType → String
71+toStringCode = case _ of
72+ ElementClickIntercepted → "element click intercepted"
73+ ElementNotSelectable → "element not selectable"
74+ ElementNotInteractable → "element not interactable"
75+ InsecureCertificate → "insecure certificate"
76+ InvalidArgument → "invalid argument"
77+ InvalidCookieDomain → "invalid cookie domain"
78+ InvalidCoordinates → "invalid coordinates"
79+ InvalidElementState → "invalid element state"
80+ InvalidSelector → "invalid selector"
81+ InvalidSessionId → "invalid session id"
82+ JavaScriptError → "javascript error"
83+ MoveTargetOutOfBounds → "move target out of bounds"
84+ NoSuchAlert → "no such alert"
85+ NoSuchCookie → "no such cookie"
86+ NoSuchElement → "no such element"
87+ NoSuchFrame → "no such frame"
88+ NoSuchWindow → "no such window"
89+ ScriptTimeout → "script timeout"
90+ SessionNotCreated → "session not created"
91+ StaleElementReference → "stale element reference"
92+ Timeout → "timeout"
93+ UnableToSetCookie → "unable to set cookie"
94+ UnableToCaptureScreen → "unable to capture screen"
95+ UnexpectedAlertOpen → "unexpected alert open"
96+ UnknownCommand → "unknown command"
97+ UnknownError → "unknown error"
98+ UnknownMethod → "unknown method"
99+ UnsupportedOperation → "unsupported operation"
100+
101+type Error =
102+ { error ∷ ErrorType
103+ , message ∷ String
104+ , stacktrace ∷ String
105+ }
106+
107+fromJson ∷ J.Json → Error
108+fromJson js = either unknownError id do
109+ obj ← J.decodeJson js
110+ value ← obj J..? "value"
111+ error ← fromStringCode =<< value J..? "error"
112+ message ← value J..? "message"
113+ stacktrace ← value J..? "stacktrace"
114+ pure { error, message, stacktrace }
115+
116+unknownError ∷ String → Error
117+unknownError message =
118+ { error: UnknownError
119+ , message
120+ , stacktrace: ""
121+ }
src/Lunapark/Types.pursnew file+160
@@ -0,0 +1,160 @@
1+module Lunapark.Types where
2+
3+import Prelude
4+
5+import Control.Alt ((<|>))
6+import CSS.Selector as CSS
7+import CSS.Render as CSSR
8+import Data.Argonaut (Json)
9+import Data.Argonaut as J
10+import Data.Time.Duration (Milliseconds(..))
11+import Data.Either (Either(..))
12+import Data.Newtype (class Newtype, un)
13+import Data.StrMap as SM
14+import Data.Tuple (Tuple(..))
15+import Data.XPath.Types as X
16+import Unsafe.Coerce (unsafeCoerce)
17+
18+newtype SessionId = SessionId String
19+derive instance newtypeSessionId ∷ Newtype SessionId _
20+
21+newtype WindowHandle = WindowHandle String
22+derive instance newtypeWindowHandle ∷ Newtype WindowHandle _
23+
24+data FrameId = ByElementId String | ByIndex Int | TopFrame
25+
26+newtype Element = Element String
27+derive instance newtypeElementId ∷ Newtype Element _
28+
29+decodeElement ∷ Json → Either String Element
30+decodeElement = J.decodeJson >=> \obj →
31+ map Element $ obj J..? "element-6066-11e4-a52e-4f735466cecf" <|> obj J..? "ELEMENT"
32+
33+encodeElement ∷ Element → Json
34+encodeElement (Element eid) = J.encodeJson $ SM.fromFoldable
35+ [ Tuple "element-6066-11e4-a52e-4f735466cecf" eid
36+ , Tuple "ELEMENT" eid
37+ ]
38+
39+data Capabilities
40+
41+encodeCapabilities ∷ Capabilities → Json
42+encodeCapabilities = unsafeCoerce
43+
44+decodeCapabilities ∷ Json → Either String Capabilities
45+decodeCapabilities js = Left "unimplemented"
46+
47+decodeSessionId ∷ Json → Either String SessionId
48+decodeSessionId = map SessionId <<< J.decodeJson
49+
50+type CreateSessionResponse =
51+ { session ∷ SessionId
52+ , capabilities ∷ Capabilities
53+ }
54+
55+decodeCreateSessionResponse ∷ Json → Either String CreateSessionResponse
56+decodeCreateSessionResponse = J.decodeJson >=> \obj → do
57+ session ← decodeSessionId =<< obj J..? "sessionId"
58+ capabilities ← decodeCapabilities =<< obj J..? "capabilities"
59+ pure { session, capabilities }
60+
61+type ServerStatus =
62+ { ready ∷ Boolean
63+ , message ∷ String
64+ }
65+
66+decodeServerStatus ∷ Json → Either String ServerStatus
67+decodeServerStatus = J.decodeJson >=> \obj → { ready: _, message: _ } <$> obj J..? "ready" <*> obj J..? "message"
68+
69+type Timeouts =
70+ { script ∷ Milliseconds
71+ , pageLoad ∷ Milliseconds
72+ , implicit ∷ Milliseconds
73+ }
74+
75+decodeTimeouts ∷ Json → Either String Timeouts
76+decodeTimeouts = J.decodeJson >=> \obj → do
77+ script ← map Milliseconds $ obj J..? "script"
78+ pageLoad ← map Milliseconds $ obj J..? "pageLoad"
79+ implicit ← map Milliseconds $ obj J..? "implicit"
80+ pure { script, pageLoad, implicit }
81+
82+encodeTimeouts ∷ Timeouts → Json
83+encodeTimeouts r = J.encodeJson $ SM.fromFoldable
84+ [ Tuple "script" (un Milliseconds r.script)
85+ , Tuple "pageLoad" (un Milliseconds r.pageLoad)
86+ , Tuple "implicit" (un Milliseconds r.implicit)
87+ ]
88+
89+encodeGoRequest ∷ String → Json
90+encodeGoRequest url = J.encodeJson $ SM.fromFoldable [ Tuple "url" url ]
91+
92+decodeWindowHandle ∷ Json → Either String WindowHandle
93+decodeWindowHandle = map WindowHandle <<< J.decodeJson
94+
95+encodeSwitchToWindowRequest ∷ WindowHandle → Json
96+encodeSwitchToWindowRequest w = J.encodeJson $ SM.fromFoldable [ Tuple "handle" $ un WindowHandle w ]
97+
98+encodeFrameId ∷ FrameId → Json
99+encodeFrameId fid = J.encodeJson $ SM.fromFoldable [ Tuple "id" encoded ]
100+ where
101+ encoded = case fid of
102+ TopFrame → J.jsonNull
103+ ByIndex ix → J.encodeJson ix
104+ ByElementId eid → J.encodeJson eid
105+
106+type Rectangle =
107+ { width ∷ Int
108+ , height ∷ Int
109+ , x ∷ Int
110+ , y ∷ Int
111+ }
112+
113+decodeRectangle ∷ Json → Either String Rectangle
114+decodeRectangle = J.decodeJson >=> \obj → do
115+ width ← obj J..? "width"
116+ height ← obj J..? "height"
117+ x ← obj J..? "x"
118+ y ← obj J..? "y"
119+ pure { width, height, x, y }
120+
121+encodeRectangle ∷ Rectangle → Json
122+encodeRectangle r = J.encodeJson $ SM.fromFoldable
123+ [ Tuple "width" r.width
124+ , Tuple "height" r.height
125+ , Tuple "x" r.x
126+ , Tuple "y" r.y
127+ ]
128+
129+data Locator
130+ = ByCss CSS.Selector
131+ | ByXPath X.XPath
132+ | ByTagName String
133+ | ByLinkText String
134+ | ByPartialLinkText String
135+
136+encodeLocator ∷ Locator → Json
137+encodeLocator l = J.encodeJson $ SM.fromFoldable case l of
138+ ByCss sel →
139+ [ Tuple "using" "css selector"
140+ , Tuple "value" $ CSSR.selector sel
141+ ]
142+ ByXPath sel →
143+ [ Tuple "using" "xpath"
144+ , Tuple "value" $ X.printXPath sel
145+ ]
146+ ByLinkText sel →
147+ [ Tuple "using" "link text"
148+ , Tuple "value" sel
149+ ]
150+ ByPartialLinkText sel →
151+ [ Tuple "using" "partial link text"
152+ , Tuple "value" sel
153+ ]
154+ ByTagName sel →
155+ [ Tuple "using" "tag name"
156+ , Tuple "value" sel
157+ ]
158+
159+encodeSendKeysRequest ∷ String → Json
160+encodeSendKeysRequest txt = J.encodeJson $ SM.fromFoldable [ Tuple "text" txt ]
src/Main.purs+4
@@ -50,6 +50,10 @@ main = void $ Aff.launchAff do
5050
5151 DT.traceAnyA "========================================"
5252
53+ res5 ← AJ.delete ("http://localhost:4444/wd/hub/session/" <> sessId <> sessId)
54+ DT.traceAnyA res5
55+ DT.traceAnyA $ res5.response ∷ A.Json
56+
5357 res5 ← AJ.delete ("http://localhost:4444/wd/hub/session/" <> sessId)
5458 DT.traceAnyA res5
5559 DT.traceAnyA $ res5.response ∷ A.Json