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/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)