Merge pull request #20 from slamdata/ps-0.14

Update for GH actions, PS 0.14

.github/workflows/ci.yml

@@ -0,0 +1,31 @@
+name: CI
+
+on:
+  - push
+  - pull_request
+
+jobs:
+  build:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v2
+
+      - uses: purescript-contrib/setup-purescript@main
+
+      - uses: actions/setup-node@v1
+        with:
+          node-version: "12"
+
+      - name: Install dependencies
+        run: |
+          npm install -g bower
+          npm install
+          bower install --production
+
+      - name: Build source
+        run: npm run-script build
+
+      - name: Run tests
+        run: |
+          bower install
+          npm run-script test --if-present

.gitignore

@@ -1,8 +1,7 @@
 /.*
 !/.gitignore
-!/.travis.yml
+!/.github
 /bower_components/
 /node_modules/
 /output/
-/example/dist/test.js
 package-lock.json

README.md

@@ -1,7 +1,7 @@
 # purescript-lunapark
 
 [![Latest release](http://img.shields.io/github/release/slamdata/purescript-lunapark.svg)](https://github.com/slamdata/purescript-lunapark/releases)
-[![Build status](https://travis-ci.org/slamdata/purescript-lunapark.svg?branch=master)](https://travis-ci.org/slamdata/purescript-lunapark)
+![Build Status](https://github.com/slamdata/purescript-lunapark/actions/workflows/ci.yml/badge.svg)
 
 ## Disclaimer
 

bower.json

@@ -25,11 +25,11 @@
     "vendor"
   ],
   "dependencies": {
-    "purescript-affjax": "^11.0.0",
-    "purescript-argonaut-codecs": "^7.0.0",
-    "purescript-argonaut-core": "^5.0.0",
-    "purescript-css": "^4.0.0",
-    "purescript-node-fs-aff": "^6.0.0",
-    "purescript-run": "^3.0.0"
+    "purescript-affjax": "^12.0.0",
+    "purescript-argonaut-codecs": "^8.1.0",
+    "purescript-argonaut-core": "^6.0.0",
+    "purescript-css": "^5.0.1",
+    "purescript-node-fs-aff": "^7.0.0",
+    "purescript-run": "^4.0.0"
   }
 }

package.json

@@ -2,16 +2,12 @@
   "name": "purescript-lunapark",
   "private": true,
   "scripts": {
-    "build": "spago build --purs-args '--censor-lib --strict'",
-    "build:non-strict": "spago build",
-    "ide": "purs ide server"
+    "build": "pulp build -- --censor-lib --strict"
   },
   "license": "Apache-2.0",
   "dependencies": {
-    "chromedriver": "^86.0.0",
     "pulp": "^15.0.0",
-    "purescript": "^0.13.8",
-    "purescript-psa": "^0.8.0",
-    "xhr2": "^0.2.0"
+    "purescript": "^0.14.2",
+    "purescript-psa": "^0.8.2"
   }
 }

src/Lunapark.purs

@@ -8,9 +8,9 @@ module Lunapark
   ) where
 
 
-import Lunapark.API (Lunapark, Interpreter(..), runInterpreter, BaseEffects, HandleLunaparkInput, handleLunapark, init, interpret, interpretW3CActions, jsonWireActions, runLunapark, runLunaparkActions, w3cActions)
+import Lunapark.API (Lunapark, Interpreter(..), runInterpreter, BASE_EFFECTS, HandleLunaparkInput, handleLunapark, init, interpret, interpretW3CActions, jsonWireActions, runLunapark, runLunaparkActions, w3cActions)
 import Lunapark.Error (Error(..), CachingError(..), printError)
-import Lunapark.ActionF (ActionF(..), LUNAPARK_ACTIONS, TouchF(..), ActionsEffect, _lunaparkActions, buttonDown, buttonUp, click, doubleClick, doubleTap, flick, liftAction, longTap, moveTo, pause, scroll, sendKeys, tap, touchDown, touchUp)
-import Lunapark.LunaparkF (ElementF(..), LUNAPARK, LunaparkF(..), LunaparkEffect, _lunapark, acceptAlert, addCookie, back, childElement, childElements, clearElement, clickElement, closeWindow, deleteAllCookies, deleteCookie, dismissAlert, elementScreenshot, executeScript, executeScriptAsync, findElement, findElements, forward, fullscreenWindow, getAlertText, getAllCookies, getAttribute, getCookie, getCss, getProperty, getRectangle, getTagName, getText, getTimeouts, getTitle, getUrl, getWindowHandle, getWindowHandles, getWindowRectangle, go, isDisplayed, isEnabled, isSelected, liftLunapark, maximizeWindow, minimizeWindow, performActions, quit, refresh, releaseActions, screenshot, sendAlertText, sendKeysElement, setTimeouts, setWindowRectangle, status, submitElement, switchToFrame, switchToParentFrame, switchToWindow)
+import Lunapark.ActionF (ActionF(..), LUNAPARK_ACTIONS, TouchF(..), _lunaparkActions, buttonDown, buttonUp, click, doubleClick, doubleTap, flick, liftAction, longTap, moveTo, pause, scroll, sendKeys, tap, touchDown, touchUp)
+import Lunapark.LunaparkF (ElementF(..), LUNAPARK, LunaparkF(..), _lunapark, acceptAlert, addCookie, back, childElement, childElements, clearElement, clickElement, closeWindow, deleteAllCookies, deleteCookie, dismissAlert, elementScreenshot, executeScript, executeScriptAsync, findElement, findElements, forward, fullscreenWindow, getAlertText, getAllCookies, getAttribute, getCookie, getCss, getProperty, getRectangle, getTagName, getText, getTimeouts, getTitle, getUrl, getWindowHandle, getWindowHandles, getWindowRectangle, go, isDisplayed, isEnabled, isSelected, liftLunapark, maximizeWindow, minimizeWindow, performActions, quit, refresh, releaseActions, screenshot, sendAlertText, sendKeysElement, setTimeouts, setWindowRectangle, status, submitElement, switchToFrame, switchToParentFrame, switchToWindow)
 import Lunapark.WebDriverError (WebDriverError, WebDriverErrorType(..), fromJson, fromStringCode, toStringCode)
 import Lunapark.Types (SessionId(..), WindowHandle(..), FrameId(..), Element(..), CreateSessionResponse, ServerStatus, Timeouts, Rectangle, RawLocator, Locator(..), Script, Cookie, Screenshot, Button(..), PointerMoveOrigin(..), PointerMove, Action, PointerType(..), ActionSequence(..), ActionRequest, BrowserType(..), DriverPaths, PageLoad(..), UnhandledPrompt(..), Platform(..), Capability(..), CapabilitiesRequest, MoveToRequest)

src/Lunapark/API.purs

@@ -22,10 +22,10 @@ import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (liftEffect)
 import Effect.Ref as Ref
 import Foreign.Object as FO
-import Lunapark.ActionF (_lunaparkActions, ActionF(..), TouchF(..), ActionsEffect)
+import Lunapark.ActionF (_lunaparkActions, ActionF(..), TouchF(..), LUNAPARK_ACTIONS)
 import Lunapark.Endpoint as LP
 import Lunapark.Error as LE
-import Lunapark.LunaparkF (_lunapark, ElementF(..), LunaparkF(..), LunaparkEffect, performActions, findElement)
+import Lunapark.LunaparkF (_lunapark, ElementF(..), LunaparkF(..), LUNAPARK, performActions, findElement)
 import Lunapark.Types as LT
 import Lunapark.Utils (liftAndRethrow, rethrowAsJsonDecodeError, catch)
 import Node.Buffer as B
@@ -36,11 +36,11 @@ import Run.Except (EXCEPT)
 import Type.Row (type (+))
 import Run.Except as RE
 
-type Lunapark r a = Run (BaseEffects + LunaparkEffect + ActionsEffect + r) a
+type Lunapark r a = Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r) a
 
