e8884bd · rowtype-yoga/purescript-lunapark

git.iko.soy/rowtype-yoga/purescript-lunapark

update for 0.12

commite8884bd6da0960ce7d17ed5c710b9de01e616453 authorMaxim Zimaliev <zimaliev@gmail.com> dateTue 15 May 2018, 12:37 (8 years ago) parent0b35e54

8 files changed+127−135

compare with main

unifiedsplit

bower.json+6−6 package.json+1−1 src/Lunapark/API.purs+43−51 src/Lunapark/Endpoint.purs+5−6 src/Lunapark/Error.purs+1−1 src/Lunapark/LunaparkF.purs+25−25 src/Lunapark/Types.purs+42−41 src/Lunapark/Utils.purs+4−4

bower.json+6−6

@@ -24,11 +24,11 @@

2424 "test"

2525 ],

2626 "dependencies": {

27− "purescript-affjax": "^5.0.0",

28− "purescript-argonaut": "^3.1.0",

29− "purescript-css": "^3.4.0",

30− "purescript-node-fs-aff": "^5.0.0",

31− "purescript-run": "^1.0.1",

32− "purescript-xpath": "cryogenian/purescript-xpath#master"

27+ "purescript-affjax": "#compiler/0.12",

28+ "purescript-argonaut": "cryogenian/purescript-argonaut#compiler/0.12",

29+ "purescript-css": "justinwoo/purescript-css#compiler/0.12",

30+ "purescript-node-fs-aff": "#compiler/0.12",

31+ "purescript-run": "#compiler/0.12",

32+ "purescript-xpath": "cryogenian/purescript-xpath#compiler/0.12"

3333 }

3434}

package.json+1−1

@@ -11,7 +11,7 @@

1111 "dependencies": {

1212 "chromedriver": "^2.37.0",

1313 "pulp": "^12.0.1",

14− "purescript": "^0.11.7",

14+ "purescript": "cryogenian/node-purescript-bin#master",

1515 "purescript-psa": "^0.6.0",

1616 "xhr2": "^0.1.4"

1717 }

src/Lunapark/API.purs+43−51

@@ -2,10 +2,6 @@ module Lunapark.API where

33import Prelude

5−import Control.Monad.Aff as Aff

6−import Control.Monad.Aff.Class (class MonadAff, liftAff)

7−import Control.Monad.Eff.Ref as Ref

8−import Control.Monad.Eff.Class (liftEff)

95import Control.Monad.Rec.Class (class MonadRec)

106import Data.Argonaut as J

117import Data.Bifunctor (lmap)

@@ -14,37 +10,33 @@ import Data.List (List(..), (:))

1410import Data.List as L

1511import Data.Map as Map

1612import Data.Maybe (Maybe(..))

17−import Data.StrMap as SM

1813import Data.String as Str

19−import Data.Variant as V

2014import Data.Time.Duration (Milliseconds(..))

2115import Data.Traversable as T

16+import Data.Variant as V

17+import Effect.Aff as Aff

18+import Effect.Aff.Class (class MonadAff, liftAff)

19+import Effect.Class (liftEffect)

20+import Effect.Ref as Ref

21+import Foreign.Object as FO

22+import Lunapark.ActionF (_lunaparkActions, LUNAPARK_ACTIONS, ActionF(..), TouchF(..))

2223import Lunapark.Endpoint as LP

2324import Lunapark.Error as LE

24−import Lunapark.Types as LT

2525import Lunapark.LunaparkF (_lunapark, LUNAPARK, ElementF(..), LunaparkF(..), performActions, findElement)

26−import Lunapark.ActionF (_lunaparkActions, LUNAPARK_ACTIONS, ActionF(..), TouchF(..))

26+import Lunapark.Types as LT

2727import Lunapark.Utils (liftAndRethrow, throwLeft, catch)

28−import Network.HTTP.Affjax (AJAX)

2928import Node.Buffer as B

3029import Node.FS.Aff as FS

3130import Run as R

3231import Run.Except (EXCEPT)

3332

34−type LunaparkEffects e =

35− ( ajax ∷ AJAX

36− , ref ∷ Ref.REF

37− , buffer ∷ B.BUFFER

38− , fs ∷ FS.FS

39− | e)

40−

4133init

42− ∷ ∀ e m r a

43− . MonadAff (LunaparkEffects e) m

34+ ∷ ∀ m r a

35+ . MonadAff m

4436 ⇒ MonadRec m

4537 ⇒ String

4638 → LT.CapabilitiesRequest

47− → m (Either LE.Error (Lunapark e r a → BaseRun e r a))

39+ → m (Either LE.Error (Lunapark r a → BaseRun r a))

4840init uri caps = do

4941 res ←

5042 liftAff

@@ -58,19 +50,19 @@ init uri caps = do

5850

5951 T.for sessionResponse \{ session, capabilities } → do

6052 timeoutsRef ←

61− liftEff $ Ref.newRef

53+ liftEffect $ Ref.new

6254 { implicit: Milliseconds 0.0

6355 , pageLoad: Milliseconds 300000.0

6456 , script: Milliseconds 30000.0

6557 }

