Add prototype of function to run Fetcher with a follow-up call to reload route data.

This commit is contained in:
Dillon Kearns 2022-05-06 11:19:24 -07:00
parent da4aaa2714
commit 2192dd30af
5 changed files with 111 additions and 4 deletions

View File

@ -1,6 +1,8 @@
module Effect exposing (Effect(..), batch, fromCmd, map, none, perform)
import Browser.Navigation
import Bytes exposing (Bytes)
import Bytes.Decode
import Http
import Json.Decode as Decode
import Url exposing (Url)
@ -22,6 +24,12 @@ type Effect msg
, method : Maybe String
, toMsg : Result Http.Error Url -> msg
}
| SubmitFetcher
{ decoder : Result Http.Error Bytes -> msg
, fields : List ( String, String )
, headers : List ( String, String )
, url : String
}
type alias RequestInfo =
@ -75,6 +83,14 @@ map fn effect =
, toMsg = fetchInfo.toMsg >> fn
}
SubmitFetcher fetchInfo ->
SubmitFetcher
{ decoder = fetchInfo.decoder >> fn
, fields = fetchInfo.fields
, headers = fetchInfo.headers
, url = fetchInfo.url
}
perform :
{ fetchRouteData :
@ -91,6 +107,13 @@ perform :
, toMsg : Result Http.Error Url -> pageMsg
}
-> Cmd msg
, runFetcher :
{ decoder : Result Http.Error Bytes -> pageMsg
, fields : List ( String, String )
, headers : List ( String, String )
, url : String
}
-> Cmd msg
, fromPageMsg : pageMsg -> msg
, key : Browser.Navigation.Key
}
@ -129,3 +152,6 @@ perform ({ fromPageMsg, key } as helpers) effect =
, encType = Nothing -- TODO
, toMsg = record.toMsg
}
SubmitFetcher record ->
helpers.runFetcher record

View File

@ -54,14 +54,14 @@ init :
-> ( Model, Effect Msg )
init maybePageUrl sharedModel static =
( {}
, Fetcher.Signup.submit
, Fetcher.Signup.something GotResponse
{ headers = []
, formFields =
, fields =
[ ( "first", "Jane" )
, ( "email", "jane@example.com" )
]
}
|> Effect.map GotResponse
|> Effect.SubmitFetcher
)

View File

@ -1271,10 +1271,12 @@ function fetcherModule(name) {
})
.join(", ");
return `module Fetcher.${moduleName} exposing (load, submit)
return `module Fetcher.${moduleName} exposing (load, submit, something)
{-| -}
import Bytes exposing (Bytes)
import Bytes.Decode
import Effect exposing (Effect)
import FormDecoder
import Http
@ -1321,6 +1323,39 @@ submit options =
, timeout = Nothing
}
|> Effect.fromCmd
something :
(Result Http.Error Route.${moduleName}.ActionData -> msg)
->
{ fields : List ( String, String )
, headers : List ( String, String )
}
->
{ decoder : Result Http.Error Bytes -> msg
, fields : List ( String, String )
, headers : List ( String, String )
, url : String
}
something toMsg options =
{ decoder =
\\bytesResult ->
bytesResult
|> Result.andThen
(\\okBytes ->
okBytes
|> Bytes.Decode.decode Route.${moduleName}.w3_decode_ActionData
|> Result.fromMaybe (Http.BadBody "Couldn't decode bytes.")
)
|> toMsg
, fields = options.fields
, headers = options.headers
, url = ${
fetcherPath === ""
? '"/content.dat"'
: `[ ${fetcherPath}, [ "content.dat" ] ] |> List.concat |> String.join "/"`
}
}
`;
}

View File

@ -288,6 +288,7 @@ type Msg userMsg pageData actionData sharedData errorPage
| UrlChanged Url
| UserMsg userMsg
| UpdateCacheAndUrlNew Bool Url (Maybe userMsg) (Result Http.Error ( Url, ResponseSketch pageData actionData sharedData ))
| FetcherComplete (Result Http.Error userMsg)
| PageScrollComplete
| HotReloadCompleteNew Bytes
| ProcessFetchResponse (Result Http.Error ( Url, ResponseSketch pageData actionData sharedData )) (Result Http.Error ( Url, ResponseSketch pageData actionData sharedData ) -> Msg userMsg pageData actionData sharedData errorPage)
@ -427,6 +428,18 @@ update config appMsg model =
)
|> startNewGetLoad url.path (UpdateCacheAndUrlNew False url Nothing)
FetcherComplete userMsgResult ->
case userMsgResult of
Ok userMsg ->
( model, NoEffect )
|> performUserMsg userMsg config
|> startNewGetLoad model.url.path (UpdateCacheAndUrlNew False model.url Nothing)
Err _ ->
-- TODO how to handle error?
( model, NoEffect )
|> startNewGetLoad model.url.path (UpdateCacheAndUrlNew False model.url Nothing)
ProcessFetchResponse response toMsg ->
case response of
Ok ( _, ResponseSketch.Redirect redirectTo ) ->
@ -667,6 +680,32 @@ perform config currentUrl maybeKey effect =
currentUrl
in
fetchRouteData -1 (prepare fetchInfo.toMsg) config urlToSubmitTo (Just (FormDecoder.encodeFormData fetchInfo.values))
, runFetcher =
\options ->
let
{ contentType, body } =
FormDecoder.encodeFormData options.fields
in
-- TODO make sure that `actionData` isn't updated in Model for fetchers
Http.request
{ expect =
Http.expectBytesResponse FetcherComplete
(\bytes ->
case bytes of
Http.GoodStatus_ metadata bytesBody ->
options.decoder (Ok bytesBody)
|> Ok
_ ->
Debug.todo ""
)
, tracker = Nothing
, body = Http.stringBody contentType body
, headers = options.headers |> List.map (\( name, value ) -> Http.header name value)
, url = options.url
, method = "POST"
, timeout = Nothing
}
, fromPageMsg = UserMsg
, key = key
}

View File

@ -106,6 +106,13 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData
}
-> Cmd mappedMsg
, fromPageMsg : userMsg -> mappedMsg
, runFetcher :
{ decoder : Result Http.Error Bytes -> userMsg
, fields : List ( String, String )
, headers : List ( String, String )
, url : String
}
-> Cmd mappedMsg
, key : Browser.Navigation.Key
}
-> effect