-newtype Interpreter r = Interpreter (Run (BaseEffects + LunaparkEffect + ActionsEffect + r) ~> Run (BaseEffects r))
+newtype Interpreter r = Interpreter (Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r) ~> Run (BASE_EFFECTS r))
 
-runInterpreter ∷ ∀ r. Interpreter r → Run (BaseEffects + LunaparkEffect + ActionsEffect + r) ~> Run (BaseEffects r)
+runInterpreter ∷ ∀ r. Interpreter r → Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r) ~> Run (BASE_EFFECTS r)
 runInterpreter (Interpreter f) = f
 
 init
@@ -93,33 +93,29 @@ init uri caps = do
 interpret
   ∷ ∀ r
   . HandleLunaparkInput
-  → Run (BaseEffects + LunaparkEffect + ActionsEffect + r )
-  ~> Run (BaseEffects r)
+  → Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r )
+  ~> Run (BASE_EFFECTS r)
 interpret input = runLunapark input <<< runLunaparkActions input
 
-type BaseEffects r =
-  ( except ∷ EXCEPT LE.Error
-  , aff ∷ R.AFF
-  , effect ∷ R.EFFECT
-  | r)
+type BASE_EFFECTS r = EXCEPT LE.Error + R.AFF + R.EFFECT + r
 
-runLunapark ∷ ∀ r. HandleLunaparkInput → Run (BaseEffects + LunaparkEffect + r) ~> Run (BaseEffects r)
+runLunapark ∷ ∀ r. HandleLunaparkInput → Run (BASE_EFFECTS + LUNAPARK + r) ~> Run (BASE_EFFECTS r)
 runLunapark input = do
   R.interpretRec (R.on _lunapark (handleLunapark input) R.send)
 
 runLunaparkActions
   ∷ ∀ r. HandleLunaparkInput
