elm-pages 2.1.10 → 3.0.0-beta.0

package/src/Pages/Manifest.elm

@@ -3,6 +3,7 @@ module Pages.Manifest exposing
     , init
     , withBackgroundColor, withCategories, withDisplayMode, withIarcRatingId, withLang, withOrientation, withShortName, withThemeColor
     , DisplayMode(..), Orientation(..), IconPurpose(..)
+    , generator
     , toJson
     )
 
@@ -45,14 +46,22 @@ You pass your `Pages.Manifest.Config` record into the `Pages.application` functi
 @docs DisplayMode, Orientation, IconPurpose
 
 
+## Generating a Manifest.json
+
+@docs generator
+
+
 ## Functions for use by the generated code (`Pages.elm`)
 
 @docs toJson
 
 -}
 
+import ApiRoute
 import Color exposing (Color)
 import Color.Convert
+import DataSource exposing (DataSource)
+import Head
 import Json.Encode as Encode
 import LanguageTag exposing (LanguageTag, emptySubtags)
 import LanguageTag.Country as Country
@@ -313,6 +322,23 @@ nonEmptyList list =
         Just list
 
 
+{-| A generator for Api.elm to include a manifest.json.
+-}
+generator : String -> DataSource Config -> ApiRoute.ApiRoute ApiRoute.Response
+generator canonicalSiteUrl config =
+    ApiRoute.succeed
+        (config
+            |> DataSource.map (toJson canonicalSiteUrl >> Encode.encode 0)
+        )
+        |> ApiRoute.literal "manifest.json"
+        |> ApiRoute.single
+        |> ApiRoute.withGlobalHeadTags
+            (DataSource.succeed
+                [ Head.manifestLink "/manifest.json"
+                ]
+            )
+
+
 {-| Feel free to use this, but in 99% of cases you won't need it. The generated
 code will run this for you to generate your `manifest.json` file automatically!
 -}

package/src/Pages/Msg.elm

@@ -0,0 +1,79 @@
+module Pages.Msg exposing
+    ( Msg(..)
+    , map, onSubmit, fetcherOnSubmit, submitIfValid
+    )
+
+{-|
+
+@docs Msg
+
+@docs map, onSubmit, fetcherOnSubmit, submitIfValid
+
+-}
+
+import Form.FormData exposing (FormData)
+import FormDecoder
+import Html exposing (Attribute)
+import Html.Attributes as Attr
+import Json.Decode
+
+
+{-| -}
+type Msg userMsg
+    = UserMsg userMsg
+    | Submit FormData
+    | SubmitIfValid String FormData Bool
+    | SubmitFetcher String FormData Bool (Maybe userMsg)
+    | FormFieldEvent Json.Decode.Value
+
+
+{-| -}
+onSubmit : Attribute (Msg userMsg)
+onSubmit =
+    FormDecoder.formDataOnSubmit
+        |> Attr.map Submit
+
+
+{-| -}
+submitIfValid : String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
+submitIfValid formId isValid =
+    FormDecoder.formDataOnSubmit
+        |> Attr.map (\formData -> SubmitIfValid formId formData (isValid formData.fields))
+
+
+{-| -}
+fetcherOnSubmit : Maybe ({ fields : List ( String, String ) } -> userMsg) -> String -> (List ( String, String ) -> Bool) -> Attribute (Msg userMsg)
+fetcherOnSubmit userMsg formId isValid =
+    FormDecoder.formDataOnSubmit
+        |> Attr.map
+            (\formData ->
+                SubmitFetcher formId
+                    formData
+                    (isValid formData.fields)
+                    (userMsg
+                        |> Maybe.map
+                            (\toUserMsg ->
+                                toUserMsg { fields = formData.fields }
+                            )
+                    )
+            )
+
+
+{-| -}
+map : (a -> b) -> Msg a -> Msg b
+map mapFn msg =
+    case msg of
+        UserMsg userMsg ->
+            UserMsg (mapFn userMsg)
+
+        Submit info ->
+            Submit info
+
+        SubmitIfValid formId info isValid ->
+            SubmitIfValid formId info isValid
+
+        SubmitFetcher formId info isValid toUserMsg ->
+            SubmitFetcher formId info isValid (Maybe.map mapFn toUserMsg)
+
+        FormFieldEvent value ->
+            FormFieldEvent value