6658

67− requestMapRef ← liftEff $ Ref.newRef Map.empty

59+ requestMapRef ← liftEffect $ Ref.new Map.empty

6860

6961 actionsEnabled ←

7062 map isRight

7163 $ liftAff

7264 $ LP.post uri (LP.InSession session : LP.Actions : Nil)

73− $ LT.encodeActionRequest $ SM.singleton "action-test"

65+ $ LT.encodeActionRequest $ FO.singleton "action-test"

7466 $ LT.NoSource [ LT.pause $ Milliseconds 0.0 ]

7567

7668 let

@@ -86,40 +78,40 @@ init uri caps = do

8678 pure $ interpret input

8779

8880interpret

89− ∷ ∀ e r

81+ ∷ ∀ r

9082 . HandleLunaparkInput

91− → Lunapark e r

92− ~> BaseRun e r

83+ → Lunapark r

84+ ~> BaseRun r

9385interpret input = runLunapark input <<< runLunaparkActions input

9486

9587

96−type Lunapark e r = BaseRun e (lunapark ∷ LUNAPARK, lunaparkActions ∷ LUNAPARK_ACTIONS|r)

88+type Lunapark r = BaseRun (lunapark ∷ LUNAPARK, lunaparkActions ∷ LUNAPARK_ACTIONS|r)

9789

98−type BaseRun e r = R.Run

90+type BaseRun r = R.Run

9991 ( except ∷ EXCEPT LE.Error

100− , aff ∷ R.AFF (LunaparkEffects e)

101− , eff ∷ R.EFF (LunaparkEffects e)

92+ , aff ∷ R.AFF

93+ , effect ∷ R.EFFECT

10294 | r)

10395

104−runLunapark ∷ ∀ e r. HandleLunaparkInput → BaseRun e (lunapark ∷ LUNAPARK|r) ~> BaseRun e r

96+runLunapark ∷ ∀ r. HandleLunaparkInput → BaseRun (lunapark ∷ LUNAPARK|r) ~> BaseRun r

10597runLunapark input = do

10698 R.interpretRec (R.on _lunapark (handleLunapark input) R.send)

10799

108−runLunaparkActions ∷ ∀ e r. HandleLunaparkInput → Lunapark e r ~> BaseRun e (lunapark ∷ LUNAPARK|r)

100+runLunaparkActions ∷ ∀ r. HandleLunaparkInput → Lunapark r ~> BaseRun (lunapark ∷ LUNAPARK|r)

109101runLunaparkActions input

110102 | input.actionsEnabled = interpretW3CActions Nil

111103 | otherwise = R.interpretRec (R.on _lunaparkActions (jsonWireActions input) R.send)

112104

113105interpretW3CActions

114− ∷ ∀ e r

106+ ∷ ∀ r

115107 . List LT.ActionSequence

116− → Lunapark e r

117− ~> BaseRun e (lunapark ∷ LUNAPARK|r)

108+ → Lunapark r

109+ ~> BaseRun (lunapark ∷ LUNAPARK|r)

118110interpretW3CActions acc as = case R.peel as of

119111 Left la → case tag la of

120112 Left a → w3cActions acc interpretW3CActions a

121113 Right others → do

122− T.for_ (L.reverse acc) \s → performActions $ SM.singleton "dummy" s

114+ T.for_ (L.reverse acc) \s → performActions $ FO.singleton "dummy" s

123115 cont ← R.send others

124116 interpretW3CActions Nil cont

125117 Right a → pure a

@@ -127,14 +119,14 @@ interpretW3CActions acc as = case R.peel as of

127119 tag = R.on _lunaparkActions Left Right

128120

129121w3cActions

130− ∷ ∀ e r a

122+ ∷ ∀ r a

131123 . List LT.ActionSequence

132124 → ( List LT.ActionSequence

133− → Lunapark e r

134− ~> BaseRun e (lunapark ∷ LUNAPARK|r)

125+ → Lunapark r

126+ ~> BaseRun (lunapark ∷ LUNAPARK|r)

135127 )

136− → ActionF (Lunapark e r a)

137− → BaseRun e (lunapark ∷ LUNAPARK|r) a

128+ → ActionF (Lunapark r a)

129+ → BaseRun (lunapark ∷ LUNAPARK|r) a

138130w3cActions acc loop = case _ of

139131 Click btn next →

140132 let seq = [ LT.pointerDown btn, LT.pointerUp btn ]

@@ -219,7 +211,7 @@ type HandleLunaparkInput =

219211 , actionsEnabled ∷ Boolean

220212 }

221213

222−jsonWireActions ∷ ∀ e r. HandleLunaparkInput → ActionF ~> BaseRun e (lunapark ∷ LUNAPARK|r)

214+jsonWireActions ∷ ∀ r. HandleLunaparkInput → ActionF ~> BaseRun (lunapark ∷ LUNAPARK|r)

223215jsonWireActions inp = case _ of

224216 Click btn next → do

225217 _ ← post (LP.Click : Nil) (LT.encodeButton btn)

@@ -290,7 +282,7 @@ jsonWireActions inp = case _ of

