From cc1f011511f9d260fd8562eba096c15846b2081d Mon Sep 17 00:00:00 2001 From: Leonardo Taglialegne Date: Mon, 13 May 2024 13:14:51 +0200 Subject: [PATCH] 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)