-  → Run (BaseEffects + LunaparkEffect + ActionsEffect + r )
-  ~> Run (BaseEffects + LunaparkEffect + r)
+  → Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r )
+  ~> Run (BASE_EFFECTS + LUNAPARK + r)
 runLunaparkActions input
   | input.actionsEnabled = interpretW3CActions Nil
   | otherwise = R.interpretRec (R.on _lunaparkActions (jsonWireActions input) R.send)
 
 interpretW3CActions
   ∷ ∀ r
   . List LT.ActionSequence
-  → Run (BaseEffects + LunaparkEffect + ActionsEffect + r )
-  ~> Run (BaseEffects + LunaparkEffect + r )
+  → Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r )
+  ~> Run (BASE_EFFECTS + LUNAPARK + r )
 interpretW3CActions acc as = case R.peel as of
   Left la → case tag la of
     Left a → w3cActions acc interpretW3CActions a
@@ -135,11 +131,11 @@ w3cActions
   ∷ ∀ r a
   . List LT.ActionSequence
   → ( List LT.ActionSequence
-    → Run (BaseEffects + LunaparkEffect + ActionsEffect + r )
-    ~> Run (BaseEffects + LunaparkEffect + r)
+    → Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r )
+    ~> Run (BASE_EFFECTS + LUNAPARK + r)
     )
-  → ActionF (Run (BaseEffects + LunaparkEffect + ActionsEffect + r ) a)
-  → Run (BaseEffects + LunaparkEffect + r) a
+  → ActionF (Run (BASE_EFFECTS + LUNAPARK + LUNAPARK_ACTIONS + r ) a)
+  → Run (BASE_EFFECTS + LUNAPARK + r) a
 w3cActions acc loop = case _ of
   Click btn next →
     let seq = [ LT.pointerDown btn, LT.pointerUp btn ]
@@ -224,7 +220,7 @@ type HandleLunaparkInput =
   , actionsEnabled ∷ Boolean
   }
 
-jsonWireActions ∷ ∀ r. HandleLunaparkInput → ActionF ~> Run (BaseEffects + LunaparkEffect + r)
+jsonWireActions ∷ ∀ r. HandleLunaparkInput → ActionF ~> Run (BASE_EFFECTS + LUNAPARK + r)
 jsonWireActions inp = case _ of
   Click btn next → do
     _ ← post (LP.Click : Nil) (LT.encodeButton btn)
@@ -238,7 +234,7 @@ jsonWireActions inp = case _ of
   DoubleClick btn next → do
     _ ← case btn of
       LT.LeftBtn → post' (LP.DoubleClick : Nil)
-      other → do
+      _ → do
         _ ← post (LP.Click : Nil) (LT.encodeButton btn)
         post (LP.Click : Nil) (LT.encodeButton btn)
     pure next
@@ -295,7 +291,7 @@ jsonWireActions inp = case _ of
   inSession ∷ LP.EndpointPart
   inSession = LP.InSession inp.session
 
-handleLunapark ∷ ∀ r. HandleLunaparkInput → LunaparkF ~> Run (BaseEffects r)
+handleLunapark ∷ ∀ r. HandleLunaparkInput → LunaparkF ~> Run (BASE_EFFECTS r)
 handleLunapark inp = case _ of
   Quit next → do
     _ ← delete $ inSession : Nil
@@ -542,7 +538,7 @@ handleLunapark inp = case _ of
 
   -- | It caches an index of an action that is valid for current webdriver implementation.
   -- | So you don't need to search correct one by tring them each time
-  tryAndCache ∷ ∀ a. String → Array (Run (BaseEffects r) a) → Run (BaseEffects r) a
+  tryAndCache ∷ ∀ a. String → Array (Run (BASE_EFFECTS r) a) → Run (BASE_EFFECTS r) a
   tryAndCache key actions = do
     mp ← R.liftEffect $ Ref.read inp.requestMapRef
     case Map.lookup key mp of

src/Lunapark/ActionF.purs

@@ -8,7 +8,6 @@ import Lunapark.Types as LT
 import Run (Run)
 import Run as R
 
-
 data ActionF a
   = Click LT.Button a
   | ButtonDown LT.Button a
@@ -32,50 +31,49 @@ derive instance functorActionF ∷ Functor ActionF
 derive instance functorTouchF ∷ Functor TouchF
 
 _lunaparkActions = SProxy ∷ SProxy "lunaparkActions"
