dillonkearns/elm-pages-v3-beta
1
1
Fork 0
mirror of https://github.com/dillonkearns/elm-pages-v3-beta.git synced 2024-11-28 06:05:31 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'actions' into serverless-latest

Browse Source 
# Conflicts:
#	examples/docs/app/Effect.elm
#	examples/hackernews/app/Effect.elm
This commit is contained in:
Dillon Kearns 2022-05-11 16:06:25 -07:00
commit 3fb3805aca
47 changed files with 1580 additions and 631 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
docs.json
View File

File diff suppressed because one or more lines are too long

1
elm.json
View File

@ -25,6 +25,7 @@
"Pages.Manifest",
"Pages.Manifest.Category",
"Pages.Flags",
"Pages.Fetcher",
"Form",
"Form.Value"
],

15
examples/docs/app/Effect.elm
View File

@ -1,8 +1,11 @@
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 Pages.Fetcher
import Url exposing (Url)
@ -22,6 +25,7 @@ type Effect msg
, method : Maybe String
, toMsg : Result Http.Error Url -> msg
}
| SubmitFetcher (Pages.Fetcher.Fetcher msg)
type alias RequestInfo =
@ -75,6 +79,11 @@ map fn effect =
, toMsg = fetchInfo.toMsg >> fn
}
SubmitFetcher fetcher ->
fetcher
|> Pages.Fetcher.map fn
|> SubmitFetcher
perform :
{ fetchRouteData :
@ -91,6 +100,9 @@ perform :
, toMsg : Result Http.Error Url -> pageMsg
}
-> Cmd msg
, runFetcher :
Pages.Fetcher.Fetcher pageMsg
-> Cmd msg
, fromPageMsg : pageMsg -> msg
, key : Browser.Navigation.Key
}
@ -129,3 +141,6 @@ perform ({ fromPageMsg, key } as helpers) effect =
, encType = Nothing -- TODO
, toMsg = record.toMsg
}
SubmitFetcher record ->
helpers.runFetcher record

12
examples/docs/app/Route/Blog.elm
View File

