Allow internal errors on BackendTask

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)
 

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
             )

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
             )
 
 

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)

test-scripts/custom-backend-task.js

@@ -0,0 +1,4 @@
+export async function environmentVariable(input) {
+  input.mutable++;
+  return "Done";
+}

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": {}
+    }
+}

test-scripts/package.json

@@ -0,0 +1,6 @@
+{
+  "license": "BSD-3-Clause",
+  "devDependencies": {
+    "elm-pages": "file:.."
+  }
+}

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

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)