-type LUNAPARK_ACTIONS = R.FProxy ActionF
-type ActionsEffect r = ( lunaparkActions ∷ LUNAPARK_ACTIONS | r )
+type LUNAPARK_ACTIONS r = ( lunaparkActions ∷ ActionF | r )
 
-liftAction ∷ ∀ r. ActionF Unit → Run (ActionsEffect r) Unit
+liftAction ∷ ∀ r. ActionF Unit → Run (LUNAPARK_ACTIONS r) Unit
 liftAction = R.lift _lunaparkActions
 
-click ∷ ∀ r. LT.Button → Run (ActionsEffect r) Unit
+click ∷ ∀ r. LT.Button → Run (LUNAPARK_ACTIONS r) Unit
 click btn = liftAction $ Click btn unit
 
-buttonDown ∷ ∀ r. LT.Button → Run (ActionsEffect r) Unit
+buttonDown ∷ ∀ r. LT.Button → Run (LUNAPARK_ACTIONS r) Unit
 buttonDown btn = liftAction $ ButtonDown btn unit
 
-buttonUp ∷ ∀ r. LT.Button → Run (ActionsEffect r) Unit
+buttonUp ∷ ∀ r. LT.Button → Run (LUNAPARK_ACTIONS r) Unit
 buttonUp btn = liftAction $ ButtonUp btn unit
 
-doubleClick ∷ ∀ r. LT.Button → Run (ActionsEffect r) Unit
+doubleClick ∷ ∀ r. LT.Button → Run (LUNAPARK_ACTIONS r) Unit
 doubleClick btn = liftAction $ DoubleClick btn unit
 
-sendKeys ∷ ∀ r. String → Run (ActionsEffect r) Unit
+sendKeys ∷ ∀ r. String → Run (LUNAPARK_ACTIONS r) Unit
 sendKeys txt = liftAction $ SendKeys txt unit
 
-moveTo ∷ ∀ r. LT.PointerMove → Run (ActionsEffect r) Unit
+moveTo ∷ ∀ r. LT.PointerMove → Run (LUNAPARK_ACTIONS r) Unit
 moveTo move = liftAction $ MoveTo move unit
 
-pause ∷ ∀ r. Milliseconds → Run (ActionsEffect r) Unit
+pause ∷ ∀ r. Milliseconds → Run (LUNAPARK_ACTIONS r) Unit
 pause ms = liftAction $ Pause ms unit
 
-tap ∷ ∀ r. Run (ActionsEffect r) Unit
+tap ∷ ∀ r. Run (LUNAPARK_ACTIONS r) Unit
 tap = liftAction $ InTouch $ Tap unit
 
-touchDown ∷ ∀ r. Run (ActionsEffect r) Unit
+touchDown ∷ ∀ r. Run (LUNAPARK_ACTIONS r) Unit
 touchDown = liftAction $ InTouch $ TouchDown unit
 
-touchUp ∷ ∀ r. Run (ActionsEffect r) Unit
+touchUp ∷ ∀ r. Run (LUNAPARK_ACTIONS r) Unit
 touchUp = liftAction $ InTouch $ TouchUp unit
 
-longTap ∷ ∀ r. Run (ActionsEffect r) Unit
+longTap ∷ ∀ r. Run (LUNAPARK_ACTIONS r) Unit
 longTap = liftAction $ InTouch $ LongClick unit
 
-flick ∷ ∀ r. LT.PointerMove → Run (ActionsEffect r) Unit
+flick ∷ ∀ r. LT.PointerMove → Run (LUNAPARK_ACTIONS r) Unit
 flick move = liftAction $ InTouch $ Flick move unit
 
-scroll ∷ ∀ r. LT.PointerMove → Run (ActionsEffect r) Unit
+scroll ∷ ∀ r. LT.PointerMove → Run (LUNAPARK_ACTIONS r) Unit
 scroll move = liftAction $ InTouch $ Scroll move unit
 
-doubleTap ∷ ∀ r. Run (ActionsEffect r) Unit
+doubleTap ∷ ∀ r. Run (LUNAPARK_ACTIONS r) Unit
 doubleTap = liftAction $ InTouch $ DoubleTap unit

src/Lunapark/Endpoint.purs

@@ -184,7 +184,7 @@ handleAPIError (Right r) = case r.status of
   StatusCode 200 → lmap LE.JsonDecodeError do
     obj ← J.decodeJson r.body
     obj J..: "value"
-  code →
+  _ →
     Left $ either LE.JsonDecodeError LE.WebDriverError $ LWE.fromJson r.body
 
 get ∷ String → Endpoint → Aff (Either LE.Error Json)