package/src/Pages/ProgramConfig.elm

@@ -2,26 +2,39 @@ module Pages.ProgramConfig exposing (ProgramConfig)
 
 import ApiRoute
 import Browser.Navigation
-import DataSource
+import Bytes exposing (Bytes)
+import Bytes.Decode
+import Bytes.Encode
+import DataSource exposing (DataSource)
+import Dict exposing (Dict)
+import Form.FormData exposing (FormData)
 import Head
 import Html exposing (Html)
+import Http
 import Json.Decode as Decode
 import Json.Encode
+import PageServerResponse exposing (PageServerResponse)
+import Pages.Fetcher
 import Pages.Flags
+import Pages.FormState
 import Pages.Internal.NotFoundReason exposing (NotFoundReason)
+import Pages.Internal.Platform.ToJsPayload
+import Pages.Internal.ResponseSketch exposing (ResponseSketch)
 import Pages.Internal.RoutePattern exposing (RoutePattern)
+import Pages.Msg
 import Pages.PageUrl exposing (PageUrl)
 import Pages.SiteConfig exposing (SiteConfig)
+import Pages.Transition
 import Path exposing (Path)
 import Url exposing (Url)
 
 
-type alias ProgramConfig userMsg userModel route siteData pageData sharedData =
+type alias ProgramConfig userMsg userModel route pageData actionData sharedData effect mappedMsg errorPage =
     { init :
         Pages.Flags.Flags
         -> sharedData
         -> pageData
-        -> Maybe Browser.Navigation.Key
+        -> Maybe actionData
         ->
             Maybe
                 { path :
@@ -32,29 +45,38 @@ type alias ProgramConfig userMsg userModel route siteData pageData sharedData =
                 , metadata : route
                 , pageUrl : Maybe PageUrl
                 }
-        -> ( userModel, Cmd userMsg )
-    , update : sharedData -> pageData -> Maybe Browser.Navigation.Key -> userMsg -> userModel -> ( userModel, Cmd userMsg )
+        -> ( userModel, effect )
+    , update : Pages.FormState.PageFormState -> Dict String (Pages.Transition.FetcherState actionData) -> Maybe Pages.Transition.Transition -> sharedData -> pageData -> Maybe Browser.Navigation.Key -> userMsg -> userModel -> ( userModel, effect )
     , subscriptions : route -> Path -> userModel -> Sub userMsg
-    , sharedData : DataSource.DataSource sharedData
-    , data : route -> DataSource.DataSource pageData
+    , sharedData : DataSource sharedData
+    , data : route -> DataSource (PageServerResponse pageData errorPage)
+    , action : route -> DataSource (PageServerResponse actionData errorPage)
+    , onActionData : actionData -> Maybe userMsg
     , view :
-        { path : Path
-        , route : route
-        }
+        Pages.FormState.PageFormState
+        -> Dict String (Pages.Transition.FetcherState actionData)
+        -> Maybe Pages.Transition.Transition
+        ->
+            { path : Path
+            , route : route
+            }
         -> Maybe PageUrl
         -> sharedData
         -> pageData
+        -> Maybe actionData
         ->
-            { view : userModel -> { title : String, body : Html userMsg }
+            { view : userModel -> { title : String, body : Html (Pages.Msg.Msg userMsg) }
             , head : List Head.Tag
             }
-    , handleRoute : route -> DataSource.DataSource (Maybe NotFoundReason)
-    , getStaticRoutes : DataSource.DataSource (List route)
+    , handleRoute : route -> DataSource (Maybe NotFoundReason)
+    , getStaticRoutes : DataSource (List route)
     , urlToRoute : Url -> route
     , routeToPath : route -> List String
-    , site : Maybe (SiteConfig siteData)
+    , site : Maybe SiteConfig
     , toJsPort : Json.Encode.Value -> Cmd Never
     , fromJsPort : Sub Decode.Value
+    , gotBatchSub : Sub Decode.Value
+    , hotReloadData : Sub Bytes
     , onPageChange :
         { protocol : Url.Protocol
         , host : String
@@ -70,4 +92,35 @@ type alias ProgramConfig userMsg userModel route siteData pageData sharedData =
         -> List (ApiRoute.ApiRoute ApiRoute.Response)
     , pathPatterns : List RoutePattern
     , basePath : List String
+    , sendPageData : Pages.Internal.Platform.ToJsPayload.NewThingForPort -> Cmd Never
+    , byteEncodePageData : pageData -> Bytes.Encode.Encoder
+    , byteDecodePageData : route -> Bytes.Decode.Decoder pageData
+    , encodeResponse : ResponseSketch pageData actionData sharedData -> Bytes.Encode.Encoder
+    , encodeAction : actionData -> Bytes.Encode.Encoder
+    , decodeResponse : Bytes.Decode.Decoder (ResponseSketch pageData actionData sharedData)
+    , globalHeadTags : Maybe ((Html Never -> String) -> DataSource (List Head.Tag))
+    , cmdToEffect : Cmd userMsg -> effect
+    , perform :
+        { fetchRouteData :
+            { data : Maybe FormData
+            , toMsg : Result Http.Error Url -> userMsg
+            }
+            -> Cmd mappedMsg
+        , submit :
+            { values : FormData
+            , toMsg : Result Http.Error Url -> userMsg
+            }
+            -> Cmd mappedMsg
+        , fromPageMsg : userMsg -> mappedMsg
+        , runFetcher : Pages.Fetcher.Fetcher userMsg -> Cmd mappedMsg
+        , key : Browser.Navigation.Key
+        , setField : { formId : String, name : String, value : String } -> Cmd mappedMsg
+        }
+        -> effect
+        -> Cmd mappedMsg
+    , errorStatusCode : errorPage -> Int
+    , notFoundPage : errorPage
+    , internalError : String -> errorPage
+    , errorPageToData : errorPage -> pageData
+    , notFoundRoute : route
     }

package/src/Pages/SiteConfig.elm

@@ -2,12 +2,9 @@ module Pages.SiteConfig exposing (SiteConfig)
 
 import DataSource exposing (DataSource)
 import Head
-import Pages.Manifest
 
 
-type alias SiteConfig data =
-    { data : DataSource data
-    , canonicalUrl : String
-    , manifest : data -> Pages.Manifest.Config
-    , head : data -> List Head.Tag
+type alias SiteConfig =
+    { canonicalUrl : String
+    , head : DataSource (List Head.Tag)
     }

package/src/Pages/StaticHttp/Request.elm

@@ -1,8 +1,8 @@
 module Pages.StaticHttp.Request exposing (Request, codec, hash)
 
 import Codec exposing (Codec)
+import FNV1a
 import Json.Encode as Encode
-import Murmur3
 import Pages.Internal.StaticHttpBody as StaticHttpBody exposing (Body)
 
 
@@ -11,6 +11,7 @@ type alias Request =
     , method : String
     , headers : List ( String, String )
     , body : Body
+    , useCache : Bool
     }
 
 
@@ -23,7 +24,7 @@ hash requestDetails =
         , ( "body", StaticHttpBody.encode requestDetails.body )
         ]
         |> Encode.encode 0
-        |> Murmur3.hashString 0
+        |> FNV1a.hash
         |> String.fromInt
 
 
@@ -39,4 +40,5 @@ codec =
         |> Codec.field "method" .method Codec.string
         |> Codec.field "headers" .headers (Codec.list (Codec.tuple Codec.string Codec.string))
         |> Codec.field "body" .body StaticHttpBody.codec
+        |> Codec.field "useCache" .useCache Codec.bool
         |> Codec.buildObject

package/src/Pages/StaticHttpRequest.elm

@@ -1,203 +1,26 @@
-module Pages.StaticHttpRequest exposing (Error(..), RawRequest(..), Status(..), WhatToDo(..), cacheRequestResolution, merge, resolve, resolveUrls, strippedResponsesEncode, toBuildError)
+module Pages.StaticHttpRequest exposing (Error(..), MockResolver, RawRequest(..), Status(..), cacheRequestResolution, mockResolve, resolve, resolveUrls, toBuildError)
 
 import BuildError exposing (BuildError)
-import Dict exposing (Dict)
-import Internal.OptimizedDecoder
-import Json.Decode.Exploration
-import Json.Encode
-import KeepOrDiscard exposing (KeepOrDiscard)
+import Dict
 import List.Extra
-import OptimizedDecoder
-import Pages.Internal.ApplicationType exposing (ApplicationType)
 import Pages.StaticHttp.Request
 import RequestsAndPending exposing (RequestsAndPending)
-import Secrets
 import TerminalText as Terminal
 
 
+type alias MockResolver =
+    Pages.StaticHttp.Request.Request
+    -> Maybe RequestsAndPending.Response
+
+
 type RawRequest value
-    = Request (Dict String WhatToDo) ( List (Secrets.Value Pages.StaticHttp.Request.Request), KeepOrDiscard -> ApplicationType -> RequestsAndPending -> RawRequest value )
+    = Request (List Pages.StaticHttp.Request.Request) (Maybe MockResolver -> RequestsAndPending -> RawRequest value)
     | RequestError Error
-    | ApiRoute (Dict String WhatToDo) value
-
-
-type WhatToDo
-    = UseRawResponse
-    | CliOnly
-    | StripResponse (OptimizedDecoder.Decoder ())
-    | DistilledResponse Json.Encode.Value
-    | Error (List BuildError)
-
-
-merge : String -> WhatToDo -> WhatToDo -> WhatToDo
-merge key whatToDo1 whatToDo2 =
-    case ( whatToDo1, whatToDo2 ) of
-        ( Error buildErrors1, Error buildErrors2 ) ->
-            Error (buildErrors1 ++ buildErrors2)
-
-        ( Error buildErrors1, _ ) ->
-            Error buildErrors1
-
-        ( _, Error buildErrors1 ) ->
-            Error buildErrors1
-
-        ( StripResponse strip1, StripResponse strip2 ) ->
-            StripResponse (OptimizedDecoder.map2 (\_ _ -> ()) strip1 strip2)
-
-        ( StripResponse strip1, _ ) ->
-            StripResponse strip1
-
-        ( _, StripResponse strip1 ) ->
-            StripResponse strip1
-
-        ( _, CliOnly ) ->
-            whatToDo1
-
-        ( CliOnly, _ ) ->
-            whatToDo2
-
-        ( DistilledResponse distilled1, DistilledResponse distilled2 ) ->
-            if Json.Encode.encode 0 distilled1 == Json.Encode.encode 0 distilled2 then
-                DistilledResponse distilled1
-
-            else
-                Error
-                    [ { title = "Non-Unique Distill Keys"
-                      , message =
-                            [ Terminal.text "I encountered DataSource.distill with two matching keys that had differing encoded values.\n\n"
-                            , Terminal.text "Look for "
-                            , Terminal.red <| "DataSource.distill"
-                            , Terminal.text " with the key "
-                            , Terminal.red <| ("\"" ++ key ++ "\"")
-                            , Terminal.text "\n\n"
-                            , Terminal.yellow <| "The first encoded value was:\n"
-                            , Terminal.text <| Json.Encode.encode 2 distilled1
-                            , Terminal.text "\n\n-------------------------------\n\n"
-                            , Terminal.yellow <| "The second encoded value was:\n"
-                            , Terminal.text <| Json.Encode.encode 2 distilled2
-                            ]
-                      , path = "" -- TODO wire in path here?
-                      , fatal = True
-                      }
-                    ]
-
-        ( DistilledResponse distilled1, _ ) ->
-            DistilledResponse distilled1
-
-        ( _, DistilledResponse distilled1 ) ->
-            DistilledResponse distilled1
-
-        ( UseRawResponse, UseRawResponse ) ->
-            UseRawResponse
-
-
-strippedResponses : ApplicationType -> RawRequest value -> RequestsAndPending -> Dict String WhatToDo
-strippedResponses =
-    strippedResponsesHelp Dict.empty
-
-
-strippedResponsesEncode : ApplicationType -> RawRequest value -> RequestsAndPending -> Result (List BuildError) (Dict String String)
-strippedResponsesEncode appType rawRequest requestsAndPending =
-    strippedResponses appType rawRequest requestsAndPending
-        |> Dict.toList
-        |> List.map
-            (\( k, whatToDo ) ->
-                (case whatToDo of
-                    UseRawResponse ->
-                        Dict.get k requestsAndPending
-                            |> Maybe.withDefault Nothing
-                            |> Maybe.withDefault ""
-                            |> Just
-                            |> Ok
-
-                    StripResponse decoder ->
-                        Dict.get k requestsAndPending
-                            |> Maybe.withDefault Nothing
-                            |> Maybe.withDefault ""
-                            |> Json.Decode.Exploration.stripString (Internal.OptimizedDecoder.jde decoder)
-                            |> Result.withDefault "ERROR"
-                            |> Just
-                            |> Ok
-
-                    CliOnly ->
-                        Nothing
-                            |> Ok
-
-                    DistilledResponse value ->
-                        value
-                            |> Json.Encode.encode 0
-                            |> Just
-                            |> Ok
-
-                    Error buildError ->
-                        Err buildError
-                )
-                    |> Result.map (Maybe.map (Tuple.pair k))
-            )
-        |> combineMultipleErrors
-        |> Result.map (List.filterMap identity)
-        |> Result.map Dict.fromList
-
-
-combineMultipleErrors : List (Result (List error) a) -> Result (List error) (List a)
-combineMultipleErrors results =
-    List.foldr
-        (\result soFarResult ->
-            case soFarResult of
-                Ok soFarOk ->
-                    case result of
-                        Ok value ->
-                            value :: soFarOk |> Ok
-
-                        Err error_ ->
-                            Err error_
-
-                Err errorsSoFar ->
-                    case result of
-                        Ok _ ->
-                            Err errorsSoFar
-
-                        Err error_ ->
-                            Err <| error_ ++ errorsSoFar
-        )
-        (Ok [])
-        results
-
-
-strippedResponsesHelp : Dict String WhatToDo -> ApplicationType -> RawRequest value -> RequestsAndPending -> Dict String WhatToDo
-strippedResponsesHelp usedSoFar appType request rawResponses =
-    case request of
-        RequestError _ ->
-            usedSoFar
-
-        Request partiallyStrippedResponses ( _, lookupFn ) ->
-            case lookupFn KeepOrDiscard.Keep appType rawResponses of
-                followupRequest ->
-                    strippedResponsesHelp
-                        (Dict.merge
-                            (\key a -> Dict.insert key a)
-                            (\key a b -> Dict.insert key (merge key a b))
-                            (\key b -> Dict.insert key b)
-                            usedSoFar
-                            partiallyStrippedResponses
-                            Dict.empty
-                        )
-                        appType
-                        followupRequest
-                        rawResponses
-
-        ApiRoute partiallyStrippedResponses _ ->
-            Dict.merge
-                (\key a -> Dict.insert key a)
-                (\key a b -> Dict.insert key (merge key a b))
-                (\key b -> Dict.insert key b)
-                usedSoFar
-                partiallyStrippedResponses
-                Dict.empty
+    | ApiRoute value
 
 
 type Error
-    = MissingHttpResponse String (List (Secrets.Value Pages.StaticHttp.Request.Request))
+    = MissingHttpResponse String (List Pages.StaticHttp.Request.Request)
     | DecoderError String
     | UserCalledStaticHttpFail String
 
@@ -233,70 +56,83 @@ toBuildError path error =
             }
 
 