290282 inSession ∷ LP.EndpointPart

291283 inSession = LP.InSession inp.session

292284

293−handleLunapark ∷ ∀ e r. HandleLunaparkInput → LunaparkF ~> BaseRun e r

285+handleLunapark ∷ ∀ r. HandleLunaparkInput → LunaparkF ~> BaseRun r

294286handleLunapark inp = case _ of

295287 Quit next → do

296288 _ ← delete $ inSession : Nil

@@ -300,10 +292,10 @@ handleLunapark inp = case _ of

300292 ss ← throwLeft $ LT.decodeServerStatus res

301293 pure $ cont ss

302294 GetTimeouts cont → do

303− res ← R.liftEff $ Ref.readRef inp.timeoutsRef

295+ res ← R.liftEffect $ Ref.read inp.timeoutsRef

304296 pure $ cont res

305297 SetTimeouts ts next → do

306− R.liftEff $ Ref.writeRef inp.timeoutsRef ts

298+ R.liftEffect $ Ref.write ts inp.timeoutsRef

307299 withFallback "set timeouts"

308300 { w3c: void $ post (inSession : LP.Timeouts : Nil) (LT.encodeTimeouts ts)

309301 , jsonWire: do

@@ -435,7 +427,7 @@ handleLunapark inp = case _ of

435427 Screenshot fp next → do

436428 res ← get (inSession : LP.Screenshot : Nil)

437429 screenshotPack ← throwLeft $ LT.decodeScreenshot res

438− buffer ← R.liftEff $ B.fromString screenshotPack.content screenshotPack.encoding

430+ buffer ← R.liftEffect $ B.fromString screenshotPack.content screenshotPack.encoding

439431 R.liftAff $ FS.writeFile fp buffer

440432 pure next

441433 FindElement loc cont → do

@@ -468,7 +460,7 @@ handleLunapark inp = case _ of

468460 ScreenshotEl fp next → do

469461 res ← get (inSession : inElement : LP.Screenshot : Nil)

470462 screenshotPack ← throwLeft $ LT.decodeScreenshot res

471− buffer ← R.liftEff $ B.fromString screenshotPack.content screenshotPack.encoding

463+ buffer ← R.liftEffect $ B.fromString screenshotPack.content screenshotPack.encoding

472464 R.liftAff $ FS.writeFile fp buffer

473465 pure next

474466 IsSelected cont → do

@@ -518,7 +510,7 @@ handleLunapark inp = case _ of

518510 { script: """var el = arguments[0]; return el.offsetHeight > 0 && el.offsetWidth > 0"""

519511 , args: [ LT.encodeElement el ]

520512 }

521− handleLunapark inp $ ExecuteScript script id

513+ handleLunapark inp $ ExecuteScript script identity

522514 }

523515 map cont $ throwLeft $ J.decodeJson res

524516 Submit next → do

@@ -531,9 +523,9 @@ handleLunapark inp = case _ of

531523 get a = liftAndRethrow $ LP.get inp.uri a

532524 post_ a = liftAndRethrow $ LP.post_ inp.uri a

533525

534− withFallback ∷ ∀ a. String → { w3c ∷ BaseRun e r a, jsonWire ∷ BaseRun e r a } → BaseRun e r a

526+ withFallback ∷ ∀ a. String → { w3c ∷ BaseRun r a, jsonWire ∷ BaseRun r a } → BaseRun r a

535527 withFallback key { w3c: try, jsonWire: fallback } = do

536− mp ← R.liftEff $ Ref.readRef inp.requestMapRef

528+ mp ← R.liftEffect $ Ref.read inp.requestMapRef

537529 case Map.lookup key mp of

538530 Just true → try

539531 Just false → fallback

@@ -541,11 +533,11 @@ handleLunapark inp = case _ of

541533 let

542534 try' = do

543535 a ← try

544− R.liftEff $ Ref.modifyRef inp.requestMapRef (Map.insert key true)

536+ R.liftEffect $ Ref.modify (Map.insert key true) inp.requestMapRef

545537 pure a

546538 fallback' = do

547539 a ← fallback

548− R.liftEff $ Ref.modifyRef inp.requestMapRef (Map.insert key false)

540+ R.liftEffect $ Ref.modify (Map.insert key false) inp.requestMapRef

549541 pure a

550542 in catch try' \_ → fallback'

551543

src/Lunapark/Endpoint.purs+5−6

@@ -7,7 +7,7 @@ module Lunapark.Endpoint where

88import Prelude

10−import Control.Monad.Aff (Aff)

10+import Effect.Aff (Aff)

1111import Data.Argonaut (Json)

1212import Data.Argonaut as J

1313import Data.Bifunctor (lmap)

@@ -18,7 +18,6 @@ import Data.Maybe (Maybe(..))

1818import Data.Newtype (un)

1919import Lunapark.Error as LE

2020import Lunapark.Types as LT

21−import Network.HTTP.Affjax (AJAX)

2221import Network.HTTP.Affjax as N

2322import Network.HTTP.StatusCode (StatusCode(..))

2423

@@ -173,14 +172,14 @@ handleAPIError r = case r.status of