@ -1,4 +1,4 @@
module Route.Blog exposing (Data, Model, Msg, route)
module Route.Blog exposing (ActionData, Data, Model, Msg, route)
import Article
import DataSource
@ -22,7 +22,7 @@ type alias Msg =
()
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.single
{ head = head
@ -42,6 +42,10 @@ type alias Data =
List ( Route, Article.ArticleMetadata )
type alias ActionData =
{}
type alias RouteParams =
{}
@ -53,7 +57,7 @@ type alias Model =
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data {}
-> StaticPayload Data ActionData {}
-> View msg
view maybeUrl sharedModel staticPayload =
{ title = "elm-pages blog"
@ -155,7 +159,7 @@ view maybeUrl sharedModel staticPayload =
}
head : StaticPayload Data {} -> List Head.Tag
head : StaticPayload Data ActionData {} -> List Head.Tag
head staticPayload =
Seo.summary
{ canonicalUrlOverride = Nothing

12
examples/docs/app/Route/Blog/Slug_.elm
View File

@ -1,4 +1,4 @@
module Route.Blog.Slug_ exposing (Data, Model, Msg, route)
module Route.Blog.Slug_ exposing (ActionData, Data, Model, Msg, route)
import Article
import Cloudinary
@ -39,7 +39,7 @@ type alias RouteParams =
{ slug : String }
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.preRender
{ data = data
@ -63,7 +63,7 @@ pages =
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel static =
{ title = static.data.metadata.title
@ -179,7 +179,7 @@ authorView author static =
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
let
@ -233,6 +233,10 @@ type alias Data =
}
type alias ActionData =
{}
data : RouteParams -> DataSource Data
data routeParams =
MarkdownCodec.withFrontmatter Data

12
examples/docs/app/Route/Docs/Section__.elm
View File

@ -1,4 +1,4 @@
module Route.Docs.Section__ exposing (Data, Model, Msg, route)
module Route.Docs.Section__ exposing (ActionData, Data, Model, Msg, route)
import Css
import Css.Global
@ -41,7 +41,7 @@ type alias RouteParams =
{ section : Maybe String }
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.preRender
{ head = head
@ -160,7 +160,7 @@ titleForSection section =
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
@ -190,10 +190,14 @@ type alias Data =
}
type alias ActionData =
{}
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel static =
{ title = static.data.titles.title ++ " - elm-pages docs"

12
examples/docs/app/Route/Index.elm
View File

@ -1,4 +1,4 @@
module Route.Index exposing (Data, Model, Msg, route)
module Route.Index exposing (ActionData, Data, Model, Msg, route)
import Css
import DataSource exposing (DataSource)
@ -38,7 +38,11 @@ type alias Data =
()
route : StatelessRoute RouteParams Data
type alias ActionData =
{}
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.single
{ head = head
@ -48,7 +52,7 @@ route =
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
@ -70,7 +74,7 @@ head static =
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel static =
{ title = "elm-pages - a statically typed site generator"

12
examples/docs/app/Route/Showcase.elm
View File

@ -1,4 +1,4 @@
module Route.Showcase exposing (Data, Model, Msg, route)
module Route.Showcase exposing (ActionData, Data, Model, Msg, route)
import Css
import DataSource
@ -29,7 +29,7 @@ type alias RouteParams =
{}
route : StatefulRoute RouteParams Data Model Msg
route : StatefulRoute RouteParams Data ActionData Model Msg
route =
RouteBuilder.single
{ head = head
@ -47,10 +47,14 @@ type alias Data =
List Showcase.Entry
type alias ActionData =
{}
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data {}
-> StaticPayload Data ActionData {}
-> View Msg
view maybeUrl sharedModel static =
{ title = "elm-pages blog"
@ -84,7 +88,7 @@ view maybeUrl sharedModel static =
}
head : StaticPayload Data {} -> List Head.Tag
head : StaticPayload Data ActionData {} -> List Head.Tag
head staticPayload =
Seo.summary
{ canonicalUrlOverride = Nothing

15
examples/hackernews/app/Effect.elm
View File

@ -1,8 +1,11 @@
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 Pages.Fetcher
import Url exposing (Url)
@ -22,6 +25,7 @@ type Effect msg
, method : Maybe String
, toMsg : Result Http.Error Url -> msg
}
| SubmitFetcher (Pages.Fetcher.Fetcher msg)
type alias RequestInfo =
@ -75,6 +79,11 @@ map fn effect =
, toMsg = fetchInfo.toMsg >> fn
}
SubmitFetcher fetcher ->
fetcher
|> Pages.Fetcher.map fn
|> SubmitFetcher
perform :
{ fetchRouteData :
@ -91,6 +100,9 @@ perform :
, toMsg : Result Http.Error Url -> pageMsg
}
-> Cmd msg
, runFetcher :
Pages.Fetcher.Fetcher pageMsg
-> Cmd msg
, fromPageMsg : pageMsg -> msg
, key : Browser.Navigation.Key
}
@ -129,3 +141,6 @@ perform ({ fromPageMsg, key } as helpers) effect =
, encType = Nothing -- TODO
, toMsg = record.toMsg
}
SubmitFetcher record ->
helpers.runFetcher record

17
examples/hackernews/app/Route/Feed__.elm
View File

@ -1,4 +1,4 @@
module Route.Feed__ exposing (Data, Model, Msg, route)
module Route.Feed__ exposing (ActionData, Data, Model, Msg, route)
import DataSource exposing (DataSource)
import DataSource.Http
@ -35,11 +35,12 @@ type alias RouteParams =
}
route : StatefulRoute RouteParams Data Model Msg
route : StatefulRoute RouteParams Data ActionData Model Msg
route =
RouteBuilder.serverRender
{ head = head
, data = data
, action = \_ -> Request.skip "No action."
}
|> RouteBuilder.buildWithLocalState
{ view = view
@ -52,7 +53,7 @@ route =
init :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> ( Model, Effect Msg )
init maybePageUrl sharedModel static =
( {}, Effect.none )
@ -61,7 +62,7 @@ init maybePageUrl sharedModel static =
update :
PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> Msg
-> Model
-> ( Model, Effect Msg )
@ -85,6 +86,10 @@ type alias Data =
{ stories : List Item, currentPage : Int }
type alias ActionData =
{}
data : RouteParams -> Request.Parser (DataSource (Response Data ErrorPage))
data routeParams =
Request.queryParam "page"
@ -136,7 +141,7 @@ data routeParams =
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
@ -168,7 +173,7 @@ view :
Maybe PageUrl
-> Shared.Model
-> Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel model static =
{ title = title static.routeParams

17
examples/hackernews/app/Route/Stories/Id_.elm
View File

@ -1,4 +1,4 @@
module Route.Stories.Id_ exposing (Data, Model, Msg, route)
module Route.Stories.Id_ exposing (ActionData, Data, Model, Msg, route)
import DataSource exposing (DataSource)
import DataSource.Http
@ -34,11 +34,12 @@ type alias RouteParams =
{ id : String }
route : StatefulRoute RouteParams Data Model Msg
route : StatefulRoute RouteParams Data ActionData Model Msg
route =
RouteBuilder.serverRender
{ head = head
, data = data
, action = \_ -> Request.skip "No action."
}
|> RouteBuilder.buildWithLocalState
{ view = view
@ -51,7 +52,7 @@ route =
init :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> ( Model, Effect Msg )
init maybePageUrl sharedModel static =
( {}, Effect.none )
@ -60,7 +61,7 @@ init maybePageUrl sharedModel static =
update :
PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> Msg
-> Model
-> ( Model, Effect Msg )
@ -85,6 +86,10 @@ type alias Data =
}
type alias ActionData =
{}
data : RouteParams -> Request.Parser (DataSource (Response Data ErrorPage))
data routeParams =
Request.succeed
@ -102,7 +107,7 @@ data routeParams =
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
@ -125,7 +130,7 @@ view :
Maybe PageUrl
-> Shared.Model
-> Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel model static =
{ title = static.data.story |> Tuple.first |> (\(Item common _) -> common.title)

11
examples/pokedex/app/Api.elm
View File

@ -20,11 +20,12 @@ routes :
-> (Html Never -> String)
-> List (ApiRoute.ApiRoute ApiRoute.Response)
routes getStaticRoutes htmlToString =
[ nonHybridRoute
, noArgs
, redirectRoute
, repoStars
, repoStars2
[ --nonHybridRoute
--, noArgs
redirectRoute
--, repoStars
--, repoStars2
, logout
, greet
, fileLength

15
examples/pokedex/app/Effect.elm
View File

@ -1,8 +1,11 @@
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 Pages.Fetcher
import Url exposing (Url)
@ -22,6 +25,7 @@ type Effect msg
, method : Maybe String
, toMsg : Result Http.Error Url -> msg
}
| SubmitFetcher (Pages.Fetcher.Fetcher msg)
type alias RequestInfo =
@ -75,6 +79,11 @@ map fn effect =
, toMsg = fetchInfo.toMsg >> fn
}
SubmitFetcher fetcher ->
fetcher
|> Pages.Fetcher.map fn
|> SubmitFetcher
perform :
{ fetchRouteData :
@ -91,6 +100,9 @@ perform :
, toMsg : Result Http.Error Url -> pageMsg
}
-> Cmd msg
, runFetcher :
Pages.Fetcher.Fetcher pageMsg
-> Cmd msg
, fromPageMsg : pageMsg -> msg
, key : Browser.Navigation.Key
}
@ -129,3 +141,6 @@ perform ({ fromPageMsg, key } as helpers) effect =
, encType = Nothing -- TODO
, toMsg = record.toMsg
}
SubmitFetcher record ->
helpers.runFetcher record

13
examples/pokedex/app/Route/BasicAuth.elm
View File

@ -1,4 +1,4 @@
module Route.BasicAuth exposing (Data, Model, Msg, route)
module Route.BasicAuth exposing (ActionData, Data, Model, Msg, route)
import Base64
import DataSource exposing (DataSource)
@ -25,11 +25,12 @@ type alias RouteParams =
{}
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.serverRender
{ head = head
, data = data
, action = \_ -> Request.skip "No action"
}
|> RouteBuilder.buildNoState { view = view }
@ -39,6 +40,10 @@ type alias Data =
}
type alias ActionData =
{}
data : RouteParams -> Parser (DataSource (Response Data ErrorPage))
data routeParams =
withBasicAuth
@ -53,7 +58,7 @@ data routeParams =
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
[]
@ -62,7 +67,7 @@ head static =
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel static =
{ title = "Basic Auth Test"

13
examples/pokedex/app/Route/FileUpload.elm
View File

@ -1,4 +1,4 @@
module Route.FileUpload exposing (Data, Model, Msg, route)
module Route.FileUpload exposing (ActionData, Data, Model, Msg, route)
import DataSource exposing (DataSource)
import ErrorPage exposing (ErrorPage)
@ -27,11 +27,12 @@ type alias RouteParams =
{}
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.serverRender
{ head = head
, data = data
, action = \_ -> Request.skip "No action."
}
|> RouteBuilder.buildNoState { view = view }
@ -40,6 +41,10 @@ type alias Data =
Maybe Request.File
type alias ActionData =
{}
data : RouteParams -> Request.Parser (DataSource (Server.Response.Response Data ErrorPage))
data routeParams =
Request.oneOf
@ -57,7 +62,7 @@ data routeParams =
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
@ -79,7 +84,7 @@ head static =
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel static =
{ title = "File Upload"

88
examples/pokedex/app/Route/Form.elm
View File

@ -1,4 +1,4 @@
module Route.Form exposing (Data, Model, Msg, route)
module Route.Form exposing (ActionData, Data, Model, Msg, route)
import DataSource exposing (DataSource)
import Date exposing (Date)
@ -186,16 +186,43 @@ form user =
)
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.serverRender
{ head = head
, data = data
, action = action
}
|> RouteBuilder.buildNoState { view = view }
action : RouteParams -> Parser (DataSource (Response ActionData ErrorPage))
action _ =
Form.submitHandlers
(form defaultUser)
(\model decoded ->
case decoded of
Ok okUser ->
{ user = Just okUser
, errors = model
}
|> Server.Response.render
|> DataSource.succeed
Err _ ->
{ user = Nothing
, errors = model
}
|> Server.Response.render
|> DataSource.succeed
)
type alias Data =
{}
type alias ActionData =
{ user : Maybe User
, errors : Form.Model
}
@ -203,69 +230,36 @@ type alias Data =
data : RouteParams -> Parser (DataSource (Response Data ErrorPage))
data routeParams =
Request.oneOf
[ Form.submitHandlers
(form defaultUser)
(\model decoded ->
case decoded of
Ok okUser ->
{ user = Just okUser
, errors = model
}
|> Server.Response.render
|> DataSource.succeed
Err _ ->
{ user = Nothing
, errors = model
}
|> Server.Response.render
|> DataSource.succeed
)
, { user = Nothing
, errors = Form.init (form defaultUser)
}
|> Server.Response.render
|> DataSource.succeed
|> Request.succeed
]
{}
|> Server.Response.render
|> DataSource.succeed
|> Request.succeed
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
{ canonicalUrlOverride = Nothing
, siteName = "elm-pages"
, image =
{ url = Pages.Url.external "TODO"
, alt = "elm-pages logo"
, dimensions = Nothing
, mimeType = Nothing
}
, description = "TODO"
, locale = Nothing
, title = "TODO title" -- metadata.title -- TODO
}
|> Seo.website
[]
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel static =
let
user : User
user =
static.data.user
static.action
|> Maybe.andThen .user
|> Maybe.withDefault defaultUser
in
{ title = "Form Example"
, body =
[ static.data.user
[ static.action
|> Maybe.andThen .user
|> Maybe.map
(\user_ ->
Html.p
@ -280,7 +274,7 @@ view maybeUrl sharedModel static =
[]
[ Html.text <| "Edit profile " ++ user.first ++ " " ++ user.last ]
, form user
|> Form.toStatelessHtml Nothing Html.form static.data.errors
|> Form.toStatelessHtml Nothing Html.form (static.action |> Maybe.map .errors |> Maybe.withDefault (Form.init (form user)))
|> Html.map (\_ -> ())
]
}

16
examples/pokedex/app/Route/FormEvent.elm
View File

@ -1,4 +1,4 @@
module Route.FormEvent exposing (Data, Model, Msg, route)
module Route.FormEvent exposing (ActionData, Data, Model, Msg, route)
import Browser.Navigation
import DataSource exposing (DataSource)
@ -29,7 +29,7 @@ type alias RouteParams =
{}
route : StatefulRoute RouteParams Data Model Msg
route : StatefulRoute RouteParams Data ActionData Model Msg
route =
RouteBuilder.single
{ head = head
@ -46,7 +46,7 @@ route =
init :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> ( Model, Effect Msg )
init maybePageUrl sharedModel static =
( { formAsString = Nothing }, Effect.none )
@ -55,7 +55,7 @@ init maybePageUrl sharedModel static =
update :
PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> Msg
-> Model
-> ( Model, Effect Msg )
@ -81,13 +81,17 @@ type alias Data =
{}
type alias ActionData =
{}
data : DataSource Data
data =
DataSource.succeed {}
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
@ -110,7 +114,7 @@ view :
Maybe PageUrl
-> Shared.Model
-> Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel model static =
{ title = "Placeholder"

13
examples/pokedex/app/Route/Greet.elm
View File

@ -1,4 +1,4 @@
module Route.Greet exposing (Data, Model, Msg, route)
module Route.Greet exposing (ActionData, Data, Model, Msg, route)
import DataSource exposing (DataSource)
import Dict exposing (Dict)
@ -31,11 +31,12 @@ type alias RouteParams =
{}
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.serverRender
{ head = head
, data = data
, action = \_ -> Request.skip "No action."
}
|> RouteBuilder.buildNoState { view = view }
@ -86,7 +87,7 @@ data routeParams =
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
@ -112,10 +113,14 @@ type alias Data =
}
type alias ActionData =
{}
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel static =
{ title = "Hello!"

139
examples/pokedex/app/Route/Hello.elm Normal file
View File

@ -0,0 +1,139 @@
module Route.Hello exposing (ActionData, Data, Model, Msg, route)
import DataSource exposing (DataSource)
import Effect exposing (Effect)
import ErrorPage exposing (ErrorPage)
import Fetcher.Signup
import Head
import Head.Seo as Seo
import Html
import Http
import Pages.PageUrl exposing (PageUrl)
import Pages.Url
import Path exposing (Path)
import Route.Signup
import RouteBuilder exposing (StatefulRoute, StatelessRoute, StaticPayload)
import Server.Request as Request
import Server.Response as Response exposing (Response)
import Shared
import View exposing (View)
type alias Model =
{}
type Msg
= NoOp
| GotResponse (Result Http.Error Route.Signup.ActionData)
type alias RouteParams =
{}
route : StatefulRoute RouteParams Data ActionData Model Msg
route =
RouteBuilder.serverRender
{ head = head
, data = data
, action = \_ -> Request.succeed (DataSource.succeed (Response.render {}))
}
|> RouteBuilder.buildWithLocalState
{ view = view
, update = update
, subscriptions = subscriptions
, init = init
}
init :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data ActionData RouteParams
-> ( Model, Effect Msg )
init maybePageUrl sharedModel static =
( {}
, Fetcher.Signup.submit GotResponse
{ headers = []
, fields =
[ ( "first", "Jane" )
, ( "email", "jane@example.com" )
]
}
|> Effect.SubmitFetcher
)
update :
PageUrl
-> Shared.Model
-> StaticPayload Data ActionData RouteParams
-> Msg
-> Model
-> ( Model, Effect Msg )
update pageUrl sharedModel static msg model =
case msg of
NoOp ->
( model
, Effect.none
)
GotResponse result ->
let
_ =
Debug.log "GotResponse" result
in
( model
, Effect.none
)
subscriptions : Maybe PageUrl -> RouteParams -> Path -> Shared.Model -> Model -> Sub Msg
subscriptions maybePageUrl routeParams path sharedModel model =
Sub.none
type alias Data =
{}
type alias ActionData =
{}
data : RouteParams -> Request.Parser (DataSource (Response Data ErrorPage))
data routeParams =
Request.succeed (DataSource.succeed (Response.render Data))
head :
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
{ canonicalUrlOverride = Nothing
, siteName = "elm-pages"
, image =
{ url = Pages.Url.external "TODO"
, alt = "elm-pages logo"
, dimensions = Nothing
, mimeType = Nothing
}
, description = "TODO"
, locale = Nothing
, title = "TODO title" -- metadata.title -- TODO
}
|> Seo.website
view :
Maybe PageUrl
-> Shared.Model
-> Model
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel model static =
{ title = "Hello!"
, body = [ Html.text "Hello" ]
}

8
examples/pokedex/app/Route/Hex/Hex_.elm
View File

@ -1,4 +1,4 @@
module Route.Hex.Hex_ exposing (Data, Model, Msg, route)
module Route.Hex.Hex_ exposing (ActionData, Data, Model, Msg, route)
import ColorHelpers
import DataSource exposing (DataSource)
@ -21,7 +21,11 @@ type alias Data =
ColorHelpers.Data
route : StatelessRoute RouteParams Data
type alias ActionData =
{}
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.preRenderWithFallback
{ head = ColorHelpers.head toCssVal

12
examples/pokedex/app/Route/Index.elm
View File

@ -1,4 +1,4 @@
module Route.Index exposing (Data, Model, Msg, route)
module Route.Index exposing (ActionData, Data, Model, Msg, route)
import DataSource exposing (DataSource)
import DataSource.Env as Env
@ -28,7 +28,7 @@ type alias RouteParams =
{}
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.single
{ head = head
@ -41,6 +41,10 @@ type alias Data =
{ pokemon : List String, envValue : Maybe String }
type alias ActionData =
{}
data : DataSource Data
data =
DataSource.map2 Data
@ -54,7 +58,7 @@ data =
head :
StaticPayload Data RouteParams
StaticPayload Data RouteParams ActionData
-> List Head.Tag
head static =
Seo.summary
@ -76,7 +80,7 @@ head static =
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data RouteParams ActionData
-> View Msg
view maybeUrl sharedModel static =
{ title = "Pokedex"

13
examples/pokedex/app/Route/Login.elm
View File

@ -1,4 +1,4 @@
module Route.Login exposing (Data, Model, Msg, route)
module Route.Login exposing (ActionData, Data, Model, Msg, route)
import DataSource exposing (DataSource)
import Dict exposing (Dict)
@ -31,11 +31,12 @@ type alias RouteParams =
{}
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.serverRender
{ head = head
, data = data
, action = \_ -> Request.skip "No action."
}
|> RouteBuilder.buildNoState { view = view }
@ -85,7 +86,7 @@ data routeParams =
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
@ -109,10 +110,14 @@ type alias Data =
}
type alias ActionData =
{}
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel static =
{ title = "Login"

8
examples/pokedex/app/Route/Named/Color_.elm
View File

@ -1,4 +1,4 @@
module Route.Named.Color_ exposing (Data, Model, Msg, route)
module Route.Named.Color_ exposing (ActionData, Data, Model, Msg, route)
import ColorHelpers
import DataSource exposing (DataSource)
@ -17,11 +17,15 @@ type alias RouteParams =
{ color : String }
type alias ActionData =
{}
type alias Data =
ColorHelpers.Data
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.preRenderWithFallback
{ head = ColorHelpers.head toCssVal

12
examples/pokedex/app/Route/PokedexNumber_.elm
View File

@ -1,4 +1,4 @@
module Route.PokedexNumber_ exposing (Data, Model, Msg, route)
module Route.PokedexNumber_ exposing (ActionData, Data, Model, Msg, route)
import DataSource exposing (DataSource)
import DataSource.Http
@ -28,7 +28,7 @@ type alias RouteParams =
{ pokedexNumber : String }
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.preRenderWithFallback
{ head = head
@ -79,7 +79,7 @@ type alias Pokemon =
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
@ -108,10 +108,14 @@ type alias Data =
}
type alias ActionData =
{}
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel static =
{ title = static.data.pokemon.name

12
examples/pokedex/app/Route/PortTest.elm
View File

@ -1,4 +1,4 @@
module Route.PortTest exposing (Data, Model, Msg, route)
module Route.PortTest exposing (ActionData, Data, Model, Msg, route)
import DataSource exposing (DataSource)
import DataSource.Port
@ -26,7 +26,7 @@ type alias RouteParams =
{}
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.single
{ head = head
@ -40,6 +40,10 @@ type alias Data =
}
type alias ActionData =
{}
data : DataSource Data
data =
DataSource.succeed Data
@ -47,7 +51,7 @@ data =
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
[]
@ -56,7 +60,7 @@ head static =
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel static =
{ title = "Placeholder"

12
examples/pokedex/app/Route/RedirectLinks.elm
View File

@ -1,4 +1,4 @@
module Route.RedirectLinks exposing (Data, Model, Msg, route)
module Route.RedirectLinks exposing (ActionData, Data, Model, Msg, route)
import DataSource exposing (DataSource)
import Head
@ -24,7 +24,7 @@ type alias RouteParams =
{}
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.single
{ head = head
@ -37,13 +37,17 @@ type alias Data =
{}
type alias ActionData =
{}
data : DataSource Data
data =
DataSource.succeed {}
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
@ -65,7 +69,7 @@ head static =
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel static =
{ title = "Placeholder"

8
examples/pokedex/app/Route/Rgb/Red_/Green_/Blue_.elm
View File

@ -1,4 +1,4 @@
module Route.Rgb.Red_.Green_.Blue_ exposing (Data, Model, Msg, route)
module Route.Rgb.Red_.Green_.Blue_ exposing (ActionData, Data, Model, Msg, route)
import ColorHelpers
import DataSource exposing (DataSource)
@ -17,7 +17,7 @@ type alias RouteParams =
{ red : String, green : String, blue : String }
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.preRenderWithFallback
{ head = ColorHelpers.head toCssVal
@ -36,6 +36,10 @@ type alias Data =
ColorHelpers.Data
type alias ActionData =
{}
toCssVal : RouteParams -> String
toCssVal routeParams =
"rgb("

13
examples/pokedex/app/Route/Secret.elm
View File

@ -1,4 +1,4 @@
module Route.Secret exposing (Data, Model, Msg, route)
module Route.Secret exposing (ActionData, Data, Model, Msg, route)
import DataSource exposing (DataSource)
import DataSource.File
@ -29,11 +29,12 @@ type alias RouteParams =
{}
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.serverRender
{ head = head
, data = data
, action = \_ -> Request.skip "No action"
}
|> RouteBuilder.buildNoState { view = view }
@ -43,6 +44,10 @@ type Data
| NotLoggedIn
type alias ActionData =
{}
type alias LoggedInInfo =
{ username : String
, secretNote : String
@ -76,7 +81,7 @@ data routeParams =
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
@ -98,7 +103,7 @@ head static =
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel static =
case static.data of

238
examples/pokedex/app/Route/Signup.elm Normal file
View File

@ -0,0 +1,238 @@
module Route.Signup exposing (ActionData, Data, Model, Msg, route)
import DataSource exposing (DataSource)
import Dict
import Effect exposing (Effect)
import ErrorPage exposing (ErrorPage)
import Head
import Head.Seo as Seo
import Html exposing (Html)
import Html.Attributes as Attr
import Http
import MySession
import Pages.PageUrl exposing (PageUrl)
import Pages.Url
import Path exposing (Path)
import Route
import RouteBuilder exposing (StatefulRoute, StatelessRoute, StaticPayload)
import Server.Request as Request
import Server.Response as Response exposing (Response)
import Server.Session as Session exposing (Session)
import Shared
import View exposing (View)
type alias Model =
{}
type Msg
= NoOp
| GotResponse (Result Http.Error ActionData)
type alias RouteParams =
{}
route : StatefulRoute RouteParams Data ActionData Model Msg
route =
RouteBuilder.serverRender
{ head = head
, data = data
, action = action
}
|> RouteBuilder.buildWithLocalState
{ view = view
, update = update
, subscriptions = subscriptions
, init = init
}
action : RouteParams -> Request.Parser (DataSource (Response ActionData ErrorPage))
action _ =
MySession.withSession
(Request.expectFormPost
(\{ field } ->
Request.map2 Tuple.pair
(field "first")
(field "email")
)
)
(\( first, email ) maybeSession ->
let
session : Session
session =
maybeSession |> Result.toMaybe |> Maybe.andThen identity |> Maybe.withDefault Session.empty
in
validate session
{ email = email
, first = first
}
|> DataSource.succeed
)
validate : Session -> { first : String, email : String } -> ( Session, Response ActionData ErrorPage )
validate session { first, email } =
if first /= "" && email /= "" then
( session
|> Session.withFlash "message" ("Success! You're all signed up " ++ first)
, Route.redirectTo Route.Signup
)
else
( session
, ValidationErrors
{ errors = [ "Cannot be blank?" ]
, fields =
[ ( "first", first )
, ( "email", email )
]
}
|> Response.render
)
init :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data ActionData RouteParams
-> ( Model, Effect Msg )
init maybePageUrl sharedModel static =
( {}
, static.submit
{ headers = []
, fields =
-- TODO when you run a Fetcher and get back a Redirect, how should that be handled? Maybe instead of `Result Http.Error ActionData`,
-- it should be `FetcherResponse ActionData`, with Redirect as one of the possibilities?
--[ ( "first", "Jane" )
--, ( "email", "jane@example.com" )
--]
[ ( "first", "" )
, ( "email", "" )
]
}
|> Effect.SubmitFetcher
|> Effect.map GotResponse
)
update :
PageUrl
-> Shared.Model
-> StaticPayload Data ActionData RouteParams
-> Msg
-> Model
-> ( Model, Effect Msg )
update pageUrl sharedModel static msg model =
case msg of
NoOp ->
( model, Effect.none )
GotResponse result ->
let
_ =
Debug.log "GotResponse" result
in
( model, Effect.none )
subscriptions : Maybe PageUrl -> RouteParams -> Path -> Shared.Model -> Model -> Sub Msg
subscriptions maybePageUrl routeParams path sharedModel model =
Sub.none
type alias Data =
{ flashMessage : Maybe (Result String String)
}
type ActionData
= Success { email : String, first : String }
| ValidationErrors
{ errors : List String
, fields : List ( String, String )
}
data : RouteParams -> Request.Parser (DataSource (Response Data ErrorPage))
data routeParams =
MySession.withSession
(Request.succeed ())
(\() sessionResult ->
let
session : Session
session =
sessionResult |> Result.toMaybe |> Maybe.andThen identity |> Maybe.withDefault Session.empty
flashMessage : Maybe String
flashMessage =
session |> Session.get "message"
in
( Session.empty
, Response.render
{ flashMessage = flashMessage |> Maybe.map Ok }
)
|> DataSource.succeed
)
head :
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
[]
view :
Maybe PageUrl
-> Shared.Model
-> Model
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel model static =
{ title = "Signup"
, body =
[ Html.p []
[ case static.action of
Just (Success { email, first }) ->
Html.text <| "Hello " ++ first ++ "!"
Just (ValidationErrors { errors }) ->
errors
|> List.map (\error -> Html.li [] [ Html.text error ])
|> Html.ul []
_ ->
Html.text ""
]
, flashView static.data.flashMessage
, Html.form
[ Attr.method "POST"
]
[ Html.label [] [ Html.text "First", Html.input [ Attr.name "first" ] [] ]
, Html.label [] [ Html.text "Email", Html.input [ Attr.name "email" ] [] ]
, Html.input [ Attr.type_ "submit", Attr.value "Signup" ] []
]
]
}
flashView : Maybe (Result String String) -> Html msg
flashView message =
Html.p
[ Attr.style "background-color" "rgb(163 251 163)"
]
[ Html.text <|
case message of
Nothing ->
""
Just (Ok okMessage) ->
okMessage
Just (Err error) ->
"Something went wrong: " ++ error
]

73
examples/pokedex/app/Route/TailwindForm.elm
View File

@ -1,4 +1,4 @@
module Route.TailwindForm exposing (Data, Model, Msg, route)
module Route.TailwindForm exposing (ActionData, Data, Model, Msg, route)
import Browser.Dom
import Css exposing (Color)
@ -545,11 +545,12 @@ cancelButton =
[ Html.text "Cancel" ]
route : StatefulRoute RouteParams Data Model Msg
route : StatefulRoute RouteParams Data ActionData Model Msg
route =
RouteBuilder.serverRender
{ head = head
, data = data
, action = action
}
|> RouteBuilder.buildWithLocalState
{ view = view
@ -559,24 +560,25 @@ route =
}
action : RouteParams -> Parser (DataSource (Response ActionData ErrorPage))
action routeParams =
Form.submitHandlers
(form defaultUser)
(\model decoded ->
DataSource.succeed
{ user = Result.toMaybe decoded
, initialForm = model
}
|> DataSource.map Response.render
)
update _ _ static msg model =
case msg of
FormMsg formMsg ->
model.form
|> Form.update Effect.Submit Effect.None FormMsg (form defaultUser) formMsg
|> Tuple.mapFirst (\newFormModel -> { model | form = newFormModel })
|> (case formMsg of
Form.GotFormResponse _ ->
if Form.hasErrors static.data.initialForm then
-- TODO this case is never hit because `init` is called again
withFlash (Err "Failed to submit or had errors")
else
withFlash (Ok "Success! Submitted form from Elm")
_ ->
identity
)
MovedToTop ->
( model, Effect.none )
@ -588,16 +590,25 @@ withFlash flashMessage ( model, cmd ) =
init _ _ static =
( { form = static.data.initialForm
let
_ =
Debug.log "@@@static.action" static.action
in
( { form = static.action |> Maybe.map .initialForm |> Maybe.withDefault (Form.init (form defaultUser))
, flashMessage =
static.data.user
static.action
|> Maybe.map
(\user_ ->
if Form.hasErrors static.data.initialForm then
(\actionData ->
if Form.hasErrors actionData.initialForm then
Err "Got errors"
else
Ok ("Successfully received user " ++ user_.first ++ " " ++ user_.last)
case actionData.user of
Just user ->
Ok ("Successfully updated profile for user " ++ user.first ++ " " ++ user.last)
Nothing ->
Err "Unexpected"
)
}
, Effect.none
@ -605,6 +616,10 @@ init _ _ static =
type alias Data =
{}
type alias ActionData =
{ user : Maybe User
, initialForm : Form.Model
}
@ -613,18 +628,7 @@ type alias Data =
data : RouteParams -> Parser (DataSource (Response Data ErrorPage))
data routeParams =
Request.oneOf
[ Form.submitHandlers
(form defaultUser)
(\model decoded ->
DataSource.succeed
{ user = Result.toMaybe decoded
, initialForm = model
}
|> DataSource.map Response.render
)
, { user = Nothing
, initialForm = Form.init (form defaultUser)
}
[ {}
|> Response.render
|> DataSource.succeed
|> Request.succeed
@ -632,7 +636,7 @@ data routeParams =
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
@ -703,13 +707,14 @@ view :
Maybe PageUrl
-> Shared.Model
-> Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel model static =
let
user : User
user =
static.data.user
static.action
|> Maybe.andThen .user
|> Maybe.withDefault defaultUser
in
{ title = "Form Example"

13
examples/pokedex/app/Route/Time.elm
View File

@ -1,4 +1,4 @@
module Route.Time exposing (Data, Model, Msg, route)
module Route.Time exposing (ActionData, Data, Model, Msg, route)
import DataSource exposing (DataSource)
import Dict exposing (Dict)
@ -28,11 +28,12 @@ type alias RouteParams =
{}
route : StatelessRoute RouteParams Data
route : StatelessRoute RouteParams Data ActionData
route =
RouteBuilder.serverRender
{ head = head
, data = data
, action = \_ -> Request.skip "No action."
}
|> RouteBuilder.buildNoState { view = view }
@ -104,7 +105,7 @@ data routeParams =
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
@ -128,10 +129,14 @@ type alias Data =
}
type alias ActionData =
{}
view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel static =
{ title = "Time"

107
examples/pokedex/app/Route/Todos.elm
View File

@ -1,4 +1,4 @@
module Route.Todos exposing (Data, Model, Msg, route)
module Route.Todos exposing (ActionData, Data, Model, Msg, route)
import Api.InputObject
import Api.Mutation
@ -50,11 +50,12 @@ type alias RouteParams =
{}
route : StatefulRoute RouteParams Data Model Msg
route : StatefulRoute RouteParams Data ActionData Model Msg
route =
RouteBuilder.serverRender
{ head = head
, data = data
, action = action
}
|> RouteBuilder.buildWithLocalState
{ view = view
@ -67,7 +68,7 @@ route =
init :
Maybe PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> ( Model, Effect Msg )
init maybePageUrl sharedModel static =
( { submitting = False
@ -80,7 +81,7 @@ init maybePageUrl sharedModel static =
update :
PageUrl
-> Shared.Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> Msg
-> Model
-> ( Model, Effect Msg )
@ -128,6 +129,10 @@ type alias Data =
}
type alias ActionData =
Maybe Form.Model
type alias Todo =
{ description : String
, id : String
@ -175,34 +180,7 @@ todoSelection =
data : RouteParams -> Parser (DataSource (Response Data ErrorPage))
data routeParams =
Request.oneOf
[ Form.submitHandlers (deleteItemForm "")
(\model decoded ->
case decoded of
Ok id ->
Request.Fauna.mutationDataSource "" (deleteTodo id)
|> DataSource.map
(\_ -> Route.redirectTo Route.Todos)
Err error ->
{ todos = [] }
|> Response.render
|> DataSource.succeed
)
, Form.submitHandlers (newItemForm False)
(\model decoded ->
case decoded of
Ok okItem ->
Request.Fauna.mutationDataSource "" (createTodo okItem.description)
|> DataSource.map
(\_ -> Route.redirectTo Route.Todos)
Err error ->
{ todos = []
}
|> Response.render
|> DataSource.succeed
)
, Request.requestTime
[ Request.requestTime
|> Request.map
(\time ->
Request.Fauna.dataSource (time |> Time.posixToMillis |> String.fromInt) todos
@ -212,8 +190,44 @@ data routeParams =
]
action : RouteParams -> Parser (DataSource (Response ActionData ErrorPage))
action _ =
Request.oneOf
[ Form.submitHandlers (deleteItemForm "")
(\model decoded ->
case decoded of
Ok id ->
Request.Fauna.mutationDataSource "" (deleteTodo id)
|> DataSource.map
(\_ -> Route.redirectTo Route.Todos)
Err error ->
Nothing
|> Response.render
|> DataSource.succeed
)
, Form.submitHandlers (newItemForm False)
(\model decoded ->
case decoded of
Ok okItem ->
Request.Fauna.mutationDataSource "" (createTodo okItem.description)
|> DataSource.map
(\_ ->
--Route.redirectTo Route.Todos
Response.render Nothing
)
Err error ->
model
|> Just
|> Response.render
|> DataSource.succeed
)
]
head :
StaticPayload Data RouteParams
StaticPayload Data ActionData RouteParams
-> List Head.Tag
head static =
Seo.summary
@ -236,7 +250,7 @@ view :
Maybe PageUrl
-> Shared.Model
-> Model
-> StaticPayload Data RouteParams
-> StaticPayload Data ActionData RouteParams
-> View Msg
view maybeUrl sharedModel model static =
{ title = "Todos"
@ -262,6 +276,7 @@ view maybeUrl sharedModel model static =
]
)
)
, errorsView static.action
, newItemForm model.submitting
|> Form.toStatelessHtml
(Just FormSubmitted)
@ -271,14 +286,32 @@ view maybeUrl sharedModel model static =
}
errorsView : Maybe ActionData -> Html msg
errorsView actionData =
case actionData |> Maybe.andThen identity of
Just justData ->
justData
|> Form.getErrors
|> List.map (\( name, error ) -> Html.text (name ++ ": " ++ error))
|> Html.ul [ Attr.style "color" "red" ]
Nothing ->
Html.div [] []
newItemForm : Bool -> Form Msg String TodoInput (Html Msg)
newItemForm submitting =
Form.succeed (\description () -> TodoInput description)
|> Form.with
(Form.text "description"
(\{ toInput } ->
Html.input (Attr.autofocus True :: toInput) []
|> Html.map (\_ -> NoOp)
(\info ->
Html.div []
[ Html.label info.toLabel
[ Html.text "Description"
]
, Html.input (Attr.autofocus True :: info.toInput) []
|> Html.map (\_ -> NoOp)
]
)
|> Form.required "Required"
)

4
examples/pokedex/src/ColorHelpers.elm
View File

@ -27,7 +27,7 @@ data _ =
|> DataSource.map Server.Response.render
head : (routeParams -> String) -> StaticPayload Data routeParams -> List Head.Tag
head : (routeParams -> String) -> StaticPayload Data {} routeParams -> List Head.Tag
head toCssValue static =
Seo.summary
{ canonicalUrlOverride = Nothing
@ -53,7 +53,7 @@ view :
(routeParams -> String)
-> Maybe PageUrl
-> Shared.Model
-> StaticPayload Data routeParams
-> StaticPayload Data {} routeParams
-> View msg
view toCssVal maybeUrl sharedModel static =
let

97
generator/src/RouteBuilder.elm
View File

@ -82,11 +82,14 @@ When there are Dynamic Route Segments, you need to tell `elm-pages` which pages
-}
import Bytes exposing (Bytes)
import DataSource exposing (DataSource)
import DataSource.Http
import Effect exposing (Effect)
import ErrorPage exposing (ErrorPage)
import Head
import Http
import Pages.Fetcher
import Pages.Internal.NotFoundReason exposing (NotFoundReason)
import Pages.Internal.RoutePattern exposing (RoutePattern)
import Pages.PageUrl exposing (PageUrl)
@ -98,20 +101,21 @@ import View exposing (View)
{-| -}
type alias StatefulRoute routeParams data model msg =
type alias StatefulRoute routeParams data action model msg =
{ data : routeParams -> DataSource (Server.Response.Response data ErrorPage)
, action : routeParams -> DataSource (Server.Response.Response action ErrorPage)
, staticRoutes : DataSource (List routeParams)
, view :
Maybe PageUrl
-> Shared.Model
-> model
-> StaticPayload data routeParams
-> StaticPayload data action routeParams
-> View msg
, head :
StaticPayload data routeParams
StaticPayload data action routeParams
-> List Head.Tag
, init : Maybe PageUrl -> Shared.Model -> StaticPayload data routeParams -> ( model, Effect msg )
, update : PageUrl -> StaticPayload data routeParams -> msg -> model -> Shared.Model -> ( model, Effect msg, Maybe Shared.Msg )
, init : Maybe PageUrl -> Shared.Model -> StaticPayload data action routeParams -> ( model, Effect msg )
, update : PageUrl -> StaticPayload data action routeParams -> msg -> model -> Shared.Model -> ( model, Effect msg, Maybe Shared.Msg )
, subscriptions : Maybe PageUrl -> routeParams -> Path -> model -> Shared.Model -> Sub msg
, handleRoute : { moduleName : List String, routePattern : RoutePattern } -> (routeParams -> List ( String, String )) -> routeParams -> DataSource (Maybe NotFoundReason)
, kind : String
@ -119,26 +123,31 @@ type alias StatefulRoute routeParams data model msg =
{-| -}
type alias StatelessRoute routeParams data =
StatefulRoute routeParams data {} ()
type alias StatelessRoute routeParams data action =
StatefulRoute routeParams data action {} ()
{-| -}
type alias StaticPayload data routeParams =
type alias StaticPayload data action routeParams =
{ data : data
, sharedData : Shared.Data
, routeParams : routeParams
, path : Path
, action : Maybe action
, submit :
{ fields : List ( String, String ), headers : List ( String, String ) }
-> Pages.Fetcher.Fetcher (Result Http.Error action)
}
{-| -}
type Builder routeParams data
type Builder routeParams data action
= WithData
{ data : routeParams -> DataSource (Server.Response.Response data ErrorPage)
, action : routeParams -> DataSource (Server.Response.Response action ErrorPage)
, staticRoutes : DataSource (List routeParams)
, head :
StaticPayload data routeParams
StaticPayload data action routeParams
-> List Head.Tag
, serverless : Bool
, handleRoute :
@ -155,17 +164,18 @@ buildNoState :
{ view :
Maybe PageUrl
-> Shared.Model
-> StaticPayload data routeParams
-> StaticPayload data action routeParams
-> View ()
}
-> Builder routeParams data
-> StatefulRoute routeParams data {} ()
-> Builder routeParams data action
-> StatefulRoute routeParams data action {} ()
buildNoState { view } builderState =
case builderState of
WithData record ->
{ view = \maybePageUrl sharedModel _ -> view maybePageUrl sharedModel
, head = record.head
, data = record.data
, action = record.action
, staticRoutes = record.staticRoutes
, init = \_ _ _ -> ( {}, Effect.none )
, update = \_ _ _ _ _ -> ( {}, Effect.none, Nothing )
@ -181,14 +191,14 @@ buildWithLocalState :
Maybe PageUrl
-> Shared.Model
-> model
-> StaticPayload data routeParams
-> StaticPayload data action routeParams
-> View msg
, init : Maybe PageUrl -> Shared.Model -> StaticPayload data routeParams -> ( model, Effect msg )
, update : PageUrl -> Shared.Model -> StaticPayload data routeParams -> msg -> model -> ( model, Effect msg )
, init : Maybe PageUrl -> Shared.Model -> StaticPayload data action routeParams -> ( model, Effect msg )
, update : PageUrl -> Shared.Model -> StaticPayload data action routeParams -> msg -> model -> ( model, Effect msg )
, subscriptions : Maybe PageUrl -> routeParams -> Path -> Shared.Model -> model -> Sub msg
}
-> Builder routeParams data
-> StatefulRoute routeParams data model msg
-> Builder routeParams data action
-> StatefulRoute routeParams data action model msg
buildWithLocalState config builderState =
case builderState of
WithData record ->
@ -197,6 +207,7 @@ buildWithLocalState config builderState =
config.view model sharedModel staticPayload
, head = record.head
, data = record.data
, action = record.action
, staticRoutes = record.staticRoutes
, init = config.init
, update =
@ -225,20 +236,21 @@ buildWithSharedState :
Maybe PageUrl
-> Shared.Model
-> model
-> StaticPayload data routeParams
-> StaticPayload data action routeParams
-> View msg
, init : Maybe PageUrl -> Shared.Model -> StaticPayload data routeParams -> ( model, Effect msg )
, update : PageUrl -> Shared.Model -> StaticPayload data routeParams -> msg -> model -> ( model, Effect msg, Maybe Shared.Msg )
, init : Maybe PageUrl -> Shared.Model -> StaticPayload data action routeParams -> ( model, Effect msg )
, update : PageUrl -> Shared.Model -> StaticPayload data action routeParams -> msg -> model -> ( model, Effect msg, Maybe Shared.Msg )
, subscriptions : Maybe PageUrl -> routeParams -> Path -> Shared.Model -> model -> Sub msg
}
-> Builder routeParams data
-> StatefulRoute routeParams data model msg
-> Builder routeParams data action
-> StatefulRoute routeParams data action model msg
buildWithSharedState config builderState =
case builderState of
WithData record ->
{ view = config.view
, head = record.head
, data = record.data
, action = record.action
, staticRoutes = record.staticRoutes
, init = config.init
, update =
@ -259,12 +271,13 @@ buildWithSharedState config builderState =
{-| -}
single :
{ data : DataSource data
, head : StaticPayload data {} -> List Head.Tag
, head : StaticPayload data action {} -> List Head.Tag
}
-> Builder {} data
-> Builder {} data action
single { data, head } =
WithData
{ data = \_ -> data |> DataSource.map Server.Response.render
, action = \_ -> DataSource.fail "Internal Error - actions should never be called for statically generated pages."
, staticRoutes = DataSource.succeed [ {} ]
, head = head
, serverless = False
@ -277,12 +290,13 @@ single { data, head } =
preRender :
{ data : routeParams -> DataSource data
, pages : DataSource (List routeParams)
, head : StaticPayload data routeParams -> List Head.Tag
, head : StaticPayload data action routeParams -> List Head.Tag
}
-> Builder routeParams data
-> Builder routeParams data action
preRender { data, head, pages } =
WithData
{ data = data >> DataSource.map Server.Response.render
, action = \_ -> DataSource.fail "Internal Error - actions should never be called for statically generated pages."
, staticRoutes = pages
, head = head
, serverless = False
@ -314,12 +328,13 @@ preRender { data, head, pages } =
preRenderWithFallback :
{ data : routeParams -> DataSource (Server.Response.Response data ErrorPage)
, pages : DataSource (List routeParams)
, head : StaticPayload data routeParams -> List Head.Tag
, head : StaticPayload data action routeParams -> List Head.Tag
}
-> Builder routeParams data
-> Builder routeParams data action
preRenderWithFallback { data, head, pages } =
WithData
{ data = data
, action = \_ -> DataSource.fail "Internal Error - actions should never be called for statically generated pages."
, staticRoutes = pages
, head = head
, serverless = False
@ -333,10 +348,11 @@ preRenderWithFallback { data, head, pages } =
{-| -}
serverRender :
{ data : routeParams -> Server.Request.Parser (DataSource (Server.Response.Response data ErrorPage))
, head : StaticPayload data routeParams -> List Head.Tag
, action : routeParams -> Server.Request.Parser (DataSource (Server.Response.Response action ErrorPage))
, head : StaticPayload data action routeParams -> List Head.Tag
}
-> Builder routeParams data
serverRender { data, head } =
-> Builder routeParams data action
serverRender { data, action, head } =
WithData
{ data =
\routeParams ->
@ -355,6 +371,23 @@ serverRender { data, head } =
Err error ->
Server.Request.errorsToString error |> DataSource.fail
)
, action =
\routeParams ->
DataSource.Http.get
"$$elm-pages$$headers"
(routeParams
|> action
|> Server.Request.getDecoder
)
|> DataSource.andThen
(\rendered ->
case rendered of
Ok okRendered ->
okRendered
Err error ->
Server.Request.errorsToString error |> DataSource.fail
)
, staticRoutes = DataSource.succeed []
, head = head
, serverless = True

20
generator/src/codegen.js
View File

@ -20,6 +20,7 @@ async function generate(basePath) {
const browserCode = generateTemplateModuleConnector(basePath, "browser");
ensureDirSync("./elm-stuff");
ensureDirSync("./.elm-pages");
ensureDirSync("./gen");
ensureDirSync("./elm-stuff/elm-pages/.elm-pages");
const uiFileContent = elmPagesUiFile();
@ -49,12 +50,31 @@ async function generate(basePath) {
),
fs.promises.writeFile("./.elm-pages/Main.elm", browserCode.mainModule),
fs.promises.writeFile("./.elm-pages/Route.elm", browserCode.routesModule),
writeFetcherModules("./.elm-pages", browserCode.fetcherModules),
writeFetcherModules(
"./elm-stuff/elm-pages/client/.elm-pages",
browserCode.fetcherModules
),
writeFetcherModules(
"./elm-stuff/elm-pages/.elm-pages",
browserCode.fetcherModules
),
// write modified elm.json to elm-stuff/elm-pages/
copyModifiedElmJson(),
...(await listFiles("./Pages/Internal")).map(copyToBoth),
]);
}
function writeFetcherModules(basePath, fetcherData) {
Promise.all(
fetcherData.map(([name, fileContent]) => {
let filePath = path.join(basePath, `/Fetcher/${name.join("/")}.elm`);
ensureDirSync(path.dirname(filePath));
return fs.promises.writeFile(filePath, fileContent);
})
);
}
async function newCopyBoth(modulePath) {
await fs.promises.copyFile(
path.join(__dirname, modulePath),

185
generator/src/generate-template-module-connector.js
View File

@ -59,6 +59,7 @@ import Http
import Json.Decode
import Json.Encode
import Pages.Flags
import Pages.Fetcher
import ${
phase === "browser"
? "Pages.Internal.Platform"
@ -142,6 +143,17 @@ type PageData
.join(" | ")}
type ActionData
=
${templates
.map(
(name) =>
`ActionData${pathNormalizedName(name)} Route.${moduleName(
name
)}.ActionData\n`
)
.join(" | ")}
view :
{ path : Path
@ -150,11 +162,12 @@ view :
-> Maybe PageUrl
-> Shared.Data
-> PageData
-> Maybe ActionData
->
{ view : Model -> { title : String, body : Html Msg }
, head : List Head.Tag
}
view page maybePageUrl globalData pageData =
view page maybePageUrl globalData pageData actionData =
case ( page.route, pageData ) of
( _, DataErrorPage____ data ) ->
{ view =
@ -188,6 +201,14 @@ view page maybePageUrl globalData pageData =
? `Route.${routeHelpers.routeVariant(name)}`
: `(Route.${routeHelpers.routeVariant(name)} s)`
}, Data${routeHelpers.routeVariant(name)} data ) ->
let
actionDataOrNothing =
case actionData of
Just (ActionData${routeHelpers.routeVariant(
name
)} justActionData) -> Just justActionData
_ -> Nothing
in
{ view =
\\model ->
case model.page of
@ -201,7 +222,11 @@ view page maybePageUrl globalData pageData =
, routeParams = ${
emptyRouteParams(name) ? "{}" : "s"
}
, action = actionDataOrNothing
, path = page.path
, submit = Pages.Fetcher.submit Route.${moduleName(
name
)}.w3_decode_ActionData
}
|> View.map Msg${pathNormalizedName(name)}
|> Shared.template.view globalData page model.global MsgGlobal
@ -215,7 +240,11 @@ view page maybePageUrl globalData pageData =
{ data = data
, sharedData = globalData
, routeParams = ${emptyRouteParams(name) ? "{}" : "s"}
, action = Nothing
, path = page.path
, submit = Pages.Fetcher.submit Route.${moduleName(
name
)}.w3_decode_ActionData
}
`
}
@ -243,6 +272,7 @@ init :
-> Pages.Flags.Flags
-> Shared.Data
-> PageData
-> Maybe ActionData
-> Maybe Browser.Navigation.Key
->
Maybe
@ -255,7 +285,7 @@ init :
, pageUrl : Maybe PageUrl
}
-> ( Model, Effect Msg )
init currentGlobalModel userFlags sharedData pageData navigationKey maybePagePath =
init currentGlobalModel userFlags sharedData pageData actionData navigationKey maybePagePath =
let
( sharedModel, globalCmd ) =
currentGlobalModel |> Maybe.map (\\m -> ( m, Effect.none )) |> Maybe.withDefault (Shared.template.init userFlags maybePagePath)
@ -273,15 +303,27 @@ init currentGlobalModel userFlags sharedData pageData navigationKey maybePagePat
}, justPath ), Data${pathNormalizedName(
name
)} thisPageData ) ->
let
actionDataOrNothing =
case actionData of
Just (ActionData${routeHelpers.routeVariant(
name
)} justActionData) -> Just justActionData
_ -> Nothing
in
Route.${moduleName(name)}.route.init
(Maybe.andThen .pageUrl maybePagePath)
sharedModel
{ data = thisPageData
, sharedData = sharedData
, action = actionDataOrNothing
, routeParams = ${
emptyRouteParams(name) ? "{}" : "routeParams"
}
, path = justPath.path
, submit = Pages.Fetcher.submit Route.${moduleName(
name
)}.w3_decode_ActionData
}
|> Tuple.mapBoth Model${pathNormalizedName(
name
@ -351,7 +393,7 @@ update sharedData pageData navigationKey msg model =
)
OnPageChange record ->
(init (Just model.global) Pages.Flags.PreRenderFlags sharedData pageData navigationKey <|
(init (Just model.global) Pages.Flags.PreRenderFlags sharedData pageData Nothing navigationKey <|
Just
{ path =
{ path = record.path
@ -414,11 +456,15 @@ update sharedData pageData navigationKey msg model =
pageUrl
{ data = thisPageData
, sharedData = sharedData
, action = Nothing
, routeParams = ${routeHelpers.referenceRouteParams(
name,
"routeParams"
)}
, path = justPage.path
, submit = Pages.Fetcher.submit Route.${moduleName(
name
)}.w3_decode_ActionData
}
msg_
pageModel
@ -476,7 +522,7 @@ templateSubscriptions route path model =
main : ${
phase === "browser"
? "Pages.Internal.Platform.Program Model Msg PageData Shared.Data ErrorPage"
? "Pages.Internal.Platform.Program Model Msg PageData ActionData Shared.Data ErrorPage"
: "Pages.Internal.Platform.Cli.Program (Maybe Route)"
}
main =
@ -515,6 +561,7 @@ config =
phase === "browser" ? "Sub.none" : "gotBatchSub identity"
}
, data = dataForRoute
, action = action
, sharedData = Shared.template.data
, apiRoutes = ${
phase === "browser"
@ -533,6 +580,7 @@ config =
, hotReloadData = hotReloadData identity
, encodeResponse = encodeResponse
, decodeResponse = decodeResponse
, encodeAction = encodeActionData
, cmdToEffect = Effect.fromCmd
, perform = Effect.perform
, errorStatusCode = ErrorPage.statusCode
@ -553,14 +601,14 @@ globalHeadTags =
|> DataSource.map List.concat
encodeResponse : ResponseSketch PageData Shared.Data -> Bytes.Encode.Encoder
encodeResponse : ResponseSketch PageData ActionData Shared.Data -> Bytes.Encode.Encoder
encodeResponse =
Pages.Internal.ResponseSketch.w3_encode_ResponseSketch w3_encode_PageData Shared.w3_encode_Data
Pages.Internal.ResponseSketch.w3_encode_ResponseSketch w3_encode_PageData w3_encode_ActionData Shared.w3_encode_Data
decodeResponse : Bytes.Decode.Decoder (ResponseSketch PageData Shared.Data)
decodeResponse : Bytes.Decode.Decoder (ResponseSketch PageData ActionData Shared.Data)
decodeResponse =
Pages.Internal.ResponseSketch.w3_decode_ResponseSketch w3_decode_PageData Shared.w3_decode_Data
Pages.Internal.ResponseSketch.w3_decode_ResponseSketch w3_decode_PageData w3_decode_ActionData Shared.w3_decode_Data
port hotReloadData : (Bytes -> msg) -> Sub msg
@ -584,6 +632,18 @@ ${templates
)
.join("\n")}
encodeActionData : ActionData -> Bytes.Encode.Encoder
encodeActionData actionData =
case actionData of
${templates
.map(
(name) => ` ActionData${pathNormalizedName(name)} thisActionData ->
Route.${name.join(".")}.w3_encode_ActionData thisActionData
`
)
.join("\n")}
port sendPageData : Pages.Internal.Platform.ToJsPayload.NewThingForPort -> Cmd msg
@ -607,6 +667,9 @@ ${templates
)
.join("\n")}
dataForRoute : Maybe Route -> DataSource (Server.Response.Response PageData ErrorPage)
dataForRoute route =
case route of
@ -633,6 +696,34 @@ dataForRoute route =
)
.join("\n ")}
action : Maybe Route -> DataSource (Server.Response.Response ActionData ErrorPage)
action route =
case route of
Nothing ->
DataSource.succeed ( Server.Response.plainText "TODO" )
${templates
.map(
(name) =>
`Just ${
emptyRouteParams(name)
? `Route.${routeHelpers.routeVariant(name)}`
: `(Route.${routeHelpers.routeVariant(name)} routeParams)`
} ->\n Route.${name.join(
"."
)}.route.action ${routeHelpers.referenceRouteParams(
name,
"routeParams"
)}
|> DataSource.map (Server.Response.map ActionData${routeHelpers.routeVariant(
name
)})
`
)
.join("\n ")}
handleRoute : Maybe Route -> DataSource (Maybe Pages.Internal.NotFoundReason.NotFoundReason)
handleRoute maybeRoute =
case maybeRoute of
@ -843,7 +934,7 @@ decodeBytes bytesDecoder items =
{-|
@docs Route, link, matchers, routeToPath, toLink, urlToRoute, toPath, redirectTo, toString
@docs Route, link, matchers, routeToPath, toLink, urlToRoute, toPath, redirectTo, toString, baseUrlAsPath
-}
@ -874,6 +965,7 @@ baseUrl =
"${basePath}"
{-| -}
baseUrlAsPath : List String
baseUrlAsPath =
baseUrl
@ -970,12 +1062,16 @@ link attributes children route =
route
{-| -}
redirectTo : Route -> Server.Response.Response data error
redirectTo route =
route
|> toString
|> Server.Response.temporaryRedirect
`,
fetcherModules: templates.map((name) => {
return [name, fetcherModule(name)];
}),
};
}
@ -1159,6 +1255,77 @@ function prefixThing(param) {
}
}
function fetcherModule(name) {
let moduleName = name.join(".");
// TODO need to account for splat routes/etc.
let modulePath = name.join("/");
let fetcherPath = routeHelpers
.parseRouteParamsWithStatic(name)
.map((param) => {
switch (param.kind) {
case "static": {
return param.name === "Index"
? `[]`
: `[ "${camelToKebab(param.name)}" ]`;
}
case "optional": {
return `Pages.Internal.Router.maybeToList params.${param.name}`;
}
case "required-splat": {
return `Pages.Internal.Router.nonEmptyToList params.${param.name}`;
}
case "dynamic": {
return `[ params.${param.name} ]`;
}
case "optional-splat": {
return `params.${param.name}`;
}
}
})
.join(", ");
return `module Fetcher.${moduleName} exposing (submit)
{-| -}
import Bytes exposing (Bytes)
import Bytes.Decode
import FormDecoder
import Http
import Pages.Fetcher
import Route.${moduleName}
submit :
(Result Http.Error Route.${moduleName}.ActionData -> msg)
->
{ fields : List ( String, String )
, headers : List ( String, String )
}
-> Pages.Fetcher.Fetcher msg
submit 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 = ("elm-pages-action-only", "true") :: options.headers
, url = ${
fetcherPath === ""
? 'Just "/content.dat"'
: `[ ${fetcherPath}, [ "content.dat" ] ] |> List.concat |> String.join "/" |> Just`
}
}
|> Pages.Fetcher.Fetcher
`;
}
/**
* @param {string[]} name
*/

69
src/Form.elm
View File

@ -14,6 +14,7 @@ module Form exposing
, withServerValidation
, withMax, withMin
, withStep
, getErrors
, hasErrors, rawValues, runClientValidations, withClientValidation, withRecoverableClientValidation
, FieldInfoSimple, FieldState, FinalFieldInfo, FormInfo, No, RawFieldState, TimeOfDay, Yes
, fieldStatusToString
@ -117,6 +118,8 @@ Steps
## Internals?
@docs getErrors
@docs hasErrors, rawValues, runClientValidations, withClientValidation, withRecoverableClientValidation
@docs FieldInfoSimple, FieldState, FinalFieldInfo, FormInfo, No, RawFieldState, TimeOfDay, Yes
@ -311,6 +314,18 @@ type alias Model =
}
{-| -}
getErrors : Model -> List ( String, String )
getErrors { fields } =
fields
|> Dict.toList
|> List.concatMap
(\( name, info ) ->
info.errors
|> List.map (Tuple.pair name)
)
{-| -}
type alias ServerUpdate =
Dict String (RawFieldState String)
@ -615,7 +630,7 @@ toInputRecord maybeToMsg formInfo name maybeValue info field =
, field.required |> Attr.required |> Just
, Maybe.map
(\toMsg ->
if field.type_ == "checkbox" then
if isOptional field then
Html.Events.onCheck
(\checkState ->
OnFieldInput
@ -728,7 +743,7 @@ toRadioInputRecord maybeToMsg formInfo name itemValue info field =
valueAttr : { a | type_ : String } -> Maybe String -> Maybe (Html.Attribute msg)
valueAttr field stringValue =
if field.type_ == "checkbox" then
if isOptional field then
if stringValue == Just "on" then
Attr.attribute "checked" "true" |> Just
@ -1541,6 +1556,11 @@ withFormUrl formUrl (Form fields decoder serverValidations modelToValue config)
Form fields decoder serverValidations modelToValue { config | url = Just formUrl }
isOptional : { a | type_ : String } -> Bool
isOptional field =
field.type_ == "checkbox" || field.type_ == "radio"
{-| -}
with : Field msg error value view constraints -> Form msg error (value -> form) view -> Form msg error form view
with (Field field) (Form fields decoder serverValidations modelToValue config) =
@ -1567,7 +1587,7 @@ with (Field field) (Form fields decoder serverValidations modelToValue config) =
(field.name
|> nonEmptyString
|> Maybe.map
((if field.type_ == "checkbox" then
((if isOptional field then
.optional
else
@ -1586,7 +1606,7 @@ with (Field field) (Form fields decoder serverValidations modelToValue config) =
|> nonEmptyString
-- TODO is checkbox the only one that should use optional?
|> Maybe.map
((if field.type_ == "checkbox" then
((if isOptional field then
.optional
else
@ -2060,7 +2080,7 @@ renderRequestParser ((Form _ decoder serverValidations modelToValue config) as f
Ok ( value, otherValidationErrors ) ->
if
otherValidationErrors
|> List.any
|> List.all
(\( _, entryErrors ) ->
entryErrors |> List.isEmpty
)
@ -2139,26 +2159,23 @@ submitHandlers :
-> (Model -> Result () decoded -> DataSource (Response data error))
-> Parser (DataSource (Response data error))
submitHandlers myForm toDataSource =
Request.oneOf
[ apiHandler myForm
, renderRequestParser myForm
|> Request.map
(\userOrErrors ->
userOrErrors
|> DataSource.andThen
(\result ->
case result of
Ok ( model, decoded ) ->
Ok decoded
|> toDataSource model
renderRequestParser myForm
|> Request.map
(\parsedResult ->
parsedResult
|> DataSource.andThen
(\result ->
case result of
Ok ( model, decoded ) ->
Ok decoded
|> toDataSource model
Err model ->
Err ()
|> toDataSource model
)
-- TODO allow customizing headers or status code, or not?
)
]
Err model ->
Err ()
|> toDataSource model
)
-- TODO allow customizing headers or status code, or not?
)
hasErrors_ : List ( String, RawFieldState error ) -> Bool
@ -2178,6 +2195,10 @@ hasErrors model =
entry.errors |> List.isEmpty |> not
)
model.fields
|| (model.formErrors
|> Dict.toList
|> List.any (\( _, errors ) -> errors |> List.isEmpty |> not)
)
{-| -}

58
src/Pages/Fetcher.elm Normal file
View File

@ -0,0 +1,58 @@
module Pages.Fetcher exposing (Fetcher(..), FetcherInfo, submit, map)
{-|
@docs Fetcher, FetcherInfo, submit, map
-}
import Bytes exposing (Bytes)
import Bytes.Decode
import Http
{-| -}
type Fetcher decoded
= Fetcher (FetcherInfo decoded)
{-| -}
type alias FetcherInfo decoded =
{ decoder : Result Http.Error Bytes -> decoded
, fields : List ( String, String )
, headers : List ( String, String )
, url : Maybe String
}
{-| -}
submit :
Bytes.Decode.Decoder decoded
-> { fields : List ( String, String ), headers : List ( String, String ) }
-> Fetcher (Result Http.Error decoded)
submit byteDecoder options =
Fetcher
{ decoder =
\bytesResult ->
bytesResult
|> Result.andThen
(\okBytes ->
okBytes
|> Bytes.Decode.decode byteDecoder
|> Result.fromMaybe (Http.BadBody "Couldn't decode bytes.")
)
, fields = options.fields
, headers = ( "elm-pages-action-only", "true" ) :: options.headers
, url = Nothing
}
{-| -}
map : (a -> b) -> Fetcher a -> Fetcher b
map mapFn (Fetcher fetcher) =
Fetcher
{ decoder = fetcher.decoder >> mapFn
, fields = fetcher.fields
, headers = fetcher.headers
, url = fetcher.url
}

239
src/Pages/Internal/Platform.elm
View File

@ -24,6 +24,7 @@ import Http
import Json.Decode as Decode
import Json.Encode
import Pages.ContentCache as ContentCache
import Pages.Fetcher
import Pages.Flags
import Pages.Internal.NotFoundReason exposing (NotFoundReason)
import Pages.Internal.ResponseSketch as ResponseSketch exposing (ResponseSketch)
@ -46,13 +47,13 @@ type Transition
{-| -}
type alias Program userModel userMsg pageData sharedData errorPage =
Platform.Program Flags (Model userModel pageData sharedData) (Msg userMsg pageData sharedData errorPage)
type alias Program userModel userMsg pageData actionData sharedData errorPage =
Platform.Program Flags (Model userModel pageData actionData sharedData) (Msg userMsg pageData actionData sharedData errorPage)
mainView :
ProgramConfig userMsg userModel route pageData sharedData effect (Msg userMsg pageData sharedData errorPage) errorPage
-> Model userModel pageData sharedData
ProgramConfig userMsg userModel route pageData actionData sharedData effect (Msg userMsg pageData actionData sharedData errorPage) errorPage
-> Model userModel pageData actionData sharedData
-> { title : String, body : Html userMsg }
mainView config model =
case model.notFound of
@ -76,6 +77,7 @@ mainView config model =
Nothing
pageData.sharedData
pageData.pageData
pageData.actionData
|> .view
)
pageData.userModel
@ -100,9 +102,9 @@ urlsToPagePath urls =
view :
ProgramConfig userMsg userModel route pageData sharedData effect (Msg userMsg pageData sharedData errorPage) errorPage
-> Model userModel pageData sharedData
-> Browser.Document (Msg userMsg pageData sharedData errorPage)
ProgramConfig userMsg userModel route pageData actionData sharedData effect (Msg userMsg pageData actionData sharedData errorPage) errorPage
-> Model userModel pageData actionData sharedData
-> Browser.Document (Msg userMsg pageData actionData sharedData errorPage)
view config model =
let
{ title, body } =
@ -135,21 +137,21 @@ type alias Flags =
Decode.Value
type InitKind shared page errorPage
= OkPage shared page
type InitKind shared page actionData errorPage
= OkPage shared page (Maybe actionData)
| NotFound { reason : NotFoundReason, path : Path }
{-| -}
init :
ProgramConfig userMsg userModel route pageData sharedData userEffect (Msg userMsg pageData sharedData errorPage) errorPage
ProgramConfig userMsg userModel route pageData actionData sharedData userEffect (Msg userMsg pageData actionData sharedData errorPage) errorPage
-> Flags
-> Url
-> Maybe Browser.Navigation.Key
-> ( Model userModel pageData sharedData, Effect userMsg pageData sharedData userEffect errorPage )
-> ( Model userModel pageData actionData sharedData, Effect userMsg pageData actionData sharedData userEffect errorPage )
init config flags url key =
let
pageDataResult : Result BuildError (InitKind sharedData pageData errorPage)
pageDataResult : Result BuildError (InitKind sharedData pageData actionData errorPage)
pageDataResult =
flags
|> Decode.decodeValue (Decode.field "pageDataBase64" Decode.string)
@ -163,11 +165,11 @@ init config flags url key =
config.decodeResponse
justBytes
of
Just (ResponseSketch.RenderPage _) ->
Just (ResponseSketch.RenderPage _ _) ->
Nothing
Just (ResponseSketch.HotUpdate pageData shared) ->
OkPage shared pageData
Just (ResponseSketch.HotUpdate pageData shared actionData) ->
OkPage shared pageData actionData
|> Just
Just (ResponseSketch.NotFound notFound) ->
@ -183,7 +185,7 @@ init config flags url key =
)
in
case pageDataResult of
Ok (OkPage sharedData pageData) ->
Ok (OkPage sharedData pageData actionData) ->
let
urls : { currentUrl : Url, basePath : List String }
urls =
@ -221,13 +223,13 @@ init config flags url key =
, fragment = url.fragment
}
}
|> config.init userFlags sharedData pageData key
|> config.init userFlags sharedData pageData actionData key
cmd : Effect userMsg pageData sharedData userEffect errorPage
cmd : Effect userMsg pageData actionData sharedData userEffect errorPage
cmd =
UserCmd userCmd
initialModel : Model userModel pageData sharedData
initialModel : Model userModel pageData actionData sharedData
initialModel =
{ key = key
, url = url
@ -236,6 +238,7 @@ init config flags url key =
{ pageData = pageData
, sharedData = sharedData
, userModel = userModel
, actionData = actionData
}
, ariaNavigationAnnouncement = ""
, userFlags = flags
@ -281,18 +284,19 @@ init config flags url key =
{-| -}
type Msg userMsg pageData sharedData errorPage
type Msg userMsg pageData actionData sharedData errorPage
= LinkClicked Browser.UrlRequest
| UrlChanged Url
| UserMsg userMsg
| UpdateCacheAndUrlNew Bool Url (Maybe userMsg) (Result Http.Error ( Url, ResponseSketch pageData sharedData ))
| 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 sharedData )) (Result Http.Error ( Url, ResponseSketch pageData sharedData ) -> Msg userMsg pageData sharedData errorPage)
| ProcessFetchResponse (Result Http.Error ( Url, ResponseSketch pageData actionData sharedData )) (Result Http.Error ( Url, ResponseSketch pageData actionData sharedData ) -> Msg userMsg pageData actionData sharedData errorPage)
{-| -}
type alias Model userModel pageData sharedData =
type alias Model userModel pageData actionData sharedData =
{ key : Maybe Browser.Navigation.Key
, url : Url
, ariaNavigationAnnouncement : String
@ -302,6 +306,7 @@ type alias Model userModel pageData sharedData =
{ userModel : userModel
, pageData : pageData
, sharedData : sharedData
, actionData : Maybe actionData
}
, notFound : Maybe { reason : NotFoundReason, path : Path }
, userFlags : Decode.Value
@ -310,23 +315,23 @@ type alias Model userModel pageData sharedData =
}
type Effect userMsg pageData sharedData userEffect errorPage
type Effect userMsg pageData actionData sharedData userEffect errorPage
= ScrollToTop
| NoEffect
| BrowserLoadUrl String
| BrowserPushUrl String
| FetchPageData Int (Maybe RequestInfo) Url (Result Http.Error ( Url, ResponseSketch pageData sharedData ) -> Msg userMsg pageData sharedData errorPage)
| Batch (List (Effect userMsg pageData sharedData userEffect errorPage))
| FetchPageData Int (Maybe RequestInfo) Url (Result Http.Error ( Url, ResponseSketch pageData actionData sharedData ) -> Msg userMsg pageData actionData sharedData errorPage)
| Batch (List (Effect userMsg pageData actionData sharedData userEffect errorPage))
| UserCmd userEffect
| CancelRequest Int
{-| -}
update :
ProgramConfig userMsg userModel route pageData sharedData userEffect (Msg userMsg pageData sharedData errorPage) errorPage
-> Msg userMsg pageData sharedData errorPage
-> Model userModel pageData sharedData
-> ( Model userModel pageData sharedData, Effect userMsg pageData sharedData userEffect errorPage )
ProgramConfig userMsg userModel route pageData actionData sharedData userEffect (Msg userMsg pageData actionData sharedData errorPage) errorPage
-> Msg userMsg pageData actionData sharedData errorPage
-> Model userModel pageData actionData sharedData
-> ( Model userModel pageData actionData sharedData, Effect userMsg pageData actionData sharedData userEffect errorPage )
update config appMsg model =
case appMsg of
LinkClicked urlRequest ->
@ -383,12 +388,13 @@ update config appMsg model =
, basePath = config.basePath
}
updatedPageData : Result String { userModel : userModel, sharedData : sharedData, pageData : pageData }
updatedPageData : Result String { userModel : userModel, sharedData : sharedData, pageData : pageData, actionData : Maybe actionData }
updatedPageData =
Ok
{ userModel = userModel
, sharedData = pageData.sharedData
, pageData = pageData.pageData
, actionData = pageData.actionData
}
( userModel, _ ) =
@ -423,6 +429,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 ) ->
@ -433,22 +451,8 @@ update config appMsg model =
update config (toMsg response) model
UserMsg userMsg ->
case model.pageData of
Ok pageData ->
let
( userModel, userCmd ) =
config.update pageData.sharedData pageData.pageData model.key userMsg pageData.userModel
updatedPageData : Result error { userModel : userModel, pageData : pageData, sharedData : sharedData }
updatedPageData =
Ok { pageData | userModel = userModel }
in
( { model | pageData = updatedPageData }
, UserCmd userCmd
)
Err _ ->
( model, NoEffect )
( model, NoEffect )
|> performUserMsg userMsg config
UpdateCacheAndUrlNew fromLinkClick urlWithoutRedirectResolution maybeUserMsg updateResult ->
case
@ -460,43 +464,26 @@ update config appMsg model =
of
Ok ( ( newUrl, newData ), previousPageData ) ->
let
( newPageData, newSharedData ) =
( newPageData, newSharedData, newActionData ) =
case newData of
ResponseSketch.RenderPage pageData ->
( pageData, previousPageData.sharedData )
ResponseSketch.RenderPage pageData actionData ->
( pageData, previousPageData.sharedData, actionData )
ResponseSketch.HotUpdate pageData sharedData ->
( pageData, sharedData )
ResponseSketch.HotUpdate pageData sharedData actionData ->
( pageData, sharedData, actionData )
_ ->
( previousPageData.pageData, previousPageData.sharedData )
( previousPageData.pageData, previousPageData.sharedData, previousPageData.actionData )
updatedPageData : { userModel : userModel, sharedData : sharedData, pageData : pageData }
updatedPageData : { userModel : userModel, sharedData : sharedData, actionData : Maybe actionData, pageData : pageData }
updatedPageData =
{ userModel = userModel
{ userModel = previousPageData.userModel
, sharedData = newSharedData
, pageData = newPageData
, actionData = newActionData
}
( userModel, userCmd ) =
-- TODO call update on new Model for ErrorPage
config.update
newSharedData
newPageData
model.key
(config.onPageChange
{ protocol = model.url.protocol
, host = model.url.host
, port_ = model.url.port_
, path = newUrl |> urlPathToPath
, query = newUrl.query
, fragment = newUrl.fragment
, metadata = config.urlToRoute newUrl
}
)
previousPageData.userModel
updatedModel : Model userModel pageData sharedData
updatedModel : Model userModel pageData actionData sharedData
updatedModel =
{ model
| url = newUrl
@ -509,8 +496,7 @@ update config appMsg model =
| ariaNavigationAnnouncement = mainView config updatedModel |> .title
}
, Batch
[ UserCmd userCmd
, ScrollToTop
[ ScrollToTop
, if fromLinkClick || urlWithoutRedirectResolution.path /= newUrl.path then
BrowserPushUrl newUrl.path
@ -525,8 +511,7 @@ update config appMsg model =
| ariaNavigationAnnouncement = mainView config updatedModel |> .title
}
, Batch
[ UserCmd userCmd
, ScrollToTop
[ ScrollToTop
, if fromLinkClick || urlWithoutRedirectResolution.path /= newUrl.path then
BrowserPushUrl newUrl.path
@ -563,33 +548,35 @@ update config appMsg model =
|> Result.map
(\pageData ->
let
newThing : Maybe (ResponseSketch pageData sharedData)
newThing : Maybe (ResponseSketch pageData actionData sharedData)
newThing =
-- TODO if ErrorPage, call ErrorPage.init to get appropriate Model?
pageDataBytes
|> Bytes.Decode.decode config.decodeResponse
in
case newThing of
Just (ResponseSketch.RenderPage newPageData) ->
Just (ResponseSketch.RenderPage newPageData newActionData) ->
( { model
| pageData =
Ok
{ userModel = pageData.userModel
, sharedData = pageData.sharedData
, pageData = newPageData
, actionData = newActionData
}
, notFound = Nothing
}
, NoEffect
)
Just (ResponseSketch.HotUpdate newPageData newSharedData) ->
Just (ResponseSketch.HotUpdate newPageData newSharedData newActionData) ->
( { model
| pageData =
Ok
{ userModel = pageData.userModel
, sharedData = newSharedData
, pageData = newPageData
, actionData = newActionData
}
, notFound = Nothing
}
@ -605,7 +592,31 @@ update config appMsg model =
|> Result.withDefault ( model, NoEffect )
perform : ProgramConfig userMsg userModel route pageData sharedData userEffect (Msg userMsg pageData sharedData errorPage) errorPage -> Url -> Maybe Browser.Navigation.Key -> Effect userMsg pageData sharedData userEffect errorPage -> Cmd (Msg userMsg pageData sharedData errorPage)
performUserMsg :
userMsg
-> ProgramConfig userMsg userModel route pageData actionData sharedData userEffect (Msg userMsg pageData actionData sharedData errorPage) errorPage
-> ( Model userModel pageData actionData sharedData, Effect userMsg pageData actionData sharedData userEffect errorPage )
-> ( Model userModel pageData actionData sharedData, Effect userMsg pageData actionData sharedData userEffect errorPage )
performUserMsg userMsg config ( model, effect ) =
case model.pageData of
Ok pageData ->
let
( userModel, userCmd ) =
config.update pageData.sharedData pageData.pageData model.key userMsg pageData.userModel
updatedPageData : Result error { userModel : userModel, pageData : pageData, actionData : Maybe actionData, sharedData : sharedData }
updatedPageData =
Ok { pageData | userModel = userModel }
in
( { model | pageData = updatedPageData }
, Batch [ effect, UserCmd userCmd ]
)
Err _ ->
( model, effect )
perform : ProgramConfig userMsg userModel route pageData actionData sharedData userEffect (Msg userMsg pageData actionData sharedData errorPage) errorPage -> Url -> Maybe Browser.Navigation.Key -> Effect userMsg pageData actionData sharedData userEffect errorPage -> Cmd (Msg userMsg pageData actionData sharedData errorPage)
perform config currentUrl maybeKey effect =
-- elm-review: known-unoptimized-recursion
case effect of
@ -640,8 +651,8 @@ perform config currentUrl maybeKey effect =
let
prepare :
(Result Http.Error Url -> userMsg)
-> Result Http.Error ( Url, ResponseSketch pageData sharedData )
-> Msg userMsg pageData sharedData errorPage
-> Result Http.Error ( Url, ResponseSketch pageData actionData sharedData )
-> Msg userMsg pageData actionData sharedData errorPage
prepare toMsg info =
UpdateCacheAndUrlNew True currentUrl (info |> Result.map Tuple.first |> toMsg |> Just) info
in
@ -670,6 +681,32 @@ perform config currentUrl maybeKey effect =
currentUrl
in
fetchRouteData -1 (prepare fetchInfo.toMsg) config urlToSubmitTo (Just (FormDecoder.encodeFormData fetchInfo.values))
, runFetcher =
\(Pages.Fetcher.Fetcher 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 |> Maybe.withDefault (Path.join [ currentUrl.path, "content.dat" ] |> Path.toAbsolute)
, method = "POST"
, timeout = Nothing
}
, fromPageMsg = UserMsg
, key = key
}
@ -683,8 +720,8 @@ perform config currentUrl maybeKey effect =
{-| -}
application :
ProgramConfig userMsg userModel route pageData sharedData effect (Msg userMsg pageData sharedData errorPage) errorPage
-> Platform.Program Flags (Model userModel pageData sharedData) (Msg userMsg pageData sharedData errorPage)
ProgramConfig userMsg userModel route pageData actionData sharedData effect (Msg userMsg pageData actionData sharedData errorPage) errorPage
-> Platform.Program Flags (Model userModel pageData actionData sharedData) (Msg userMsg pageData actionData sharedData errorPage)
application config =
Browser.application
{ init =
@ -728,10 +765,10 @@ type alias RequestInfo =
withUserMsg :
ProgramConfig userMsg userModel route pageData sharedData userEffect (Msg userMsg pageData sharedData errorPage) errorPage
ProgramConfig userMsg userModel route pageData actionData sharedData userEffect (Msg userMsg pageData actionData sharedData errorPage) errorPage
-> userMsg
-> ( Model userModel pageData sharedData, Effect userMsg pageData sharedData userEffect errorPage )
-> ( Model userModel pageData sharedData, Effect userMsg pageData sharedData userEffect errorPage )
-> ( Model userModel pageData actionData sharedData, Effect userMsg pageData actionData sharedData userEffect errorPage )
-> ( Model userModel pageData actionData sharedData, Effect userMsg pageData actionData sharedData userEffect errorPage )
withUserMsg config userMsg ( model, effect ) =
case model.pageData of
Ok pageData ->
@ -739,7 +776,7 @@ withUserMsg config userMsg ( model, effect ) =
( userModel, userCmd ) =
config.update pageData.sharedData pageData.pageData model.key userMsg pageData.userModel
updatedPageData : Result error { userModel : userModel, pageData : pageData, sharedData : sharedData }
updatedPageData : Result error { userModel : userModel, pageData : pageData, actionData : Maybe actionData, sharedData : sharedData }
updatedPageData =
Ok { pageData | userModel = userModel }
in
@ -761,11 +798,11 @@ urlPathToPath urls =
fetchRouteData :
Int
-> (Result Http.Error ( Url, ResponseSketch pageData sharedData ) -> Msg userMsg pageData sharedData errorPage)
-> ProgramConfig userMsg userModel route pageData sharedData effect (Msg userMsg pageData sharedData errorPage) errorPage
-> (Result Http.Error ( Url, ResponseSketch pageData actionData sharedData ) -> Msg userMsg pageData actionData sharedData errorPage)
-> ProgramConfig userMsg userModel route pageData actionData sharedData effect (Msg userMsg pageData actionData sharedData errorPage) errorPage
-> Url
-> Maybe { contentType : String, body : String }
-> Cmd (Msg userMsg pageData sharedData errorPage)
-> Cmd (Msg userMsg pageData actionData sharedData errorPage)
fetchRouteData transitionKey toMsg config url details =
{-
TODO:
@ -804,8 +841,12 @@ fetchRouteData transitionKey toMsg config url details =
Http.NetworkError_ ->
Err Http.NetworkError
Http.BadStatus_ metadata _ ->
Err (Http.BadStatus metadata.statusCode)
Http.BadStatus_ metadata body ->
body
|> Bytes.Decode.decode config.decodeResponse
|> Result.fromMaybe "Decoding error"
|> Result.mapError Http.BadBody
|> Result.map (\okResponse -> ( url, okResponse ))
Http.GoodStatus_ _ body ->
body
@ -844,16 +885,16 @@ chopEnd needle string =
startNewGetLoad :
String
-> (Result Http.Error ( Url, ResponseSketch pageData sharedData ) -> Msg userMsg pageData sharedData errorPage)
-> ( Model userModel pageData sharedData, Effect userMsg pageData sharedData userEffect errorPage )
-> ( Model userModel pageData sharedData, Effect userMsg pageData sharedData userEffect errorPage )
-> (Result Http.Error ( Url, ResponseSketch pageData actionData sharedData ) -> Msg userMsg pageData actionData sharedData errorPage)
-> ( Model userModel pageData actionData sharedData, Effect userMsg pageData actionData sharedData userEffect errorPage )
-> ( Model userModel pageData actionData sharedData, Effect userMsg pageData actionData sharedData userEffect errorPage )
startNewGetLoad pathToGet toMsg ( model, effect ) =
let
currentUrl : Url
currentUrl =
model.url
cancelIfStale : Effect userMsg pageData sharedData userEffect errorPage
cancelIfStale : Effect userMsg pageData actionData sharedData userEffect errorPage
cancelIfStale =
case model.transition of
Just (Loading transitionKey path) ->

233
src/Pages/Internal/Platform/Cli.elm
View File

@ -76,7 +76,7 @@ type alias Program route =
{-| -}
cliApplication :
ProgramConfig userMsg userModel (Maybe route) pageData sharedData effect mappedMsg errorPage
ProgramConfig userMsg userModel (Maybe route) pageData actionData sharedData effect mappedMsg errorPage
-> Program (Maybe route)
cliApplication config =
let
@ -84,7 +84,7 @@ cliApplication config =
site =
getSiteConfig config
getSiteConfig : ProgramConfig userMsg userModel (Maybe route) pageData sharedData effect mappedMsg errorPage -> SiteConfig
getSiteConfig : ProgramConfig userMsg userModel (Maybe route) pageData actionData sharedData effect mappedMsg errorPage -> SiteConfig
getSiteConfig fullConfig =
case fullConfig.site of
Just mySite ->
@ -199,12 +199,12 @@ requestDecoder =
|> Codec.decoder
flatten : SiteConfig -> RenderRequest route -> ProgramConfig userMsg userModel route pageData sharedData effect mappedMsg errorPage -> List Effect -> Cmd Msg
flatten : SiteConfig -> RenderRequest route -> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage -> List Effect -> Cmd Msg
flatten site renderRequest config list =
Cmd.batch (flattenHelp [] site renderRequest config list)
flattenHelp : List (Cmd Msg) -> SiteConfig -> RenderRequest route -> ProgramConfig userMsg userModel route pageData sharedData effect mappedMsg errorPage -> List Effect -> List (Cmd Msg)
flattenHelp : List (Cmd Msg) -> SiteConfig -> RenderRequest route -> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage -> List Effect -> List (Cmd Msg)
flattenHelp soFar site renderRequest config list =
case list of
first :: rest ->
@ -222,7 +222,7 @@ flattenHelp soFar site renderRequest config list =
perform :
SiteConfig
-> RenderRequest route
-> ProgramConfig userMsg userModel route pageData sharedData effect mappedMsg errorPage
-> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
-> Effect
-> Cmd Msg
perform site renderRequest config effect =
@ -361,7 +361,7 @@ flagsDecoder =
init :
SiteConfig
-> RenderRequest route
-> ProgramConfig userMsg userModel route pageData sharedData effect mappedMsg errorPage
-> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
-> Decode.Value
-> ( Model route, Effect )
init site renderRequest config flags =
@ -388,14 +388,60 @@ init site renderRequest config flags =
}
type ActionRequest
= ActionResponseRequest
| ActionOnlyRequest
isActionDecoder : Decode.Decoder (Maybe ActionRequest)
isActionDecoder =
Decode.map2 Tuple.pair
(Decode.field "method" Decode.string)
(Decode.field "headers" (Decode.dict Decode.string))
|> Decode.map
(\( method, headers ) ->
let
actionOnly : Bool
actionOnly =
case headers |> Dict.get "elm-pages-action-only" of
Just _ ->
True
Nothing ->
False
in
case method |> String.toUpper of
"GET" ->
Nothing
"OPTIONS" ->
Nothing
_ ->
Just
(if actionOnly then
ActionOnlyRequest
else
ActionResponseRequest
)
)
initLegacy :
SiteConfig
-> RenderRequest route
-> { staticHttpCache : RequestsAndPending, isDevServer : Bool }
-> ProgramConfig userMsg userModel route pageData sharedData effect mappedMsg errorPage
-> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
-> ( Model route, Effect )
initLegacy site renderRequest { staticHttpCache, isDevServer } config =
let
isAction : Maybe ActionRequest
isAction =
renderRequest
|> RenderRequest.maybeRequestPayload
|> Maybe.andThen (Decode.decodeValue isActionDecoder >> Result.withDefault Nothing)
staticResponses : StaticResponses
staticResponses =
case renderRequest of
@ -403,10 +449,32 @@ initLegacy site renderRequest { staticHttpCache, isDevServer } config =
case singleRequest of
RenderRequest.Page serverRequestPayload ->
StaticResponses.renderSingleRoute
(DataSource.map3 (\_ _ _ -> ())
(config.data serverRequestPayload.frontmatter)
config.sharedData
(config.globalHeadTags |> Maybe.withDefault (DataSource.succeed []))
(case isAction of
Just _ ->
config.action serverRequestPayload.frontmatter
|> DataSource.andThen
(\something ->
case something of
PageServerResponse.ErrorPage _ _ ->
DataSource.succeed something
|> DataSource.map (\_ -> ())
PageServerResponse.RenderPage _ actionData ->
DataSource.map3 (\_ _ _ -> ())
(config.data serverRequestPayload.frontmatter)
config.sharedData
(config.globalHeadTags |> Maybe.withDefault (DataSource.succeed []))
PageServerResponse.ServerResponse _ ->
DataSource.succeed something
|> DataSource.map (\_ -> ())
)
Nothing ->
DataSource.map3 (\_ _ _ -> ())
(config.data serverRequestPayload.frontmatter)
config.sharedData
(config.globalHeadTags |> Maybe.withDefault (DataSource.succeed []))
)
(if isDevServer then
config.handleRoute serverRequestPayload.frontmatter
@ -461,7 +529,7 @@ initLegacy site renderRequest { staticHttpCache, isDevServer } config =
updateAndSendPortIfDone :
SiteConfig
-> ProgramConfig userMsg userModel route pageData sharedData effect mappedMsg errorPage
-> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
-> Model route
-> ( Model route, Effect )
updateAndSendPortIfDone site config model =
@ -474,7 +542,7 @@ updateAndSendPortIfDone site config model =
{-| -}
update :
SiteConfig
-> ProgramConfig userMsg userModel route pageData sharedData effect mappedMsg errorPage
-> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
-> Msg
-> Model route
-> ( Model route, Effect )
@ -520,7 +588,7 @@ update site config msg model =
nextStepToEffect :
SiteConfig
-> ProgramConfig userMsg userModel route pageData sharedData effect mappedMsg errorPage
-> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
-> Model route
-> ( StaticResponses, StaticResponses.NextStep route )
-> ( Model route, Effect )
@ -578,6 +646,7 @@ nextStepToEffect site config model ( updatedStaticResponsesModel, nextStep ) =
config.sharedData
model.allRawResponses
|> Result.mapError (StaticHttpRequest.toBuildError "")
|> Debug.log "@@@sharedData"
apiResponse : Effect
apiResponse =
@ -666,7 +735,7 @@ nextStepToEffect site config model ( updatedStaticResponsesModel, nextStep ) =
sendSinglePageProgress :
SiteConfig
-> RequestsAndPending
-> ProgramConfig userMsg userModel route pageData sharedData effect mappedMsg errorPage
-> ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
-> Model route
-> { path : Path, frontmatter : route }
-> Effect
@ -674,6 +743,12 @@ sendSinglePageProgress site contentJson config model info =
let
( page, route ) =
( info.path, info.frontmatter )
isAction : Maybe ActionRequest
isAction =
model.maybeRequestJson
|> RenderRequest.maybeRequestPayload
|> Maybe.andThen (Decode.decodeValue isActionDecoder >> Result.withDefault Nothing)
in
case model.maybeRequestJson of
RenderRequest.SinglePage includeHtml _ _ ->
@ -696,6 +771,7 @@ sendSinglePageProgress site contentJson config model info =
case includeHtml of
RenderRequest.OnlyJson ->
pageDataResult
|> Debug.log "pageDataResult"
|> Result.map
(\okPageData ->
case okPageData of
@ -717,6 +793,21 @@ sendSinglePageProgress site contentJson config model info =
)
RenderRequest.HtmlAndJson ->
let
maybeActionData : Maybe actionData
maybeActionData =
case isAction of
Just actionRequest ->
case actionDataResult of
Ok (PageServerResponse.RenderPage _ actionData) ->
Just actionData
_ ->
Nothing
Nothing ->
Nothing
in
Result.map2 Tuple.pair pageDataResult sharedDataResult
|> Result.map
(\( pageData_, sharedData ) ->
@ -733,6 +824,7 @@ sendSinglePageProgress site contentJson config model info =
Pages.Flags.PreRenderFlags
sharedData
pageData
maybeActionData
Nothing
(Just
{ path =
@ -748,10 +840,10 @@ sendSinglePageProgress site contentJson config model info =
viewValue : { title : String, body : Html userMsg }
viewValue =
(config.view currentPage Nothing sharedData pageData |> .view) pageModel
(config.view currentPage Nothing sharedData pageData Nothing |> .view) pageModel
in
PageServerResponse.RenderPage responseInfo
{ head = config.view currentPage Nothing sharedData pageData |> .head
{ head = config.view currentPage Nothing sharedData pageData Nothing |> .head
, view = viewValue.body |> HtmlPrinter.htmlToString
, title = viewValue.title
}
@ -772,6 +864,7 @@ sendSinglePageProgress site contentJson config model info =
sharedData
pageData
Nothing
Nothing
(Just
{ path =
{ path = currentPage.path
@ -790,18 +883,19 @@ sendSinglePageProgress site contentJson config model info =
viewValue : { title : String, body : Html userMsg }
viewValue =
(config.view currentPage Nothing sharedData pageData |> .view) pageModel
(config.view currentPage Nothing sharedData pageData Nothing |> .view) pageModel
in
PageServerResponse.RenderPage
{ statusCode = config.errorStatusCode error
, headers = record.headers
}
{ head = config.view currentPage Nothing sharedData pageData |> .head
{ head = config.view currentPage Nothing sharedData pageData Nothing |> .head
, view = viewValue.body |> HtmlPrinter.htmlToString
, title = viewValue.title
}
)
--Debug.todo ""
currentUrl : Url
currentUrl =
{ protocol = Url.Https
@ -816,7 +910,38 @@ sendSinglePageProgress site contentJson config model info =
pageDataResult =
-- TODO OPTIMIZATION can these three be included in StaticResponses.Finish?
StaticHttpRequest.resolve
(config.data (urlToRoute config currentUrl))
(case isAction of
Just _ ->
config.action (urlToRoute config currentUrl)
|> DataSource.andThen
(\something ->
case something of
PageServerResponse.ErrorPage a b ->
PageServerResponse.ErrorPage a b
|> DataSource.succeed
PageServerResponse.RenderPage responseDetails actionData ->
-- TODO the headers/response codes are ignored from the action here
-- is that okay? Should you always do a redirect or another kind of
-- server response if you want to control the headers/response code for an action (like logout & redirect, for example)?
config.data (urlToRoute config currentUrl)
PageServerResponse.ServerResponse a ->
PageServerResponse.ServerResponse a
|> DataSource.succeed
)
Nothing ->
config.data (urlToRoute config currentUrl)
)
contentJson
|> Result.mapError (StaticHttpRequest.toBuildError currentUrl.path)
actionDataResult : Result BuildError (PageServerResponse actionData errorPage)
actionDataResult =
-- TODO OPTIMIZATION can these three be included in StaticResponses.Finish?
StaticHttpRequest.resolve
(config.action (urlToRoute config currentUrl))
contentJson
|> Result.mapError (StaticHttpRequest.toBuildError currentUrl.path)
@ -848,19 +973,39 @@ sendSinglePageProgress site contentJson config model info =
-- TODO want to encode both shared and page data in dev server and HTML-embedded data
-- but not for writing out the content.dat files - would be good to optimize this redundant data out
--if model.isDevServer then
if True then
sharedDataResult
|> Result.map (ResponseSketch.HotUpdate pageData)
|> Result.withDefault (ResponseSketch.RenderPage pageData)
|> config.encodeResponse
|> Bytes.Encode.encode
case isAction of
Just actionRequestKind ->
case actionDataResult of
Ok (PageServerResponse.RenderPage _ actionData) ->
case actionRequestKind of
ActionResponseRequest ->
sharedDataResult
|> Result.map (\sharedData -> ResponseSketch.HotUpdate pageData sharedData (Just actionData))
|> Result.withDefault (ResponseSketch.RenderPage pageData (Just actionData))
|> config.encodeResponse
|> Bytes.Encode.encode
else
pageData
|> ResponseSketch.RenderPage
|> config.encodeResponse
|> Bytes.Encode.encode
ActionOnlyRequest ->
---- TODO need to encode action data when only that is requested (not ResponseSketch?)
actionData
|> config.encodeAction
|> Bytes.Encode.encode
_ ->
Bytes.Encode.encode (Bytes.Encode.unsignedInt8 0)
Nothing ->
sharedDataResult
|> Result.map (\something -> ResponseSketch.HotUpdate pageData something Nothing)
|> Result.withDefault (ResponseSketch.RenderPage pageData Nothing)
|> config.encodeResponse
|> Bytes.Encode.encode
--else
-- pageData
-- |> ResponseSketch.RenderPage
-- |> config.encodeResponse
-- |> Bytes.Encode.encode
PageServerResponse.ServerResponse serverResponse ->
-- TODO handle error?
PageServerResponse.toRedirect serverResponse
@ -877,7 +1022,12 @@ sendSinglePageProgress site contentJson config model info =
PageServerResponse.ErrorPage error record ->
-- TODO this case should never happen
sharedDataResult
|> Result.map (ResponseSketch.HotUpdate (config.errorPageToData error))
|> Result.map
(\sharedData ->
ResponseSketch.HotUpdate (config.errorPageToData error)
sharedData
Nothing
)
|> Result.map config.encodeResponse
|> Result.map Bytes.Encode.encode
|> Result.withDefault (Bytes.Encode.encode (Bytes.Encode.unsignedInt8 0))
@ -962,7 +1112,7 @@ sendSinglePageProgress site contentJson config model info =
render404Page :
ProgramConfig userMsg userModel route pageData sharedData effect mappedMsg errorPage
ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage
-> Maybe sharedData
-> Model route
-> Path
@ -974,8 +1124,11 @@ render404Page config sharedData model path notFoundReason =
let
byteEncodedPageData : Bytes
byteEncodedPageData =
justSharedData
|> ResponseSketch.HotUpdate (config.errorPageToData config.notFoundPage)
ResponseSketch.HotUpdate
(config.errorPageToData config.notFoundPage)
justSharedData
-- TODO remove shared action data
Nothing
|> config.encodeResponse
|> Bytes.Encode.encode
@ -987,6 +1140,7 @@ render404Page config sharedData model path notFoundReason =
pageData
Nothing
Nothing
Nothing
|> Tuple.first
pageData : pageData
@ -1003,6 +1157,7 @@ render404Page config sharedData model path notFoundReason =
Nothing
justSharedData
pageData
Nothing
|> .view
)
pageModel
@ -1011,7 +1166,7 @@ render404Page config sharedData model path notFoundReason =
, contentJson = Dict.empty
, html = viewValue.body |> HtmlPrinter.htmlToString
, errors = []
, head = config.view pathAndRoute Nothing justSharedData pageData |> .head
, head = config.view pathAndRoute Nothing justSharedData pageData Nothing |> .head
, title = viewValue.title
, staticHttpCache = Dict.empty
, is404 = True
@ -1054,10 +1209,14 @@ render404Page config sharedData model path notFoundReason =
|> Effect.SendSinglePageNew byteEncodedPageData
urlToRoute : ProgramConfig userMsg userModel route pageData sharedData effect mappedMsg errorPage -> Url -> route
urlToRoute : ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage -> Url -> route
urlToRoute config url =
if url.path |> String.startsWith "/____elm-pages-internal____" then
config.notFoundRoute
else
config.urlToRoute url
triple a b c =
( a, b, c )

8
src/Pages/Internal/ResponseSketch.elm
View File

@ -1,11 +1,13 @@
module Pages.Internal.ResponseSketch exposing (ResponseSketch(..))
import Bytes exposing (Bytes)
import Pages.Internal.NotFoundReason exposing (NotFoundReason)
import Path exposing (Path)
type ResponseSketch data shared
= RenderPage data
| HotUpdate data shared
type ResponseSketch data action shared
= RenderPage data (Maybe action)
| HotUpdate data shared (Maybe action)
| Redirect String
| NotFound { reason : NotFoundReason, path : Path }
| Action action

13
src/Pages/ProgramConfig.elm
View File

@ -12,6 +12,7 @@ import Http
import Json.Decode as Decode
import Json.Encode
import PageServerResponse exposing (PageServerResponse)
import Pages.Fetcher
import Pages.Flags
import Pages.Internal.NotFoundReason exposing (NotFoundReason)
import Pages.Internal.Platform.ToJsPayload
@ -20,15 +21,15 @@ import Pages.Internal.RoutePattern exposing (RoutePattern)
import Pages.PageUrl exposing (PageUrl)
import Pages.SiteConfig exposing (SiteConfig)
import Path exposing (Path)
import Task exposing (Task)
import Url exposing (Url)
type alias ProgramConfig userMsg userModel route pageData sharedData effect mappedMsg errorPage =
type alias ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage =
{ init :
Pages.Flags.Flags
-> sharedData
-> pageData
-> Maybe actionData
-> Maybe Browser.Navigation.Key
->
Maybe
@ -45,6 +46,7 @@ type alias ProgramConfig userMsg userModel route pageData sharedData effect mapp
, subscriptions : route -> Path -> userModel -> Sub userMsg
, sharedData : DataSource sharedData
, data : route -> DataSource (PageServerResponse pageData errorPage)
, action : route -> DataSource (PageServerResponse actionData errorPage)
, view :
{ path : Path
, route : route
@ -52,6 +54,7 @@ type alias ProgramConfig userMsg userModel route pageData sharedData effect mapp
-> Maybe PageUrl
-> sharedData
-> pageData
-> Maybe actionData
->
{ view : userModel -> { title : String, body : Html userMsg }
, head : List Head.Tag
@ -83,8 +86,9 @@ type alias ProgramConfig userMsg userModel route pageData sharedData effect mapp
, sendPageData : Pages.Internal.Platform.ToJsPayload.NewThingForPort -> Cmd Never
, byteEncodePageData : pageData -> Bytes.Encode.Encoder
, byteDecodePageData : route -> Bytes.Decode.Decoder pageData
, encodeResponse : ResponseSketch pageData sharedData -> Bytes.Encode.Encoder
, decodeResponse : Bytes.Decode.Decoder (ResponseSketch pageData sharedData)
, encodeResponse : ResponseSketch pageData actionData sharedData -> Bytes.Encode.Encoder
, encodeAction : actionData -> Bytes.Encode.Encoder
, decodeResponse : Bytes.Decode.Decoder (ResponseSketch pageData actionData sharedData)
, globalHeadTags : Maybe (DataSource (List Head.Tag))
, cmdToEffect : Cmd userMsg -> effect
, perform :
@ -103,6 +107,7 @@ type alias ProgramConfig userMsg userModel route pageData sharedData effect mapp
}
-> Cmd mappedMsg
, fromPageMsg : userMsg -> mappedMsg
, runFetcher : Pages.Fetcher.Fetcher userMsg -> Cmd mappedMsg
, key : Browser.Navigation.Key
}
-> effect

3
src/Pages/Review/NoContractViolations.elm
View File

@ -146,7 +146,7 @@ moduleDefinitionVisitor node context =
Exposing.Explicit exposedValues ->
case context.isRouteModule of
Just RouteModule ->
case Set.diff (Set.fromList [ "Data", "Msg", "Model", "route" ]) (exposedNames exposedValues) |> Set.toList of
case Set.diff (Set.fromList [ "ActionData", "Data", "Msg", "Model", "route" ]) (exposedNames exposedValues) |> Set.toList of
[] ->
( [], context )
@ -158,6 +158,7 @@ moduleDefinitionVisitor node context =
- route
- Data
- ActionData
- Model
- Msg

4
src/RenderRequest.elm
View File

@ -49,7 +49,7 @@ type IncludeHtml
decoder :
ProgramConfig userMsg userModel (Maybe route) pageData sharedData effect mappedMsg errorPage
ProgramConfig userMsg userModel (Maybe route) pageData actionData sharedData effect mappedMsg errorPage
-> Decode.Decoder (RenderRequest (Maybe route))
decoder config =
Decode.field "request"
@ -90,7 +90,7 @@ decoder config =
requestPayloadDecoder :
ProgramConfig userMsg userModel (Maybe route) pageData sharedData effect mappedMsg errorPage
ProgramConfig userMsg userModel (Maybe route) pageData actionData sharedData effect mappedMsg errorPage
-> Decode.Decoder (RequestPayload (Maybe route))
requestPayloadDecoder config =
(Decode.string

16
tests/FormTests.elm
View File

@ -97,7 +97,7 @@ all =
|> Form.withClientValidation (\_ -> Err "This error always occurs")
)
|> Form.init
|> Form.hasErrors2
|> Form.hasErrors
|> Expect.true "expected errors"
, test "dependent validations" <|
\() ->
@ -296,7 +296,7 @@ all =
]
expectDecodeNoErrors2 : List ( String, String ) -> decoded -> Form.Form String decoded view -> Expect.Expectation
expectDecodeNoErrors2 : List ( String, String ) -> decoded -> Form.Form () String decoded view -> Expect.Expectation
expectDecodeNoErrors2 updates expected form =
let
formModel =
@ -315,10 +315,10 @@ expectDecodeNoErrors decoded actual =
|> Expect.equal (Ok ( decoded, [] ))
updateField : Form.Form String value view -> ( String, String ) -> Form.Model -> Form.Model
updateField : Form.Form () String value view -> ( String, String ) -> Form.Model -> Form.Model
updateField form ( name, value ) model =
model
|> Form.update (\_ -> ()) (\_ -> ()) form (Form.OnFieldInput { name = name, value = value })
|> Form.update (\_ -> ()) () (\_ -> ()) form (Form.OnFieldInput { name = name, value = value })
|> Tuple.first
@ -336,7 +336,7 @@ expectErrors expected form =
|> Expect.equalDicts (Dict.fromList expected)
updateAllFields : List String -> Form.Form String value view -> Form.Model -> Form.Model
updateAllFields : List String -> Form.Form () String value view -> Form.Model -> Form.Model
updateAllFields fields form model =
fields
|> List.foldl
@ -347,7 +347,7 @@ updateAllFields fields form model =
model
updateFieldsWithValues : List ( String, String ) -> Form.Form String value view -> Form.Model -> Form.Model
updateFieldsWithValues : List ( String, String ) -> Form.Form () String value view -> Form.Model -> Form.Model
updateFieldsWithValues fields form model =
fields
|> List.foldl
@ -358,7 +358,7 @@ updateFieldsWithValues fields form model =
model
expectErrorsAfterUpdates : List ( String, List String ) -> Form.Form String value view -> Expect.Expectation
expectErrorsAfterUpdates : List ( String, List String ) -> Form.Form () String value view -> Expect.Expectation
expectErrorsAfterUpdates expected form =
let
fieldsToUpdate : List String
@ -383,7 +383,7 @@ expectErrorsAfterUpdates expected form =
()
performUpdatesThenExpectErrors : List ( String, String ) -> List ( String, List String ) -> Form.Form String value view -> Expect.Expectation
performUpdatesThenExpectErrors : List ( String, String ) -> List ( String, List String ) -> Form.Form () String value view -> Expect.Expectation
performUpdatesThenExpectErrors updatesToPerform expected form =
let
model : Form.Model

25
tests/Pages/Review/NoContractViolationsTest.elm
View File

@ -10,7 +10,7 @@ all =
describe "Pages.Review.NoContractViolations"
[ test "reports error when missing exposed declaration" <|
\() ->
"""module Route.Blog.Slug_ exposing (Data, Msg, route)
"""module Route.Blog.Slug_ exposing (ActionData, Data, Msg, route)
a = 1
"""
@ -24,19 +24,20 @@ a = 1
- route
- Data
- ActionData
- Model
- Msg
But it is not exposing: Model"""
]
, under = "exposing (Data, Msg, route)"
, under = "exposing (ActionData, Data, Msg, route)"
}
]
)
]
, test "reports RouteParams mismatch" <|
\() ->
"""module Route.Blog.Slug_ exposing (Data, route, Model, Msg)
"""module Route.Blog.Slug_ exposing (ActionData, Data, route, Model, Msg)
type alias RouteParams = { blogPostName : String }
@ -60,7 +61,7 @@ type alias RouteParams = { slug : String }
]
, test "reports incorrect types for optional RouteParams" <|
\() ->
"""module Route.Docs.Section_.SubSection__ exposing (Data, route, Model, Msg)
"""module Route.Docs.Section_.SubSection__ exposing (ActionData, Data, route, Model, Msg)
type alias RouteParams = { section : String, subSection : String }
@ -84,7 +85,7 @@ type alias RouteParams = { section : String, subSection : Maybe String }
]
, test "reports incorrect types for required splat RouteParams" <|
\() ->
"""module Route.Docs.Section_.SPLAT_ exposing (Data, route, Model, Msg)
"""module Route.Docs.Section_.SPLAT_ exposing (ActionData, Data, route, Model, Msg)
type alias RouteParams = { section : String, splat : List String }
@ -108,7 +109,7 @@ type alias RouteParams = { section : String, splat : ( String, List String ) }
]
, test "no error for valid SPLAT_ RouteParams" <|
\() ->
"""module Route.Docs.Section_.SPLAT_ exposing (Data, route, Model, Msg)
"""module Route.Docs.Section_.SPLAT_ exposing (ActionData, Data, route, Model, Msg)
type alias RouteParams = { section : String, splat : ( String, List String ) }
@ -118,7 +119,7 @@ route = {}
|> Review.Test.expectNoErrors
, test "no error for valid SPLAT__ RouteParams" <|
\() ->
"""module Route.Docs.Section_.SPLAT__ exposing (Data, route, Model, Msg)
"""module Route.Docs.Section_.SPLAT__ exposing (ActionData, Data, route, Model, Msg)
type alias RouteParams = { section : String, splat : List String }
@ -128,7 +129,7 @@ route = {}
|> Review.Test.expectNoErrors
, test "no error for matching RouteParams name" <|
\() ->
"""module Route.Blog.Slug_ exposing (Data, route, Model, Msg)
"""module Route.Blog.Slug_ exposing (ActionData, Data, route, Model, Msg)
type alias RouteParams = { slug : String }
@ -138,7 +139,7 @@ route = {}
|> Review.Test.expectNoErrors
, test "error when RouteParams type is not a record" <|
\() ->
"""module Route.Blog.Slug_ exposing (Data, route, Model, Msg)
"""module Route.Blog.Slug_ exposing (ActionData, Data, route, Model, Msg)
type alias RouteParams = ()
@ -169,7 +170,7 @@ route = {}
|> Review.Test.expectNoErrors
, test "error for missing application module definitions" <|
\() ->
[ """module Route.Index exposing (Data, route, Model, Msg)
[ """module Route.Index exposing (ActionData, Data, route, Model, Msg)
type alias RouteParams = {}
@ -198,7 +199,7 @@ config =
]
, test "no error when all core modules are defined" <|
\() ->
("""module Route.Index exposing (Data, route, Model, Msg)
("""module Route.Index exposing (ActionData, Data, route, Model, Msg)
type alias RouteParams = {}
@ -210,7 +211,7 @@ route = {}
|> Review.Test.expectNoErrors
, test "show missing exposed values from core modules" <|
\() ->
[ """module Route.Index exposing (Data, route, Model, Msg)
[ """module Route.Index exposing (ActionData, Data, route, Model, Msg)
type alias RouteParams = {}

273
tests/StaticHttpRequestsTests.elm
View File

@ -74,28 +74,6 @@ all =
portData.is404
|> Expect.false "Expected page to be found and rendered"
_ ->
Expect.fail <| "Expected exactly 1 port of type PageProgress. Instead, got \n" ++ Debug.toString actualPorts
)
, test "data sources are not resolved 404 pages with matching route but not pre-rendered" <|
\() ->
startWithRoutes [ "post-2" ]
[ [ "post-1" ]
]
[]
[ ( [ "post-2" ]
, DataSource.Http.get "https://api.github.com/repos/dillonkearns/elm-pages" starDecoder
)
]
|> ProgramTest.expectOutgoingPortValues
"toJsPort"
(Codec.decoder (ToJsPayload.successCodecNew2 "" ""))
(\actualPorts ->
case actualPorts of
[ ToJsPayload.PageProgress portData ] ->
portData.is404
|> Expect.true "Expected 404 not found page"
_ ->
Expect.fail <| "Expected exactly 1 port of type PageProgress. Instead, got \n" ++ Debug.toString actualPorts
)
@ -444,83 +422,6 @@ startLowLevel apiRoutes staticHttpCache pages =
Nothing ->
Debug.todo "Error - no pages"
config : ProgramConfig Msg () Route () () Effect mappedMsg ()
config =
{ toJsPort = toJsPort
, fromJsPort = fromJsPort
, init = \_ _ _ _ _ -> ( (), Effect.NoEffect )
, getStaticRoutes =
--StaticHttp.get (Secrets.succeed "https://my-cms.com/posts")
-- (Decode.field "posts" (Decode.list (Decode.string |> Decode.map Route)))
pages
|> List.map Tuple.first
|> List.map (String.join "/")
|> List.map Route
|> DataSource.succeed
, handleRoute = \_ -> DataSource.succeed Nothing
, urlToRoute = .path >> Route
, update = \_ _ _ _ _ -> ( (), Effect.NoEffect )
, basePath = []
, data =
\(Route pageRoute) ->
let
thing : Maybe (DataSource a)
thing =
pages
|> Dict.fromList
|> Dict.get
(pageRoute
|> String.split "/"
|> List.filter (\pathPart -> pathPart /= "")
)
in
case thing of
Just request ->
request |> DataSource.map (\_ -> Response.render ())
Nothing ->
Debug.todo <| "Couldn't find page: " ++ pageRoute ++ "\npages: " ++ Debug.toString pages
, site = Just site
, view =
\page _ ->
let
thing : Maybe (DataSource a)
thing =
pages
|> Dict.fromList
|> Dict.get
(page.path |> Path.toSegments)
in
case thing of
Just _ ->
\_ _ -> { view = \_ -> { title = "Title", body = Html.text "" }, head = [] }
Nothing ->
Debug.todo <| "Couldn't find page: " ++ Debug.toString page ++ "\npages: " ++ Debug.toString pages
, subscriptions = \_ _ _ -> Sub.none
, routeToPath = \(Route route) -> route |> String.split "/"
, sharedData = DataSource.succeed ()
, onPageChange = \_ -> Continue
, apiRoutes = \_ -> apiRoutes
, pathPatterns = []
, byteDecodePageData = \_ -> Bytes.Decode.fail
, sendPageData = \_ -> Cmd.none
, encodeResponse = \_ -> Bytes.Encode.signedInt8 0
, hotReloadData = Sub.none
, decodeResponse = Bytes.Decode.fail
, byteEncodePageData = \_ -> Bytes.Encode.signedInt8 0
, fetchPageData = \_ _ -> Task.fail Http.NetworkError
, gotBatchSub = Sub.none
, globalHeadTags = Nothing
, perform = \_ _ -> Cmd.none
, cmdToEffect = \_ -> Effect.NoEffect
, errorStatusCode = \_ -> 404
, notFoundPage = ()
, notFoundRoute = Route "not-found"
, internalError = \_ -> ()
, errorPageToData = \_ -> ()
}
encodedFlags : Encode.Value
encodedFlags =
--{"secrets":
@ -568,8 +469,8 @@ startLowLevel apiRoutes staticHttpCache pages =
)
(Encode.object [])
)
config
, update = update site config
(config apiRoutes pages)
, update = update site (config apiRoutes pages)
, view = \_ -> { title = "", body = [] }
}
|> ProgramTest.withSimulatedEffects simulateEffects
@ -588,6 +489,85 @@ startSimple route dataSources =
startWithRoutes route [ route ] [] [ ( route, dataSources ) ]
config : List (ApiRoute.ApiRoute ApiRoute.Response) -> List ( List String, DataSource a ) -> ProgramConfig Msg () Route () () () Effect mappedMsg ()
config apiRoutes pages =
{ toJsPort = toJsPort
, fromJsPort = fromJsPort
, init = \_ _ _ _ _ _ -> ( (), Effect.NoEffect )
, getStaticRoutes =
--StaticHttp.get (Secrets.succeed "https://my-cms.com/posts")
-- (Decode.field "posts" (Decode.list (Decode.string |> Decode.map Route)))
pages
|> List.map Tuple.first
|> List.map (String.join "/")
|> List.map Route
|> DataSource.succeed
, handleRoute = \_ -> DataSource.succeed Nothing
, urlToRoute = .path >> Route
, update = \_ _ _ _ _ -> ( (), Effect.NoEffect )
, basePath = []
, data =
\(Route pageRoute) ->
let
thing : Maybe (DataSource a)
thing =
pages
|> Dict.fromList
|> Dict.get
(pageRoute
|> String.split "/"
|> List.filter (\pathPart -> pathPart /= "")
)
in
case thing of
Just request ->
request |> DataSource.map (\_ -> Response.render ())
Nothing ->
Debug.todo <| "Couldn't find page: " ++ pageRoute ++ "\npages: " ++ Debug.toString pages
, site = Just site
, view =
\page _ _ ->
let
thing : Maybe (DataSource a)
thing =
pages
|> Dict.fromList
|> Dict.get
(page.path |> Path.toSegments)
in
case thing of
Just _ ->
\_ _ -> { view = \_ -> { title = "Title", body = Html.text "" }, head = [] }
Nothing ->
Debug.todo <| "Couldn't find page: " ++ Debug.toString page ++ "\npages: " ++ Debug.toString pages
, subscriptions = \_ _ _ -> Sub.none
, routeToPath = \(Route route) -> route |> String.split "/"
, sharedData = DataSource.succeed ()
, onPageChange = \_ -> Continue
, apiRoutes = \_ -> apiRoutes
, pathPatterns = []
, byteDecodePageData = \_ -> Bytes.Decode.fail
, sendPageData = \_ -> Cmd.none
, encodeResponse = \_ -> Bytes.Encode.signedInt8 0
, hotReloadData = Sub.none
, decodeResponse = Bytes.Decode.fail
, byteEncodePageData = \_ -> Bytes.Encode.signedInt8 0
, gotBatchSub = Sub.none
, globalHeadTags = Nothing
, perform = \_ _ -> Cmd.none
, cmdToEffect = \_ -> Effect.NoEffect
, errorStatusCode = \_ -> 404
, notFoundPage = ()
, notFoundRoute = Route "not-found"
, internalError = \_ -> ()
, errorPageToData = \_ -> ()
, action = \_ -> DataSource.fail "No action."
, encodeAction = \_ -> Bytes.Encode.signedInt8 0
}
startWithRoutes :
List String
-> List (List String)
@ -596,93 +576,6 @@ startWithRoutes :
-> ProgramTest (Model Route) Msg Effect
startWithRoutes pageToLoad staticRoutes staticHttpCache pages =
let
config : ProgramConfig Msg () Route () () Effect mappedMsg ()
config =
{ toJsPort = toJsPort
, fromJsPort = fromJsPort
, init = \_ _ _ _ _ -> ( (), Effect.NoEffect )
, getStaticRoutes =
staticRoutes
|> List.map (String.join "/")
|> List.map Route
|> DataSource.succeed
, handleRoute =
\(Route route) ->
staticRoutes
|> List.map (String.join "/")
|> List.member route
|> (\found ->
if found then
Nothing
else
Just Pages.Internal.NotFoundReason.NoMatchingRoute
)
|> DataSource.succeed
, urlToRoute = .path >> Route
, update = \_ _ _ _ _ -> ( (), Effect.NoEffect )
, basePath = []
, data =
\(Route pageRoute) ->
let
thing : Maybe (DataSource a)
thing =
pages
|> Dict.fromList
|> Dict.get
(pageRoute
|> String.split "/"
|> List.filter (\pathPart -> pathPart /= "")
)
in
case thing of
Just request ->
request
|> DataSource.map (\_ -> Response.render ())
Nothing ->
DataSource.fail <| "Couldn't find page: " ++ pageRoute ++ "\npages: " ++ Debug.toString pages
, site = Just site
, view =
\page _ ->
let
thing : Maybe (DataSource a)
thing =
pages
|> Dict.fromList
|> Dict.get
(page.path |> Path.toSegments)
in
case thing of
Just _ ->
\_ _ -> { view = \_ -> { title = "Title", body = Html.text "" }, head = [] }
Nothing ->
Debug.todo <| "Couldn't find page: " ++ Debug.toString page ++ "\npages: " ++ Debug.toString pages
, subscriptions = \_ _ _ -> Sub.none
, routeToPath = \(Route route) -> route |> String.split "/"
, sharedData = DataSource.succeed ()
, onPageChange = \_ -> Continue
, apiRoutes = \_ -> []
, pathPatterns = []
, byteDecodePageData = \_ -> Bytes.Decode.fail
, sendPageData = \_ -> Cmd.none
, encodeResponse = \_ -> Bytes.Encode.signedInt8 0
, hotReloadData = Sub.none
, decodeResponse = Bytes.Decode.fail
, byteEncodePageData = \_ -> Bytes.Encode.signedInt8 0
, fetchPageData = \_ _ -> Task.fail Http.NetworkError
, gotBatchSub = Sub.none
, globalHeadTags = Nothing
, perform = \_ _ -> Cmd.none
, cmdToEffect = \_ -> Effect.NoEffect
, errorStatusCode = \_ -> 404
, notFoundPage = ()
, notFoundRoute = Route "not-found"
, internalError = \_ -> ()
, errorPageToData = \_ -> ()
}
encodedFlags : Encode.Value
encodedFlags =
--{"secrets":
@ -730,8 +623,8 @@ startWithRoutes pageToLoad staticRoutes staticHttpCache pages =
)
(Encode.object [])
)
config
, update = update site config
(config [] pages)
, update = update site (config [] pages)
, view = \_ -> { title = "", body = [] }
}
|> ProgramTest.withSimulatedEffects simulateEffects