-resolve : ApplicationType -> RawRequest value -> RequestsAndPending -> Result Error value
-resolve appType request rawResponses =
+resolve : RawRequest value -> RequestsAndPending -> Result Error value
+resolve request rawResponses =
     case request of
         RequestError error ->
             Err error
 
-        Request _ ( _, lookupFn ) ->
-            case lookupFn KeepOrDiscard.Keep appType rawResponses of
+        Request _ lookupFn ->
+            case lookupFn Nothing rawResponses of
                 nextRequest ->
-                    resolve appType nextRequest rawResponses
+                    resolve nextRequest rawResponses
 
-        ApiRoute _ value ->
+        ApiRoute value ->
             Ok value
 
 
-resolveUrls : ApplicationType -> RawRequest value -> RequestsAndPending -> List (Secrets.Value Pages.StaticHttp.Request.Request)
-resolveUrls appType request rawResponses =
-    resolveUrlsHelp appType rawResponses [] request
+mockResolve : RawRequest value -> MockResolver -> Result Error value
+mockResolve request mockResolver =
+    case request of
+        RequestError error ->
+            Err error
 
+        Request _ lookupFn ->
+            case lookupFn (Just mockResolver) Dict.empty of
+                nextRequest ->
+                    mockResolve nextRequest mockResolver
 