173172 obj J..? "value"

174173 code → Left $ LE.fromJson r.response

175174

176−get ∷ ∀ e. String → Endpoint → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)

175+get ∷ String → Endpoint → Aff (Either LE.Error Json)

177176get uri ep = map handleAPIError $ N.get (uri <> print ep)

178177

179−post ∷ ∀ e. String → Endpoint → Json → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)

178+post ∷ String → Endpoint → Json → Aff (Either LE.Error Json)

180179post uri ep obj = map handleAPIError $ N.post (uri <> print ep) obj

181180

182−post_ ∷ ∀ e. String → Endpoint → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)

181+post_ ∷ String → Endpoint → Aff (Either LE.Error Json)

183182post_ uri ep = map handleAPIError $ N.post' (uri <> print ep) (Nothing ∷ Maybe Unit)

184183

185−delete ∷ ∀ e. String → Endpoint → Aff (ajax ∷ AJAX|e) (Either LE.Error Json)

184+delete ∷ String → Endpoint → Aff (Either LE.Error Json)

186185delete uri ep = map handleAPIError $ N.delete (uri <> print ep)

src/Lunapark/Error.purs+1−1

@@ -105,7 +105,7 @@ type Error =

105105 }

106106

107107fromJson ∷ J.Json → Error

108−fromJson js = either unknownError id do

108+fromJson js = either unknownError identity do

109109 obj ← J.decodeJson js

110110 value ← obj J..? "value"

111111 error ← fromStringCode =<< value J..? "error"

src/Lunapark/LunaparkF.purs+25−25

@@ -81,19 +81,19 @@ quit ∷ ∀ r. WithLunapark r Unit

8181quit = liftLunapark $ Quit unit

8282

8383status ∷ ∀ r. WithLunapark r LT.ServerStatus

84−status = liftLunapark $ Status id

84+status = liftLunapark $ Status identity

8585

8686setTimeouts ∷ ∀ r. LT.Timeouts → WithLunapark r Unit

8787setTimeouts ts = liftLunapark $ SetTimeouts ts unit

8888

8989getTimeouts ∷ ∀ r. WithLunapark r LT.Timeouts

90−getTimeouts = liftLunapark $ GetTimeouts id

90+getTimeouts = liftLunapark $ GetTimeouts identity

9191

9292go ∷ ∀ r. String → WithLunapark r Unit

9393go uri = liftLunapark $ GoTo uri unit

9494

9595getUrl ∷ ∀ r. WithLunapark r String

96−getUrl = liftLunapark $ GetUrl id

96+getUrl = liftLunapark $ GetUrl identity

9797

9898forward ∷ ∀ r. WithLunapark r Unit

9999forward = liftLunapark $ Forward unit

@@ -105,13 +105,13 @@ refresh ∷ ∀ r. WithLunapark r Unit

105105refresh = liftLunapark $ Refresh unit

106106

107107getTitle ∷ ∀ r. WithLunapark r String

108−getTitle = liftLunapark $ GetTitle id

108+getTitle = liftLunapark $ GetTitle identity

109109

110110getWindowHandle ∷ ∀ r. WithLunapark r LT.WindowHandle

111−getWindowHandle = liftLunapark $ GetWindowHandle id

111+getWindowHandle = liftLunapark $ GetWindowHandle identity

112112

113113getWindowHandles ∷ ∀ r. WithLunapark r (Array LT.WindowHandle)

114−getWindowHandles = liftLunapark $ GetWindowHandles id

114+getWindowHandles = liftLunapark $ GetWindowHandles identity

115115

116116closeWindow ∷ ∀ r. WithLunapark r Unit

117117closeWindow = liftLunapark $ CloseWindow unit

@@ -126,7 +126,7 @@ switchToParentFrame ∷ ∀ r. WithLunapark r Unit

126126switchToParentFrame = liftLunapark $ SwitchToParentFrame unit

127127

128128getWindowRectangle ∷ ∀ r. WithLunapark r LT.Rectangle

129−getWindowRectangle = liftLunapark $ GetWindowRectangle id

129+getWindowRectangle = liftLunapark $ GetWindowRectangle identity

130130

131131setWindowRectangle ∷ ∀ r. LT.Rectangle → WithLunapark r Unit

132132setWindowRectangle r = liftLunapark $ SetWindowRectangle r unit

@@ -141,16 +141,16 @@ fullscreenWindow ∷ ∀ r. WithLunapark r Unit

141141fullscreenWindow = liftLunapark $ FullscreenWindow unit

142142

143143executeScript ∷ ∀ r. LT.Script → WithLunapark r J.Json

144−executeScript script = liftLunapark $ ExecuteScript script id

144+executeScript script = liftLunapark $ ExecuteScript script identity

145145

146146executeScriptAsync ∷ ∀ r. LT.Script → WithLunapark r J.Json

147−executeScriptAsync script = liftLunapark $ ExecuteScriptAsync script id

147+executeScriptAsync script = liftLunapark $ ExecuteScriptAsync script identity

148148

149149getAllCookies ∷ ∀ r. WithLunapark r (Array LT.Cookie)

