From fc19db79250a5afbd91b35d0a727d7b4c96f262b Mon Sep 17 00:00:00 2001 From: Leonardo Taglialegne Date: Mon, 13 May 2024 13:14:51 +0200 Subject: [PATCH 1/2] Allow internal errors on BackendTask --- src/BackendTask.elm | 27 +++++++++++++++++++++ src/BackendTask/Internal/Request.elm | 9 ++++--- src/Pages/StaticHttpRequest.elm | 35 ++++++++++++++++++++++++---- 3 files changed, 61 insertions(+), 10 deletions(-) diff --git a/src/BackendTask.elm b/src/BackendTask.elm index 67bb9821d..de182431f 100644 --- a/src/BackendTask.elm +++ b/src/BackendTask.elm @@ -143,6 +143,9 @@ but mapping allows you to change the resulting values by applying functions to t map : (a -> b) -> BackendTask error a -> BackendTask error b map fn requestInfo = case requestInfo of + InternalError err -> + InternalError err + ApiRoute value -> ApiRoute (Result.map fn value) @@ -221,6 +224,9 @@ inDir dir backendTask = -- elm-review: known-unoptimized-recursion -- TODO try to find a way to optimize tail-call recursion here case backendTask of + InternalError _ -> + backendTask + ApiRoute _ -> backendTask @@ -243,6 +249,9 @@ quiet backendTask = -- elm-review: known-unoptimized-recursion -- TODO try to find a way to optimize tail-call recursion here case backendTask of + InternalError _ -> + backendTask + ApiRoute _ -> backendTask @@ -260,6 +269,9 @@ withEnv key value backendTask = -- elm-review: known-unoptimized-recursion -- TODO try to find a way to optimize tail-call recursion here case backendTask of + InternalError _ -> + backendTask + ApiRoute _ -> backendTask @@ -422,6 +434,12 @@ map2 fn request1 request2 = -- elm-review: known-unoptimized-recursion -- TODO try to find a way to optimize tail-call recursion here case ( request1, request2 ) of + ( InternalError err1, _ ) -> + InternalError err1 + + ( _, InternalError err2 ) -> + InternalError err2 + ( ApiRoute value1, ApiRoute value2 ) -> ApiRoute (Result.map2 fn value1 value2) @@ -478,6 +496,9 @@ andThen fn requestInfo = -- elm-review: known-unoptimized-recursion -- TODO try to find a way to optimize recursion here case requestInfo of + InternalError errA -> + InternalError errA + ApiRoute a -> case a of Ok okA -> @@ -503,6 +524,9 @@ onError : (error -> BackendTask mappedError value) -> BackendTask error value -> onError fromError backendTask = -- elm-review: known-unoptimized-recursion case backendTask of + InternalError err -> + InternalError err + ApiRoute a -> case a of Ok okA -> @@ -569,6 +593,9 @@ fromResult result = mapError : (error -> errorMapped) -> BackendTask error value -> BackendTask errorMapped value mapError mapFn requestInfo = case requestInfo of + InternalError internal -> + InternalError internal + ApiRoute value -> ApiRoute (Result.mapError mapFn value) diff --git a/src/BackendTask/Internal/Request.elm b/src/BackendTask/Internal/Request.elm index 0675c3b87..a7a5e6bbc 100644 --- a/src/BackendTask/Internal/Request.elm +++ b/src/BackendTask/Internal/Request.elm @@ -4,6 +4,7 @@ import BackendTask exposing (BackendTask) import BackendTask.Http exposing (Body, Expect) import Json.Decode exposing (Decoder) import Json.Encode as Encode +import Pages.StaticHttpRequest request : @@ -12,8 +13,7 @@ request : , expect : Expect a } -> BackendTask error a -request ({ name, body, expect } as params) = - -- elm-review: known-unoptimized-recursion +request { name, body, expect } = BackendTask.Http.request { url = "elm-pages-internal://" ++ name , method = "GET" @@ -24,9 +24,8 @@ request ({ name, body, expect } as params) = } expect |> BackendTask.onError - (\_ -> - -- TODO avoid crash here, this should be handled as an internal error - request params + (\err -> + Pages.StaticHttpRequest.InternalError err.fatal ) diff --git a/src/Pages/StaticHttpRequest.elm b/src/Pages/StaticHttpRequest.elm index 7f6a9625b..ea2f84000 100644 --- a/src/Pages/StaticHttpRequest.elm +++ b/src/Pages/StaticHttpRequest.elm @@ -1,7 +1,9 @@ module Pages.StaticHttpRequest exposing (Error(..), MockResolver, RawRequest(..), Status(..), cacheRequestResolution, mockResolve, toBuildError) import BuildError exposing (BuildError) +import FatalError exposing (FatalError) import Json.Encode +import Pages.Internal.FatalError import Pages.StaticHttp.Request import RequestsAndPending exposing (RequestsAndPending) import TerminalText as Terminal @@ -15,11 +17,13 @@ type alias MockResolver = type RawRequest error value = Request (List Pages.StaticHttp.Request.Request) (Maybe MockResolver -> RequestsAndPending -> RawRequest error value) | ApiRoute (Result error value) + | InternalError FatalError type Error = DecoderError String | UserCalledStaticHttpFail String + | InternalFailure FatalError toBuildError : String -> Error -> BuildError @@ -43,18 +47,36 @@ toBuildError path error = , fatal = True } + InternalFailure (Pages.Internal.FatalError.FatalError buildError) -> + { title = "Internal error" + , message = + [ Terminal.text <| "Please report this error!" + , Terminal.text "" + , Terminal.text "" + , Terminal.text buildError.body + ] + , path = path + , fatal = True + } + -mockResolve : RawRequest error value -> MockResolver -> Result error value -mockResolve request mockResolver = +mockResolve : (FatalError -> error) -> RawRequest error value -> MockResolver -> Result error value +mockResolve onInternalError request mockResolver = case request of Request _ lookupFn -> - case lookupFn (Just mockResolver) (Json.Encode.object []) of - nextRequest -> - mockResolve nextRequest mockResolver + let + nextRequest : RawRequest error value + nextRequest = + lookupFn (Just mockResolver) (Json.Encode.object []) + in + mockResolve onInternalError nextRequest mockResolver ApiRoute value -> value + InternalError err -> + Err (onInternalError err) + cacheRequestResolution : RawRequest error value @@ -72,6 +94,9 @@ cacheRequestResolution request rawResponses = ApiRoute value -> Complete value + InternalError err -> + HasPermanentError (InternalFailure err) + type Status error value = Incomplete (List Pages.StaticHttp.Request.Request) (RawRequest error value) From be3c1faf51d1b40f58ef0a54dcdc94644a95204f Mon Sep 17 00:00:00 2001 From: Leonardo Taglialegne Date: Fri, 27 Sep 2024 16:50:58 +0200 Subject: [PATCH 2/2] Add test for internal errors --- src/BackendTask/Custom.elm | 9 +--- test-scripts/custom-backend-task.js | 4 ++ test-scripts/elm.json | 58 ++++++++++++++++++++++++ test-scripts/package-lock.json | 70 +++++++++++++++++++++++++++++ test-scripts/package.json | 6 +++ test-scripts/src/Main.elm | 18 ++++++++ test.sh | 1 + 7 files changed, 159 insertions(+), 7 deletions(-) create mode 100644 test-scripts/custom-backend-task.js create mode 100644 test-scripts/elm.json create mode 100644 test-scripts/package-lock.json create mode 100644 test-scripts/package.json create mode 100644 test-scripts/src/Main.elm diff --git a/src/BackendTask/Custom.elm b/src/BackendTask/Custom.elm index 35ffd8747..b0699dc01 100644 --- a/src/BackendTask/Custom.elm +++ b/src/BackendTask/Custom.elm @@ -126,6 +126,7 @@ import Date import FatalError exposing (FatalError) import Json.Decode as Decode exposing (Decoder) import Json.Encode as Encode +import Pages.StaticHttpRequest import TerminalText import Time @@ -331,7 +332,6 @@ request : } -> BackendTask { fatal : FatalError, recoverable : Error } a request { body, expect } = - -- elm-review: known-unoptimized-recursion BackendTask.Http.request { url = "elm-pages-internal://port" , method = "GET" @@ -343,8 +343,6 @@ request { body, expect } = expect |> BackendTask.onError (\error -> - -- TODO avoid crash here, this should be handled as an internal error - --request params case error.recoverable of BackendTask.Http.BadBody (Just jsonError) _ -> { recoverable = DecodeError jsonError @@ -353,8 +351,5 @@ request { body, expect } = |> BackendTask.fail _ -> - { recoverable = Error - , fatal = error.fatal - } - |> BackendTask.fail + Pages.StaticHttpRequest.InternalError error.fatal ) diff --git a/test-scripts/custom-backend-task.js b/test-scripts/custom-backend-task.js new file mode 100644 index 000000000..04d56c5d4 --- /dev/null +++ b/test-scripts/custom-backend-task.js @@ -0,0 +1,4 @@ +export async function environmentVariable(input) { + input.mutable++; + return "Done"; +} diff --git a/test-scripts/elm.json b/test-scripts/elm.json new file mode 100644 index 000000000..52e9f039a --- /dev/null +++ b/test-scripts/elm.json @@ -0,0 +1,58 @@ +{ + "type": "application", + "source-directories": [ + "src", + "../src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "avh4/elm-color": "1.0.0", + "danfishgold/base64-bytes": "1.1.0", + "danyx23/elm-mimetype": "4.0.1", + "dillonkearns/elm-bcp47-language-tag": "2.0.0", + "dillonkearns/elm-cli-options-parser": "3.2.0", + "dillonkearns/elm-date-or-date-time": "2.0.0", + "dillonkearns/elm-form": "3.0.0", + "elm/browser": "1.0.2", + "elm/bytes": "1.0.8", + "elm/core": "1.0.5", + "elm/html": "1.0.0", + "elm/http": "2.0.0", + "elm/json": "1.1.3", + "elm/parser": "1.1.0", + "elm/random": "1.0.0", + "elm/regex": "1.0.0", + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.3", + "elm-community/list-extra": "8.6.0", + "jluckyiv/elm-utc-date-strings": "1.0.0", + "justinmimbs/date": "4.0.1", + "mdgriffith/elm-codegen": "5.0.0", + "miniBill/elm-codec": "2.0.0", + "noahzgordon/elm-color-extra": "1.0.2", + "robinheghan/fnv1a": "1.0.0", + "rtfeldman/elm-css": "18.0.0", + "the-sett/elm-syntax-dsl": "6.0.2", + "vito/elm-ansi": "10.0.1" + }, + "indirect": { + "Chadtech/elm-bool-extra": "2.4.2", + "elm/file": "1.0.5", + "elm-community/basics-extra": "4.1.0", + "elm-community/maybe-extra": "5.3.0", + "fredcy/elm-parseint": "2.0.1", + "robinheghan/murmur3": "1.0.0", + "rtfeldman/elm-hex": "1.0.0", + "rtfeldman/elm-iso8601-date-strings": "1.1.4", + "stil4m/elm-syntax": "7.3.6", + "stil4m/structured-writer": "1.0.3", + "the-sett/elm-pretty-printer": "3.1.0" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} diff --git a/test-scripts/package-lock.json b/test-scripts/package-lock.json new file mode 100644 index 000000000..40fe90597 --- /dev/null +++ b/test-scripts/package-lock.json @@ -0,0 +1,70 @@ +{ + "name": "test-scripts", + "lockfileVersion": 3, + "requires": true, + "packages": { + "": { + "license": "BSD-3-Clause", + "devDependencies": { + "elm-pages": "file:.." + } + }, + "..": { + "version": "3.0.16", + "dev": true, + "license": "BSD-3-Clause", + "dependencies": { + "@sindresorhus/merge-streams": "^3.0.0", + "busboy": "^1.6.0", + "chokidar": "^3.5.3", + "cli-cursor": "^4.0.0", + "commander": "^11.1.0", + "connect": "^3.7.0", + "cookie-signature": "^1.2.1", + "cross-spawn": "7.0.3", + "devcert": "^1.2.2", + "elm-doc-preview": "^5.0.5", + "elm-hot": "^1.1.6", + "esbuild": "^0.19.11", + "fs-extra": "^11.2.0", + "globby": "14.0.0", + "gray-matter": "^4.0.3", + "jsesc": "^3.0.2", + "kleur": "^4.1.5", + "make-fetch-happen": "^13.0.0", + "memfs": "^4.6.0", + "micromatch": "^4.0.5", + "serve-static": "^1.15.0", + "terser": "^5.26.0", + "vite": "^5.0.11", + "which": "^4.0.0" + }, + "bin": { + "elm-pages": "generator/src/cli.js" + }, + "devDependencies": { + "@types/cross-spawn": "^6.0.6", + "@types/fs-extra": "^11.0.4", + "@types/make-fetch-happen": "^10.0.4", + "@types/micromatch": "^4.0.6", + "@types/node": "^20.10.7", + "@types/serve-static": "^1.15.5", + "cypress": "^13.6.2", + "elm-codegen": "^0.6.0", + "elm-optimize-level-2": "^0.3.5", + "elm-review": "^2.12.0", + "elm-test": "^0.19.1-revision12", + "elm-tooling": "^1.15.0", + "elm-verify-examples": "^5.3.0", + "lamdera": "^0.19.1-1.2.1-1", + "typescript": "^5.3.3", + "vite": "^5.0.11", + "vitest": "^1.1.3" + } + }, + "node_modules/elm-pages": { + "resolved": "..", + "link": true + } + } +} diff --git a/test-scripts/package.json b/test-scripts/package.json new file mode 100644 index 000000000..cea8c01c2 --- /dev/null +++ b/test-scripts/package.json @@ -0,0 +1,6 @@ +{ + "license": "BSD-3-Clause", + "devDependencies": { + "elm-pages": "file:.." + } +} diff --git a/test-scripts/src/Main.elm b/test-scripts/src/Main.elm new file mode 100644 index 000000000..b055e0d59 --- /dev/null +++ b/test-scripts/src/Main.elm @@ -0,0 +1,18 @@ +module Main exposing (run) + +import BackendTask exposing (BackendTask) +import BackendTask.Custom +import FatalError exposing (FatalError) +import Json.Decode +import Json.Encode +import Pages.Script as Script exposing (Script) + + +run : Script +run = + BackendTask.Custom.run "environmentVariable" + (Json.Encode.object [ ( "mutable", Json.Encode.int 0 ) ]) + Json.Decode.string + |> BackendTask.allowFatal + |> BackendTask.andThen Script.log + |> Script.withoutCliOptions diff --git a/test.sh b/test.sh index 24509d050..c6e21fd3d 100755 --- a/test.sh +++ b/test.sh @@ -8,3 +8,4 @@ npx elm-test-rs --compiler lamdera npm run test:snapshot elm-verify-examples --run-tests --elm-test-args '--compiler=lamdera' (cd generator && vitest run) +(cd test-scripts && npm i && npx elm-pages run src/Main.elm) \ No newline at end of file