-resolveUrlsHelp : ApplicationType -> RequestsAndPending -> List (Secrets.Value Pages.StaticHttp.Request.Request) -> RawRequest value -> List (Secrets.Value Pages.StaticHttp.Request.Request)
-resolveUrlsHelp appType rawResponses soFar request =
+        ApiRoute value ->
+            Ok value
+
+
+resolveUrls : RawRequest value -> RequestsAndPending -> List Pages.StaticHttp.Request.Request
+resolveUrls request rawResponses =
+    resolveUrlsHelp rawResponses [] request
+
+
+resolveUrlsHelp : RequestsAndPending -> List Pages.StaticHttp.Request.Request -> RawRequest value -> List Pages.StaticHttp.Request.Request
+resolveUrlsHelp rawResponses soFar request =
     case request of
         RequestError error ->
             case error of
                 MissingHttpResponse _ next ->
                     (soFar ++ next)
-                        |> List.Extra.uniqueBy (Secrets.maskedLookup >> Pages.StaticHttp.Request.hash)
+                        |> List.Extra.uniqueBy Pages.StaticHttp.Request.hash
 
                 _ ->
                     soFar
 
-        Request _ ( urlList, lookupFn ) ->
-            resolveUrlsHelp appType
+        Request urlList lookupFn ->
+            resolveUrlsHelp
                 rawResponses
                 (soFar ++ urlList)