150−getAllCookies = liftLunapark $ GetAllCookies id

150+getAllCookies = liftLunapark $ GetAllCookies identity

151151

152152getCookie ∷ ∀ r. String → WithLunapark r LT.Cookie

153−getCookie name = liftLunapark $ GetCookie name id

153+getCookie name = liftLunapark $ GetCookie name identity

154154

155155addCookie ∷ ∀ r. LT.Cookie → WithLunapark r Unit

156156addCookie cookie = liftLunapark $ AddCookie cookie unit

@@ -168,7 +168,7 @@ acceptAlert ∷ ∀ r. WithLunapark r Unit

168168acceptAlert = liftLunapark $ AcceptAlert unit

169169

170170getAlertText ∷ ∀ r. WithLunapark r String

171−getAlertText = liftLunapark $ GetAlertText id

171+getAlertText = liftLunapark $ GetAlertText identity

172172

173173sendAlertText ∷ ∀ r. String → WithLunapark r Unit

174174sendAlertText txt = liftLunapark $ SendAlertText txt unit

@@ -180,40 +180,40 @@ elementScreenshot ∷ ∀ r. LT.Element → String → WithLunapark r Unit

180180elementScreenshot el fp = liftLunapark $ OnElement el $ ScreenshotEl fp unit

181181

182182findElement ∷ ∀ r. LT.Locator → WithLunapark r LT.Element

183−findElement l = liftLunapark $ FindElement l id

183+findElement l = liftLunapark $ FindElement l identity

184184

185185findElements ∷ ∀ r. LT.Locator → WithLunapark r (Array LT.Element)

186−findElements l = liftLunapark $ FindElements l id

186+findElements l = liftLunapark $ FindElements l identity

187187

188188childElement ∷ ∀ r. LT.Element → LT.Locator → WithLunapark r LT.Element

189−childElement el l = liftLunapark $ OnElement el $ ChildElement l id

189+childElement el l = liftLunapark $ OnElement el $ ChildElement l identity

190190

191191childElements ∷ ∀ r. LT.Element → LT.Locator → WithLunapark r (Array LT.Element)

192−childElements el l = liftLunapark $ OnElement el $ ChildElements l id

192+childElements el l = liftLunapark $ OnElement el $ ChildElements l identity

193193

194194isSelected ∷ ∀ r. LT.Element → WithLunapark r Boolean

195−isSelected el = liftLunapark $ OnElement el $ IsSelected id

195+isSelected el = liftLunapark $ OnElement el $ IsSelected identity

196196

197197getAttribute ∷ ∀ r. LT.Element → String → WithLunapark r String

198−getAttribute el name = liftLunapark $ OnElement el $ GetAttribute name id

198+getAttribute el name = liftLunapark $ OnElement el $ GetAttribute name identity

199199

200200getProperty ∷ ∀ r. LT.Element → String → WithLunapark r J.Json

201−getProperty el name = liftLunapark $ OnElement el $ GetProperty name id

201+getProperty el name = liftLunapark $ OnElement el $ GetProperty name identity

202202

203203getCss ∷ ∀ r. LT.Element → String → WithLunapark r String

204−getCss el name = liftLunapark $ OnElement el $ GetCss name id

204+getCss el name = liftLunapark $ OnElement el $ GetCss name identity

205205

206206getText ∷ ∀ r. LT.Element → WithLunapark r String

207−getText el = liftLunapark $ OnElement el $ GetText id

207+getText el = liftLunapark $ OnElement el $ GetText identity

208208

209209getTagName ∷ ∀ r. LT.Element → WithLunapark r String

210−getTagName el = liftLunapark $ OnElement el $ GetTagName id

210+getTagName el = liftLunapark $ OnElement el $ GetTagName identity

211211

212212getRectangle ∷ ∀ r. LT.Element → WithLunapark r LT.Rectangle

213−getRectangle el = liftLunapark $ OnElement el $ GetRectangle id

213+getRectangle el = liftLunapark $ OnElement el $ GetRectangle identity

214214

215215isEnabled ∷ ∀ r. LT.Element → WithLunapark r Boolean

216−isEnabled el = liftLunapark $ OnElement el $ IsEnabled id

216+isEnabled el = liftLunapark $ OnElement el $ IsEnabled identity

217217

218218clickElement ∷ ∀ r. LT.Element → WithLunapark r Unit

219219clickElement el = liftLunapark $ OnElement el $ ClickEl unit

@@ -225,7 +225,7 @@ sendKeysElement ∷ ∀ r. LT.Element → String → WithLunapark r Unit

225225sendKeysElement el txt = liftLunapark $ OnElement el $ SendKeysEl txt unit

226226

227227isDisplayed ∷ ∀ r. LT.Element → WithLunapark r Boolean

228−isDisplayed el = liftLunapark $ OnElement el $ IsDisplayed id

228+isDisplayed el = liftLunapark $ OnElement el $ IsDisplayed identity

229229

230230submitElement ∷ ∀ r. LT.Element → WithLunapark r Unit

231231submitElement el = liftLunapark $ OnElement el $ Submit unit

src/Lunapark/Types.purs+42−41

