From 0de0edd8e96f1ce875d3a8aa21d69a12653f4fcc Mon Sep 17 00:00:00 2001 From: Gary Burgess Date: Mon, 14 Jun 2021 14:28:45 +0100 Subject: [PATCH] Update for GH actions, PS 0.14 --- .github/workflows/ci.yml | 31 ++++++++++ .gitignore | 3 +- .travis.yml | 15 ----- README.md | 2 +- bower.json | 12 ++-- package.json | 10 +--- packages.dhall | 4 -- spago.dhall | 15 ----- src/Lunapark.purs | 6 +- src/Lunapark/API.purs | 46 +++++++-------- src/Lunapark/ActionF.purs | 34 ++++++----- src/Lunapark/Endpoint.purs | 2 +- src/Lunapark/LunaparkF.purs | 111 ++++++++++++++++++------------------ src/Lunapark/Utils.purs | 11 ++-- 14 files changed, 144 insertions(+), 158 deletions(-) create mode 100644 .github/workflows/ci.yml delete mode 100644 .travis.yml delete mode 100644 packages.dhall delete mode 100644 spago.dhall diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 0000000..9cb89fa --- /dev/null +++ b/.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 diff --git a/.gitignore b/.gitignore index 672ae4e..c14403d 100644 --- a/.gitignore +++ b/.gitignore @@ -1,8 +1,7 @@ /.* !/.gitignore -!/.travis.yml +!/.github /bower_components/ /node_modules/ /output/ -/example/dist/test.js package-lock.json diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index d9628ca..0000000 --- a/.travis.yml +++ /dev/null @@ -1,15 +0,0 @@ -language: node_js -dist: trusty -sudo: required -node_js: stable -install: - - npm install - - npm install -g spago - - spago install -script: - - npm run -s build -after_success: -- >- - test $TRAVIS_TAG && - echo $GITHUB_TOKEN | pulp login && - echo y | pulp publish --no-push diff --git a/README.md b/README.md index 399f9ed..8e7f789 100644 --- a/README.md +++ b/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 diff --git a/bower.json b/bower.json index 10e85c8..067095b 100644 --- a/bower.json +++ b/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" } } diff --git a/package.json b/package.json index e1cfefa..2b25350 100644 --- a/package.json +++ b/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" } } diff --git a/packages.dhall b/packages.dhall deleted file mode 100644 index c9d57c7..0000000 --- a/packages.dhall +++ /dev/null @@ -1,4 +0,0 @@ -let upstream = - https://github.com/purescript/package-sets/releases/download/psc-0.13.8-20201021/packages.dhall sha256:55ebdbda1bd6ede4d5307fbc1ef19988c80271b4225d833c8d6fb9b6fb1aa6d8 - -in upstream diff --git a/spago.dhall b/spago.dhall deleted file mode 100644 index 3b70427..0000000 --- a/spago.dhall +++ /dev/null @@ -1,15 +0,0 @@ -{ name = "lunapark" -, dependencies = - [ "argonaut-core" - , "argonaut-codecs" - , "affjax" - , "console" - , "css" - , "effect" - , "node-fs-aff" - , "psci-support" - , "run" - ] -, packages = ./packages.dhall -, sources = [ "src/**/*.purs" ] -} diff --git a/src/Lunapark.purs b/src/Lunapark.purs index 4b2d3e4..1350740 100644 --- a/src/Lunapark.purs +++ b/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) diff --git a/src/Lunapark/API.purs b/src/Lunapark/API.purs index 1826909..825470f 100644 --- a/src/Lunapark/API.purs +++ b/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,24 +93,20 @@ 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) @@ -118,8 +114,8 @@ runLunaparkActions input 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 diff --git a/src/Lunapark/ActionF.purs b/src/Lunapark/ActionF.purs index a85319a..42d2605 100644 --- a/src/Lunapark/ActionF.purs +++ b/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 diff --git a/src/Lunapark/Endpoint.purs b/src/Lunapark/Endpoint.purs index 91eb6bb..a63192f 100644 --- a/src/Lunapark/Endpoint.purs +++ b/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) diff --git a/src/Lunapark/LunaparkF.purs b/src/Lunapark/LunaparkF.purs index a9cabb4..82fe4eb 100644 --- a/src/Lunapark/LunaparkF.purs +++ b/src/Lunapark/LunaparkF.purs @@ -71,167 +71,166 @@ derive instance functorLunaparkF ∷ Functor LunaparkF derive instance functorElementF ∷ Functor ElementF _lunapark = SProxy ∷ SProxy "lunapark" -type LUNAPARK = R.FProxy LunaparkF -type LunaparkEffect r = ( lunapark ∷ LUNAPARK | r ) +type LUNAPARK r = ( lunapark ∷ LunaparkF | r ) -liftLunapark ∷ ∀ a r. LunaparkF a → Run (LunaparkEffect r) a +liftLunapark ∷ ∀ a r. LunaparkF a → Run (LUNAPARK r) a liftLunapark = R.lift _lunapark -quit ∷ ∀ r. Run (LunaparkEffect r) Unit +quit ∷ ∀ r. Run (LUNAPARK r) Unit quit = liftLunapark $ Quit unit -status ∷ ∀ r. Run (LunaparkEffect r) LT.ServerStatus +status ∷ ∀ r. Run (LUNAPARK r) LT.ServerStatus status = liftLunapark $ Status identity -setTimeouts ∷ ∀ r. LT.Timeouts → Run (LunaparkEffect r) Unit +setTimeouts ∷ ∀ r. LT.Timeouts → Run (LUNAPARK r) Unit setTimeouts ts = liftLunapark $ SetTimeouts ts unit -getTimeouts ∷ ∀ r. Run (LunaparkEffect r) LT.Timeouts +getTimeouts ∷ ∀ r. Run (LUNAPARK r) LT.Timeouts getTimeouts = liftLunapark $ GetTimeouts identity -go ∷ ∀ r. String → Run (LunaparkEffect r) Unit +go ∷ ∀ r. String → Run (LUNAPARK r) Unit go uri = liftLunapark $ GoTo uri unit -getUrl ∷ ∀ r. Run (LunaparkEffect r) String +getUrl ∷ ∀ r. Run (LUNAPARK r) String getUrl = liftLunapark $ GetUrl identity -forward ∷ ∀ r. Run (LunaparkEffect r) Unit +forward ∷ ∀ r. Run (LUNAPARK r) Unit forward = liftLunapark $ Forward unit -back ∷ ∀ r. Run (LunaparkEffect r) Unit +back ∷ ∀ r. Run (LUNAPARK r) Unit back = liftLunapark $ Back unit -refresh ∷ ∀ r. Run (LunaparkEffect r) Unit +refresh ∷ ∀ r. Run (LUNAPARK r) Unit refresh = liftLunapark $ Refresh unit -getTitle ∷ ∀ r. Run (LunaparkEffect r) String +getTitle ∷ ∀ r. Run (LUNAPARK r) String getTitle = liftLunapark $ GetTitle identity -getWindowHandle ∷ ∀ r. Run (LunaparkEffect r) LT.WindowHandle +getWindowHandle ∷ ∀ r. Run (LUNAPARK r) LT.WindowHandle getWindowHandle = liftLunapark $ GetWindowHandle identity -getWindowHandles ∷ ∀ r. Run (LunaparkEffect r) (Array LT.WindowHandle) +getWindowHandles ∷ ∀ r. Run (LUNAPARK r) (Array LT.WindowHandle) getWindowHandles = liftLunapark $ GetWindowHandles identity -closeWindow ∷ ∀ r. Run (LunaparkEffect r) Unit +closeWindow ∷ ∀ r. Run (LUNAPARK r) Unit closeWindow = liftLunapark $ CloseWindow unit -switchToWindow ∷ ∀ r. LT.WindowHandle → Run (LunaparkEffect r) Unit +switchToWindow ∷ ∀ r. LT.WindowHandle → Run (LUNAPARK r) Unit switchToWindow w = liftLunapark $ SwitchToWindow w unit -switchToFrame ∷ ∀ r. LT.FrameId → Run (LunaparkEffect r) Unit +switchToFrame ∷ ∀ r. LT.FrameId → Run (LUNAPARK r) Unit switchToFrame f = liftLunapark $ SwitchToFrame f unit -switchToParentFrame ∷ ∀ r. Run (LunaparkEffect r) Unit +switchToParentFrame ∷ ∀ r. Run (LUNAPARK r) Unit switchToParentFrame = liftLunapark $ SwitchToParentFrame unit -getWindowRectangle ∷ ∀ r. Run (LunaparkEffect r) LT.Rectangle +getWindowRectangle ∷ ∀ r. Run (LUNAPARK r) LT.Rectangle getWindowRectangle = liftLunapark $ GetWindowRectangle identity -setWindowRectangle ∷ ∀ r. LT.Rectangle → Run (LunaparkEffect r) Unit +setWindowRectangle ∷ ∀ r. LT.Rectangle → Run (LUNAPARK r) Unit setWindowRectangle r = liftLunapark $ SetWindowRectangle r unit -maximizeWindow ∷ ∀ r. Run (LunaparkEffect r) Unit +maximizeWindow ∷ ∀ r. Run (LUNAPARK r) Unit maximizeWindow = liftLunapark $ MaximizeWindow unit -minimizeWindow ∷ ∀ r. Run (LunaparkEffect r) Unit +minimizeWindow ∷ ∀ r. Run (LUNAPARK r) Unit minimizeWindow = liftLunapark $ MinimizeWindow unit -fullscreenWindow ∷ ∀ r. Run (LunaparkEffect r) Unit +fullscreenWindow ∷ ∀ r. Run (LUNAPARK r) Unit fullscreenWindow = liftLunapark $ FullscreenWindow unit -executeScript ∷ ∀ r. LT.Script → Run (LunaparkEffect r) J.Json +executeScript ∷ ∀ r. LT.Script → Run (LUNAPARK r) J.Json executeScript script = liftLunapark $ ExecuteScript script identity -executeScriptAsync ∷ ∀ r. LT.Script → Run (LunaparkEffect r) J.Json +executeScriptAsync ∷ ∀ r. LT.Script → Run (LUNAPARK r) J.Json executeScriptAsync script = liftLunapark $ ExecuteScriptAsync script identity -getAllCookies ∷ ∀ r. Run (LunaparkEffect r) (Array LT.Cookie) +getAllCookies ∷ ∀ r. Run (LUNAPARK r) (Array LT.Cookie) getAllCookies = liftLunapark $ GetAllCookies identity -getCookie ∷ ∀ r. String → Run (LunaparkEffect r) LT.Cookie +getCookie ∷ ∀ r. String → Run (LUNAPARK r) LT.Cookie getCookie name = liftLunapark $ GetCookie name identity -addCookie ∷ ∀ r. LT.Cookie → Run (LunaparkEffect r) Unit +addCookie ∷ ∀ r. LT.Cookie → Run (LUNAPARK r) Unit addCookie cookie = liftLunapark $ AddCookie cookie unit -deleteCookie ∷ ∀ r. String → Run (LunaparkEffect r) Unit +deleteCookie ∷ ∀ r. String → Run (LUNAPARK r) Unit deleteCookie name = liftLunapark $ DeleteCookie name unit -deleteAllCookies ∷ ∀ r. Run (LunaparkEffect r) Unit +deleteAllCookies ∷ ∀ r. Run (LUNAPARK r) Unit deleteAllCookies = liftLunapark $ DeleteAllCookies unit -dismissAlert ∷ ∀ r. Run (LunaparkEffect r) Unit +dismissAlert ∷ ∀ r. Run (LUNAPARK r) Unit dismissAlert = liftLunapark $ DismissAlert unit -acceptAlert ∷ ∀ r. Run (LunaparkEffect r) Unit +acceptAlert ∷ ∀ r. Run (LUNAPARK r) Unit acceptAlert = liftLunapark $ AcceptAlert unit -getAlertText ∷ ∀ r. Run (LunaparkEffect r) String +getAlertText ∷ ∀ r. Run (LUNAPARK r) String getAlertText = liftLunapark $ GetAlertText identity -sendAlertText ∷ ∀ r. String → Run (LunaparkEffect r) Unit +sendAlertText ∷ ∀ r. String → Run (LUNAPARK r) Unit sendAlertText txt = liftLunapark $ SendAlertText txt unit -screenshot ∷ ∀ r. String → Run (LunaparkEffect r) Unit +screenshot ∷ ∀ r. String → Run (LUNAPARK r) Unit screenshot fp = liftLunapark $ Screenshot fp unit -elementScreenshot ∷ ∀ r. LT.Element → String → Run (LunaparkEffect r) Unit +elementScreenshot ∷ ∀ r. LT.Element → String → Run (LUNAPARK r) Unit elementScreenshot el fp = liftLunapark $ OnElement el $ ScreenshotEl fp unit -findElement ∷ ∀ r. LT.Locator → Run (LunaparkEffect r) LT.Element +findElement ∷ ∀ r. LT.Locator → Run (LUNAPARK r) LT.Element findElement l = liftLunapark $ FindElement l identity -findElements ∷ ∀ r. LT.Locator → Run (LunaparkEffect r) (Array LT.Element) +findElements ∷ ∀ r. LT.Locator → Run (LUNAPARK r) (Array LT.Element) findElements l = liftLunapark $ FindElements l identity -childElement ∷ ∀ r. LT.Element → LT.Locator → Run (LunaparkEffect r) LT.Element +childElement ∷ ∀ r. LT.Element → LT.Locator → Run (LUNAPARK r) LT.Element childElement el l = liftLunapark $ OnElement el $ ChildElement l identity -childElements ∷ ∀ r. LT.Element → LT.Locator → Run (LunaparkEffect r) (Array LT.Element) +childElements ∷ ∀ r. LT.Element → LT.Locator → Run (LUNAPARK r) (Array LT.Element) childElements el l = liftLunapark $ OnElement el $ ChildElements l identity -isSelected ∷ ∀ r. LT.Element → Run (LunaparkEffect r) Boolean +isSelected ∷ ∀ r. LT.Element → Run (LUNAPARK r) Boolean isSelected el = liftLunapark $ OnElement el $ IsSelected identity -getAttribute ∷ ∀ r. LT.Element → String → Run (LunaparkEffect r) String +getAttribute ∷ ∀ r. LT.Element → String → Run (LUNAPARK r) String getAttribute el name = liftLunapark $ OnElement el $ GetAttribute name identity -getProperty ∷ ∀ r. LT.Element → String → Run (LunaparkEffect r) J.Json +getProperty ∷ ∀ r. LT.Element → String → Run (LUNAPARK r) J.Json getProperty el name = liftLunapark $ OnElement el $ GetProperty name identity -getCss ∷ ∀ r. LT.Element → String → Run (LunaparkEffect r) String +getCss ∷ ∀ r. LT.Element → String → Run (LUNAPARK r) String getCss el name = liftLunapark $ OnElement el $ GetCss name identity -getText ∷ ∀ r. LT.Element → Run (LunaparkEffect r) String +getText ∷ ∀ r. LT.Element → Run (LUNAPARK r) String getText el = liftLunapark $ OnElement el $ GetText identity -getTagName ∷ ∀ r. LT.Element → Run (LunaparkEffect r) String +getTagName ∷ ∀ r. LT.Element → Run (LUNAPARK r) String getTagName el = liftLunapark $ OnElement el $ GetTagName identity -getRectangle ∷ ∀ r. LT.Element → Run (LunaparkEffect r) LT.Rectangle +getRectangle ∷ ∀ r. LT.Element → Run (LUNAPARK r) LT.Rectangle getRectangle el = liftLunapark $ OnElement el $ GetRectangle identity -isEnabled ∷ ∀ r. LT.Element → Run (LunaparkEffect r) Boolean +isEnabled ∷ ∀ r. LT.Element → Run (LUNAPARK r) Boolean isEnabled el = liftLunapark $ OnElement el $ IsEnabled identity -clickElement ∷ ∀ r. LT.Element → Run (LunaparkEffect r) Unit +clickElement ∷ ∀ r. LT.Element → Run (LUNAPARK r) Unit clickElement el = liftLunapark $ OnElement el $ ClickEl unit -clearElement ∷ ∀ r. LT.Element → Run (LunaparkEffect r) Unit +clearElement ∷ ∀ r. LT.Element → Run (LUNAPARK r) Unit clearElement el = liftLunapark $ OnElement el $ ClearEl unit -sendKeysElement ∷ ∀ r. LT.Element → String → Run (LunaparkEffect r) Unit +sendKeysElement ∷ ∀ r. LT.Element → String → Run (LUNAPARK r) Unit sendKeysElement el txt = liftLunapark $ OnElement el $ SendKeysEl txt unit -isDisplayed ∷ ∀ r. LT.Element → Run (LunaparkEffect r) Boolean +isDisplayed ∷ ∀ r. LT.Element → Run (LUNAPARK r) Boolean isDisplayed el = liftLunapark $ OnElement el $ IsDisplayed identity -submitElement ∷ ∀ r. LT.Element → Run (LunaparkEffect r) Unit +submitElement ∷ ∀ r. LT.Element → Run (LUNAPARK r) Unit submitElement el = liftLunapark $ OnElement el $ Submit unit -performActions ∷ ∀ r. LT.ActionRequest → Run (LunaparkEffect r) Unit +performActions ∷ ∀ r. LT.ActionRequest → Run (LUNAPARK r) Unit performActions req = liftLunapark $ PerformActions req unit -releaseActions ∷ ∀ r. Run (LunaparkEffect r) Unit +releaseActions ∷ ∀ r. Run (LUNAPARK r) Unit releaseActions = liftLunapark $ ReleaseActions unit diff --git a/src/Lunapark/Utils.purs b/src/Lunapark/Utils.purs index 0561a9d..f19ff56 100644 --- a/src/Lunapark/Utils.purs +++ b/src/Lunapark/Utils.purs @@ -9,12 +9,13 @@ import Effect.Aff (Aff) import Lunapark.Error as LE import Run as R import Run.Except as RE +import Type.Row (type (+)) import Unsafe.Coerce (unsafeCoerce) liftAndRethrow ∷ ∀ r ε ω . Aff (Either ε ω) - → R.Run (aff ∷ R.AFF, except ∷ RE.EXCEPT ε|r) ω + → R.Run (R.AFF + RE.EXCEPT ε + r) ω liftAndRethrow a = do res ← R.liftAff a RE.rethrow res @@ -22,14 +23,14 @@ liftAndRethrow a = do rethrowAsJsonDecodeError ∷ ∀ r . Either J.JsonDecodeError - ~> R.Run (except ∷ RE.EXCEPT LE.Error|r) + ~> R.Run (RE.EXCEPT LE.Error + r) rethrowAsJsonDecodeError = RE.rethrow <<< lmap LE.JsonDecodeError -- Safe, since we actually want handler and result have same rows not, remove except catch ∷ ∀ e r a - . R.Run (except ∷ RE.EXCEPT e|r) a - → (e → R.Run (except ∷ RE.EXCEPT e|r) a) - → R.Run (except ∷ RE.EXCEPT e|r) a + . R.Run (RE.EXCEPT e + r) a + → (e → R.Run (RE.EXCEPT e + r) a) + → R.Run (RE.EXCEPT e + r) a catch = unsafeCoerce $ flip RE.catch