-                (lookupFn KeepOrDiscard.Keep appType rawResponses)
+                (lookupFn Nothing rawResponses)
 
-        ApiRoute _ _ ->
+        ApiRoute _ ->
             soFar
 
 
 cacheRequestResolution :
-    ApplicationType
-    -> RawRequest value
+    RawRequest value
     -> RequestsAndPending
     -> Status value
-cacheRequestResolution appType request rawResponses =
-    cacheRequestResolutionHelp [] appType rawResponses request
+cacheRequestResolution request rawResponses =
+    cacheRequestResolutionHelp [] rawResponses request
 
 
 type Status value
-    = Incomplete (List (Secrets.Value Pages.StaticHttp.Request.Request))
+    = Incomplete (List Pages.StaticHttp.Request.Request)
     | HasPermanentError Error
     | Complete
 
 
 cacheRequestResolutionHelp :
-    List (Secrets.Value Pages.StaticHttp.Request.Request)
-    -> ApplicationType
+    List Pages.StaticHttp.Request.Request
     -> RequestsAndPending
     -> RawRequest value
     -> Status value
-cacheRequestResolutionHelp foundUrls appType rawResponses request =
+cacheRequestResolutionHelp foundUrls rawResponses request =
     case request of
         RequestError error ->
             case error of
@@ -310,11 +146,10 @@ cacheRequestResolutionHelp foundUrls appType rawResponses request =
                 UserCalledStaticHttpFail _ ->
                     HasPermanentError error
 
-        Request _ ( urlList, lookupFn ) ->
+        Request urlList lookupFn ->
             cacheRequestResolutionHelp urlList
-                appType
                 rawResponses
-                (lookupFn KeepOrDiscard.Keep appType rawResponses)
+                (lookupFn Nothing rawResponses)
 
-        ApiRoute _ _ ->
+        ApiRoute _ ->
             Complete