@@ -12,17 +12,18 @@ import Data.Argonaut (Json, (.?))

1212import Data.Argonaut as J

1313import Data.Array as A

1414import Data.Either (Either(..))

15−import Data.Traversable as F

1615import Data.Map as Map

1716import Data.Maybe (Maybe(..))

1817import Data.Newtype (class Newtype, un)

19−import Data.StrMap as SM

2018import Data.String as Str

2119import Data.Symbol (SProxy(..))

2220import Data.Time.Duration (Milliseconds(..))

21+import Data.Traversable as F

2322import Data.Tuple (Tuple(..))

2423import Data.Variant as V

25−import Data.XPath.Types as X

24+import Data.XPath.AST as XA

25+import Data.XPath.Printer (printPath)

26+import Foreign.Object as FO

2627import Node.Encoding as NE

2728import Node.Path (FilePath)

2829

@@ -45,7 +46,7 @@ decodeElement = J.decodeJson >=> \obj →

4546 map Element $ obj .? "element-6066-11e4-a52e-4f735466cecf" <|> obj .? "ELEMENT"

4647

4748encodeElement ∷ Element → Json

48−encodeElement (Element eid) = J.encodeJson $ SM.fromFoldable

49+encodeElement (Element eid) = J.encodeJson $ FO.fromFoldable

4950 [ Tuple "element-6066-11e4-a52e-4f735466cecf" eid

5051 , Tuple "ELEMENT" eid

5152 ]

@@ -86,7 +87,7 @@ decodeTimeouts = J.decodeJson >=> \obj → do

8687 pure { script, pageLoad, implicit }

8788

8889encodeTimeouts ∷ Timeouts → Json

89−encodeTimeouts r = J.encodeJson $ SM.fromFoldable

90+encodeTimeouts r = J.encodeJson $ FO.fromFoldable

9091 [ Tuple "script" (un Milliseconds r.script)

9192 , Tuple "pageLoad" (un Milliseconds r.pageLoad)

9293 , Tuple "implicit" (un Milliseconds r.implicit)

@@ -94,22 +95,22 @@ encodeTimeouts r = J.encodeJson $ SM.fromFoldable

9495

9596encodeLegacyTimeouts ∷ Timeouts → Array Json

9697encodeLegacyTimeouts r =

97− [ J.encodeJson $ SM.singleton "script" $ un Milliseconds r.script

98− , J.encodeJson $ SM.singleton "implicit" $ un Milliseconds r.implicit

99− , J.encodeJson $ SM.singleton "page load" $ un Milliseconds r.pageLoad

98+ [ J.encodeJson $ FO.singleton "script" $ un Milliseconds r.script

99+ , J.encodeJson $ FO.singleton "implicit" $ un Milliseconds r.implicit

100+ , J.encodeJson $ FO.singleton "page load" $ un Milliseconds r.pageLoad

100101 ]

101102

102103encodeGoRequest ∷ String → Json

103−encodeGoRequest url = J.encodeJson $ SM.fromFoldable [ Tuple "url" url ]

104+encodeGoRequest url = J.encodeJson $ FO.fromFoldable [ Tuple "url" url ]

104105

105106decodeWindowHandle ∷ Json → Either String WindowHandle

106107decodeWindowHandle = map WindowHandle <<< J.decodeJson

107108

108109encodeSwitchToWindowRequest ∷ WindowHandle → Json

109−encodeSwitchToWindowRequest w = J.encodeJson $ SM.fromFoldable [ Tuple "handle" $ un WindowHandle w ]

110+encodeSwitchToWindowRequest w = J.encodeJson $ FO.fromFoldable [ Tuple "handle" $ un WindowHandle w ]

110111

111112encodeFrameId ∷ FrameId → Json

112−encodeFrameId fid = J.encodeJson $ SM.fromFoldable [ Tuple "id" encoded ]

113+encodeFrameId fid = J.encodeJson $ FO.fromFoldable [ Tuple "id" encoded ]

113114 where

114115 encoded = case fid of

115116 TopFrame → J.jsonNull

@@ -143,12 +144,12 @@ decodeRectangleLegacy { size, position } = do

143144

144145encodeRectangleLegacy ∷ Rectangle → { size ∷ Json, position ∷ Json }

145146encodeRectangleLegacy r =

146− { size: J.encodeJson $ SM.fromFoldable [ Tuple "width" r.width, Tuple "height" r.height ]

147− , position: J.encodeJson $ SM.fromFoldable [ Tuple "x" r.x, Tuple "y" r.y ]

147+ { size: J.encodeJson $ FO.fromFoldable [ Tuple "width" r.width, Tuple "height" r.height ]

148+ , position: J.encodeJson $ FO.fromFoldable [ Tuple "x" r.x, Tuple "y" r.y ]

148149 }

149150

150151encodeRectangle ∷ Rectangle → Json

151−encodeRectangle r = J.encodeJson $ SM.fromFoldable

152+encodeRectangle r = J.encodeJson $ FO.fromFoldable

152153 [ Tuple "width" r.width

153154 , Tuple "height" r.height

154155 , Tuple "x" r.x

@@ -157,7 +158,7 @@ encodeRectangle r = J.encodeJson $ SM.fromFoldable

157158

158159data Locator

159160 = ByCss CSS.Selector

160− | ByXPath X.XPath

161+ | ByXPath XA.Path

161162 | ByTagName String

162163 | ByLinkText String

163164 | ByPartialLinkText String

@@ -169,14 +170,14 @@ type RawLocator =

169170 }

170171

171172encodeLocator ∷ Locator → Json

172−encodeLocator l = J.encodeJson $ SM.fromFoldable case l of

173+encodeLocator l = J.encodeJson $ FO.fromFoldable case l of

173174 ByCss sel →

174175 [ Tuple "using" "css selector"

175176 , Tuple "value" $ CSSR.selector sel

176177 ]

177178 ByXPath sel →

178179 [ Tuple "using" "xpath"

179− , Tuple "value" $ X.printXPath sel

180+ , Tuple "value" $ printPath sel

180181 ]

181182 ByLinkText sel →

182183 [ Tuple "using" "link text"

@@ -196,7 +197,7 @@ encodeLocator l = J.encodeJson $ SM.fromFoldable case l of

196197 ]

197198

198199encodeSendKeysRequest ∷ String → Json

199−encodeSendKeysRequest txt = J.encodeJson $ SM.fromFoldable [ Tuple "text" txt ]

200+encodeSendKeysRequest txt = J.encodeJson $ FO.fromFoldable [ Tuple "text" txt ]

200201

201202type Script =

202203 { script ∷ String

@@ -204,7 +205,7 @@ type Script =

204205 }

205206

206207encodeScript ∷ Script → Json

207−encodeScript r = J.encodeJson $ SM.fromFoldable

208+encodeScript r = J.encodeJson $ FO.fromFoldable

208209 [ Tuple "script" $ J.encodeJson r.script

209210 , Tuple "args" $ J.encodeJson r.args

210211 ]

@@ -220,8 +221,8 @@ type Cookie =

220221 }

221222

222223encodeCookie ∷ Cookie → Json

223−encodeCookie r = J.encodeJson $ SM.fromFoldable

224− [ Tuple "cookie" $ SM.fromFoldable

224+encodeCookie r = J.encodeJson $ FO.fromFoldable

225+ [ Tuple "cookie" $ FO.fromFoldable

225226 $ [ Tuple "name" $ J.encodeJson r.name

226227 , Tuple "value" $ J.encodeJson r.value

227228 ]

@@ -293,8 +294,8 @@ type PointerMove =

293294 , y ∷ Int

294295 }

295296

296−encodePointerMove ∷ PointerMove → SM.StrMap Json

297−encodePointerMove r = SM.fromFoldable

297+encodePointerMove ∷ PointerMove → FO.Object Json

298+encodePointerMove r = FO.fromFoldable

298299 [ Tuple "x" $ J.encodeJson r.x

299300 , Tuple "y" $ J.encodeJson r.y

300301 , Tuple "duration" $ J.encodeJson $ un Milliseconds r.duration

@@ -332,32 +333,32 @@ pointerMove = V.inj (SProxy ∷ SProxy "pointerMove")

332333encodeAction ∷ Action → Json

333334encodeAction = V.match

334335 { pause: \ms →

335− J.encodeJson $ SM.fromFoldable

336+ J.encodeJson $ FO.fromFoldable

336337 [ Tuple "duration" $ J.encodeJson $ un Milliseconds ms

337338 , Tuple "type" $ J.encodeJson "pause"

338339 ]

339340 , keyDown: \ch →

340− J.encodeJson $ SM.fromFoldable

341+ J.encodeJson $ FO.fromFoldable

341342 [ Tuple "value" $ J.encodeJson ch

342343 , Tuple "type" $ J.encodeJson "keyDown"

343344 ]

344345 , keyUp: \ch →

345− J.encodeJson $ SM.fromFoldable

346+ J.encodeJson $ FO.fromFoldable

346347 [ Tuple "value" $ J.encodeJson ch

347348 , Tuple "type" $ J.encodeJson "keyUp"

348349 ]

349350 , pointerUp: \btn →

350− J.encodeJson $ SM.fromFoldable

351+ J.encodeJson $ FO.fromFoldable

351352 [ Tuple "button" $ encodeButton btn

352353 , Tuple "type" $ J.encodeJson "pointerUp"

353354 ]

354355 , pointerDown: \btn →

355− J.encodeJson $ SM.fromFoldable

356+ J.encodeJson $ FO.fromFoldable

356357 [ Tuple "button" $ encodeButton btn

357358 , Tuple "type" $ J.encodeJson "pointerDown"

358359 ]

359360 , pointerMove: \pm →

360− J.encodeJson $ SM.insert "type" (J.encodeJson "pointerMove") $ encodePointerMove pm

361+ J.encodeJson $ FO.insert "type" (J.encodeJson "pointerMove") $ encodePointerMove pm

361362 }

362363

363364

@@ -378,31 +379,31 @@ data ActionSequence

378379 (Array (V.Variant (pause ∷ Milliseconds, pointerUp ∷ Button, pointerDown ∷ Button, pointerMove ∷ PointerMove)))

379380

380381-- Right, this is not an `Array` but `StrMap` because all `ActionSequence`s are tagged with unique id's

381−type ActionRequest = SM.StrMap ActionSequence

382+type ActionRequest = FO.Object ActionSequence

382383

383384encodeActionRequest ∷ ActionRequest → Json

384−encodeActionRequest sm = J.encodeJson $ SM.singleton "actions" $ map encodePair arrayOfPairs

385+encodeActionRequest sm = J.encodeJson $ FO.singleton "actions" $ map encodePair arrayOfPairs

385386 where

386387 arrayOfPairs ∷ Array (Tuple String ActionSequence)

387− arrayOfPairs = SM.toUnfoldable sm

388+ arrayOfPairs = FO.toUnfoldable sm

388389

389390 encodePair ∷ Tuple String ActionSequence → Json

390391 encodePair (Tuple identifier sequence) =

391− J.encodeJson $ SM.insert "id" (J.encodeJson identifier) $ encodeSequence sequence

392+ J.encodeJson $ FO.insert "id" (J.encodeJson identifier) $ encodeSequence sequence

392393

393− encodeSequence ∷ ActionSequence → J.JObject

394+ encodeSequence ∷ ActionSequence → FO.Object Json

394395 encodeSequence = case _ of

395− NoSource as → SM.fromFoldable

396+ NoSource as → FO.fromFoldable

396397 [ Tuple "type" $ J.encodeJson "none"

397398 , Tuple "actions" $ J.encodeJson $ map (encodeAction <<< V.expand) as

398399 ]

399− Key as → SM.fromFoldable

400+ Key as → FO.fromFoldable

400401 [ Tuple "type" $ J.encodeJson "key"

401402 , Tuple "actions" $ J.encodeJson $ map (encodeAction <<< V.expand) as

402403 ]

403− Pointer ptype as → SM.fromFoldable

404+ Pointer ptype as → FO.fromFoldable

404405 [ Tuple "type" $ J.encodeJson "pointer"

405− , Tuple "parameters" $ J.encodeJson $ SM.singleton "pointerType" $ printPointerType ptype

406+ , Tuple "parameters" $ J.encodeJson $ FO.singleton "pointerType" $ printPointerType ptype

406407 , Tuple "actions" $ J.encodeJson $ map (encodeAction <<< V.expand) as

407408 ]

408409

@@ -479,7 +480,7 @@ encodeCapabilities = F.foldl (\b a → J.extend (encodeCapability a) b) J.jsonEm

479480

480481decodeCapabilities ∷ Json → Either String (Array Capability)

481482decodeCapabilities = J.decodeJson >=> \obj →

482− F.for (SM.toUnfoldable obj) \l@(Tuple key val) →

483+ F.for (FO.toUnfoldable obj) \l@(Tuple key val) →

483484 decodeCapability l <|> Right (CustomCapability key val)

484485 where

485486 decodeCapability ∷ Tuple String Json → Either String Capability

@@ -518,7 +519,7 @@ type CapabilitiesRequest =

518519 }

519520

520521encodeCapabilitiesRequest ∷ CapabilitiesRequest → Json

521−encodeCapabilitiesRequest r = J.encodeJson $ SM.singleton "capabilities" $ SM.fromFoldable

522+encodeCapabilitiesRequest r = J.encodeJson $ FO.singleton "capabilities" $ FO.fromFoldable

522523 [ Tuple "alwaysMatch" $ encodeCapabilities r.alwaysMatch

523524 , Tuple "firstMatch" $ J.encodeJson $ map encodeCapabilities r.firstMatch

524525 ]

@@ -530,7 +531,7 @@ type MoveToRequest =

530531 }

531532

532533encodeMoveToRequest ∷ MoveToRequest → Json

533−encodeMoveToRequest r = J.encodeJson $ SM.fromFoldable

534+encodeMoveToRequest r = J.encodeJson $ FO.fromFoldable

534535 [ Tuple "element" $ case r.element of

535536 Nothing → J.jsonNull

536537 Just el → J.encodeJson $ un Element el

src/Lunapark/Utils.purs+4−4

@@ -2,7 +2,7 @@ module Lunapark.Utils where

33import Prelude

5−import Control.Monad.Aff (Aff)

5+import Effect.Aff (Aff)

66import Data.Bifunctor (lmap)

77import Data.Either (Either)

88import Lunapark.Error as LE

@@ -11,9 +11,9 @@ import Run.Except as RE

1111import Unsafe.Coerce (unsafeCoerce)

1212

1313liftAndRethrow

14− ∷ ∀ e r ε ω

15− . Aff e (Either ε ω)

16− → R.Run (aff ∷ R.AFF e, except ∷ RE.EXCEPT ε|r) ω

14+ ∷ ∀ r ε ω

15+ . Aff (Either ε ω)

16+ → R.Run (aff ∷ R.AFF, except ∷ RE.EXCEPT ε|r) ω

1717liftAndRethrow a = do

1818 res ← R.liftAff a

1919 RE.rethrow res