elm-pages 3.0.0-beta.1 → 3.0.0-beta.12

package/src/Pages/Internal/Platform/CompatibilityKey.elm

@@ -0,0 +1,6 @@
+module Pages.Internal.Platform.CompatibilityKey exposing (currentCompatibilityKey)
+
+
+currentCompatibilityKey : Int
+currentCompatibilityKey =
+    2

package/src/Pages/Internal/Platform/GeneratorApplication.elm

@@ -0,0 +1,455 @@
+module Pages.Internal.Platform.GeneratorApplication exposing (Flags, Model, Msg(..), init, requestDecoder, update, app)
+
+{-| Exposed for internal use only (used in generated code).
+
+@docs Flags, Model, Msg, init, requestDecoder, update, app
+
+-}
+
+import BuildError exposing (BuildError)
+import Cli.Program as Program exposing (FlagsIncludingArgv)
+import Codec
+import DataSource exposing (DataSource)
+import Dict
+import HtmlPrinter
+import Json.Decode as Decode
+import Json.Encode
+import Pages.GeneratorProgramConfig exposing (GeneratorProgramConfig)
+import Pages.Internal.Platform.CompatibilityKey
+import Pages.Internal.Platform.Effect as Effect exposing (Effect)
+import Pages.Internal.Platform.StaticResponses as StaticResponses exposing (StaticResponses)
+import Pages.Internal.Platform.ToJsPayload as ToJsPayload
+import Pages.Script exposing (Script(..))
+import Pages.StaticHttp.Request
+import Pages.StaticHttpRequest as StaticHttpRequest
+import RequestsAndPending exposing (RequestsAndPending)
+import TerminalText as Terminal
+
+
+{-| -}
+type alias Flags =
+    { compatibilityKey : Int
+    }
+
+
+{-| -}
+type alias Model =
+    { staticResponses : StaticResponses
+    , errors : List BuildError
+    , allRawResponses : RequestsAndPending
+    , done : Bool
+    }
+
+
+{-| -}
+type Msg
+    = GotDataBatch
+        (List
+            { request : Pages.StaticHttp.Request.Request
+            , response : RequestsAndPending.Response
+            }
+        )
+    | GotBuildError BuildError
+
+
+{-| -}
+app :
+    GeneratorProgramConfig
+    -> Program.StatefulProgram Model Msg (DataSource ()) Flags
+app config =
+    let
+        cliConfig : Program.Config (DataSource ())
+        cliConfig =
+            case config.data of
+                Generator theCliConfig ->
+                    theCliConfig HtmlPrinter.htmlToString
+    in
+    Program.stateful
+        { init =
+            \flags cliOptions ->
+                init cliOptions flags
+                    |> Tuple.mapSecond (perform config)
+        , update =
+            \cliOptions msg model ->
+                update cliOptions msg model
+                    |> Tuple.mapSecond (perform config)
+        , subscriptions =
+            \_ ->
+                Sub.batch
+                    [ config.fromJsPort
+                        |> Sub.map
+                            (\jsonValue ->
+                                let
+                                    decoder : Decode.Decoder Msg
+                                    decoder =
+                                        Decode.field "tag" Decode.string
+                                            |> Decode.andThen
+                                                (\tag ->
+                                                    case tag of
+                                                        "BuildError" ->
+                                                            Decode.field "data"
+                                                                (Decode.map2
+                                                                    (\message title ->
+                                                                        { title = title
+                                                                        , message = message
+                                                                        , fatal = True
+                                                                        , path = "" -- TODO wire in current path here
+                                                                        }
+                                                                    )
+                                                                    (Decode.field "message" Decode.string |> Decode.map Terminal.fromAnsiString)
+                                                                    (Decode.field "title" Decode.string)
+                                                                )
+                                                                |> Decode.map GotBuildError
+
+                                                        _ ->
+                                                            Decode.fail "Unhandled msg"
+                                                )
+                                in
+                                Decode.decodeValue decoder jsonValue
+                                    |> Result.mapError
+                                        (\error ->
+                                            ("From location 1: "
+                                                ++ (error
+                                                        |> Decode.errorToString
+                                                   )
+                                            )
+                                                |> BuildError.internal
+                                                |> GotBuildError
+                                        )
+                                    |> mergeResult
+                            )
+                    , config.gotBatchSub
+                        |> Sub.map
+                            (\newBatch ->
+                                Decode.decodeValue batchDecoder newBatch
+                                    |> Result.map GotDataBatch
+                                    |> Result.mapError
+                                        (\error ->
+                                            ("From location 2: "
+                                                ++ (error
+                                                        |> Decode.errorToString
+                                                   )
+                                            )
+                                                |> BuildError.internal
+                                                |> GotBuildError
+                                        )
+                                    |> mergeResult
+                            )
+                    ]
+        , config = cliConfig
+        , printAndExitFailure =
+            \string ->
+                ToJsPayload.Errors
+                    [ { title = "Invalid CLI arguments"
+                      , path = ""
+                      , message =
+                            [ Terminal.text string
+                            ]
+                      , fatal = True
+                      }
+                    ]
+                    |> Codec.encodeToValue (ToJsPayload.successCodecNew2 "" "")
+                    |> config.toJsPort
+                    |> Cmd.map never
+        , printAndExitSuccess = \string -> config.toJsPort (Json.Encode.string string) |> Cmd.map never
+        }
+
+
+batchDecoder : Decode.Decoder (List { request : Pages.StaticHttp.Request.Request, response : RequestsAndPending.Response })
+batchDecoder =
+    Decode.map2 (\request response -> { request = request, response = response })
+        (Decode.field "request" requestDecoder)
+        (Decode.field "response" RequestsAndPending.decoder)
+        |> Decode.list
+
+
+mergeResult : Result a a -> a
+mergeResult r =
+    case r of
+        Ok rr ->
+            rr
+
+        Err rr ->
+            rr
+
+
+{-| -}
+requestDecoder : Decode.Decoder Pages.StaticHttp.Request.Request
+requestDecoder =
+    Pages.StaticHttp.Request.codec
+        |> Codec.decoder
+
+
+flatten : GeneratorProgramConfig -> List Effect -> Cmd Msg
+flatten config list =
+    Cmd.batch (flattenHelp [] config list)
+
+
+flattenHelp : List (Cmd Msg) -> GeneratorProgramConfig -> List Effect -> List (Cmd Msg)
+flattenHelp soFar config list =
+    case list of
+        first :: rest ->
+            flattenHelp
+                (perform config first :: soFar)
+                config
+                rest
+
+        [] ->
+            soFar
+
+
+perform :
+    GeneratorProgramConfig
+    -> Effect
+    -> Cmd Msg
+perform config effect =
+    let
+        canonicalSiteUrl : String
+        canonicalSiteUrl =
+            ""
+    in
+    case effect of
+        Effect.NoEffect ->
+            Cmd.none
+
+        Effect.Batch list ->
+            flatten config list
+
+        Effect.FetchHttp unmasked ->
+            ToJsPayload.DoHttp unmasked unmasked.useCache
+                |> Codec.encoder (ToJsPayload.successCodecNew2 canonicalSiteUrl "")
+                |> config.toJsPort
+                |> Cmd.map never
+
+        Effect.SendSinglePage info ->
+            let
+                currentPagePath : String
+                currentPagePath =
+                    case info of
+                        ToJsPayload.PageProgress toJsSuccessPayloadNew ->
+                            toJsSuccessPayloadNew.route
+
+                        _ ->
+                            ""
+            in
+            info
+                |> Codec.encoder (ToJsPayload.successCodecNew2 canonicalSiteUrl currentPagePath)
+                |> config.toJsPort
+                |> Cmd.map never
+
+        Effect.SendSinglePageNew rawBytes info ->
+            let
+                currentPagePath : String
+                currentPagePath =
+                    case info of
+                        ToJsPayload.PageProgress toJsSuccessPayloadNew ->
+                            toJsSuccessPayloadNew.route
+
+                        _ ->
+                            ""
+            in
+            { oldThing =
+                info
+                    |> Codec.encoder (ToJsPayload.successCodecNew2 canonicalSiteUrl currentPagePath)
+            , binaryPageData = rawBytes
+            }
+                |> config.sendPageData
+                |> Cmd.map never
+
+        Effect.Continue ->
+            Cmd.none
+
+
+
+-- TODO use Json.Decode.Value for flagsDecoder instead of hardcoded record flags
+--flagsDecoder :
+--    Decode.Decoder
+--        { staticHttpCache : RequestsAndPending
+--        , compatibilityKey : Int
+--        }
+--flagsDecoder =
+--    Decode.map3
+--        (\staticHttpCache compatibilityKey ->
+--            { staticHttpCache = staticHttpCache
+--            , isDevServer = isDevServer
+--            , compatibilityKey = compatibilityKey
+--            }
+--        )
+--        (Decode.succeed Dict.empty)
+--        (Decode.field "compatibilityKey" Decode.int)
+
+
+{-| -}
+init :
+    DataSource ()
+    -> FlagsIncludingArgv Flags
+    -> ( Model, Effect )
+init execute flags =
+    if flags.compatibilityKey == Pages.Internal.Platform.CompatibilityKey.currentCompatibilityKey then
+        initLegacy execute { staticHttpCache = Dict.empty }
+
+    else
+        let
+            elmPackageAheadOfNpmPackage : Bool
+            elmPackageAheadOfNpmPackage =
+                Pages.Internal.Platform.CompatibilityKey.currentCompatibilityKey > flags.compatibilityKey
+
+            message : String
+            message =
+                "The NPM package and Elm package you have installed are incompatible. If you are updating versions, be sure to update both the elm-pages Elm and NPM package.\n\n"
+                    ++ (if elmPackageAheadOfNpmPackage then
+                            "The elm-pages Elm package is ahead of the elm-pages NPM package. Try updating the elm-pages NPM package?"
+
+                        else
+                            "The elm-pages NPM package is ahead of the elm-pages Elm package. Try updating the elm-pages Elm package?"
+                       )
+        in
+        updateAndSendPortIfDone execute
+            { staticResponses = StaticResponses.empty
+            , errors =
+                [ { title = "Incompatible NPM and Elm package versions"
+                  , message = [ Terminal.text <| message ]
+                  , fatal = True
+                  , path = ""
+                  }
+                ]
+            , allRawResponses = Dict.empty
+            , done = False
+            }
+
+
+initLegacy :
+    DataSource ()
+    -> { staticHttpCache : RequestsAndPending }
+    -> ( Model, Effect )
+initLegacy execute { staticHttpCache } =
+    let
+        staticResponses : StaticResponses
+        staticResponses =
+            StaticResponses.renderApiRequest execute
+
+        initialModel : Model
+        initialModel =
+            { staticResponses = staticResponses
+            , errors = []
+            , allRawResponses = staticHttpCache
+            , done = False
+            }
+    in
+    StaticResponses.nextStep initialModel Nothing
+        |> nextStepToEffect execute
+            initialModel
+
+
+updateAndSendPortIfDone :
+    DataSource ()
+    -> Model
+    -> ( Model, Effect )
+updateAndSendPortIfDone execute model =
+    StaticResponses.nextStep
+        model
+        Nothing
+        |> nextStepToEffect execute model
+
+
+{-| -}
+update :
+    DataSource ()
+    -> Msg
+    -> Model
+    -> ( Model, Effect )
+update execute msg model =
+    case msg of
+        GotDataBatch batch ->
+            let
+                updatedModel : Model
+                updatedModel =
+                    model
+                        |> StaticResponses.batchUpdate batch
+            in
+            StaticResponses.nextStep
+                updatedModel
+                Nothing
+                |> nextStepToEffect execute updatedModel
+
+        GotBuildError buildError ->
+            let
+                updatedModel : Model
+                updatedModel =
+                    { model
+                        | errors =
+                            buildError :: model.errors
+                    }
+            in
+            StaticResponses.nextStep
+                updatedModel
+                Nothing
+                |> nextStepToEffect execute updatedModel
+
+
+nextStepToEffect :
+    DataSource ()
+    -> Model
+    -> ( StaticResponses, StaticResponses.NextStep route )
+    -> ( Model, Effect )
+nextStepToEffect execute model ( updatedStaticResponsesModel, nextStep ) =
+    case nextStep of
+        StaticResponses.Continue updatedAllRawResponses httpRequests _ ->
+            let
+                updatedModel : Model
+                updatedModel =
+                    { model
+                        | allRawResponses = updatedAllRawResponses
+                        , staticResponses = updatedStaticResponsesModel
+                    }
+            in
+            if List.isEmpty httpRequests then
+                nextStepToEffect execute
+                    updatedModel
+                    (StaticResponses.nextStep
+                        updatedModel
+                        Nothing
+                    )
+
+            else
+                ( updatedModel
+                , (httpRequests
+                    |> List.map Effect.FetchHttp
+                  )
+                    |> Effect.Batch
+                )
+
+        StaticResponses.Finish toJsPayload ->
+            case toJsPayload of
+                StaticResponses.ApiResponse ->
+                    let
+                        apiResponse : Effect
+                        apiResponse =
+                            StaticHttpRequest.resolve
+                                execute
+                                model.allRawResponses
+                                |> Result.mapError (StaticHttpRequest.toBuildError "TODO - path from request")
+                                |> (\response ->
+                                        case response of
+                                            Ok () ->
+                                                { body = Json.Encode.null
+                                                , staticHttpCache = Dict.empty
+                                                , statusCode = 200
+                                                }
+                                                    |> ToJsPayload.SendApiResponse
+                                                    |> Effect.SendSinglePage
+
+                                            Err error ->
+                                                [ error ]
+                                                    |> ToJsPayload.Errors
+                                                    |> Effect.SendSinglePage
+                                   )
+                    in
+                    ( model
+                    , apiResponse
+                    )
+
+                StaticResponses.Errors errors ->
+                    ( model
+                    , errors |> ToJsPayload.Errors |> Effect.SendSinglePage
+                    )

package/src/Pages/Internal/Platform.elm

@@ -58,7 +58,7 @@ type alias Program userModel userMsg pageData actionData sharedData errorPage =
 mainView :
     ProgramConfig userMsg userModel route pageData actionData sharedData effect (Msg userMsg pageData actionData sharedData errorPage) errorPage
     -> Model userModel pageData actionData sharedData
-    -> { title : String, body : Html (Pages.Msg.Msg userMsg) }
+    -> { title : String, body : List (Html (Pages.Msg.Msg userMsg)) }
 mainView config model =
     case model.notFound of
         Just info ->
@@ -95,7 +95,7 @@ mainView config model =
                 Err error ->
                     { title = "Page Data Error"
                     , body =
-                        Html.div [] [ Html.text error ]
+                        [ Html.div [] [ Html.text error ] ]
                     }
 
 
@@ -124,9 +124,9 @@ view config model =
     { title = title
     , body =
         [ onViewChangeElement model.url
-        , body |> Html.map UserMsg
         , AriaLiveAnnouncer.view model.ariaNavigationAnnouncement
         ]
+            ++ List.map (Html.map UserMsg) body
     }
 
 
@@ -423,9 +423,7 @@ update config appMsg model =
                         )
 
                     else
-                        ( { model
-                            | url = url
-                          }
+                        ( model
                         , NoEffect
                         )
                             -- TODO is it reasonable to always re-fetch route data if you re-navigate to the current route? Might be a good
@@ -605,27 +603,32 @@ update config appMsg model =
                                 , actionData = newActionData
                                 }
 
-                            ( userModel, _ ) =
+                            ( userModel, userEffect ) =
                                 -- TODO if urlWithoutRedirectResolution is different from the url with redirect resolution, then
                                 -- instead of calling update, call pushUrl (I think?)
                                 -- TODO include user Cmd
-                                config.update model.pageFormState
-                                    (model.inFlightFetchers |> toFetcherState)
-                                    (model.transition |> Maybe.map Tuple.second)
-                                    newSharedData
-                                    newPageData
-                                    model.key
-                                    (config.onPageChange
-                                        { protocol = model.url.protocol
-                                        , host = model.url.host
-                                        , port_ = model.url.port_
-                                        , path = urlPathToPath urlWithoutRedirectResolution
-                                        , query = urlWithoutRedirectResolution.query
-                                        , fragment = urlWithoutRedirectResolution.fragment
-                                        , metadata = config.urlToRoute urlWithoutRedirectResolution
-                                        }
-                                    )
-                                    previousPageData.userModel
+                                if stayingOnSamePath then
+                                    ( previousPageData.userModel, NoEffect )
+
+                                else
+                                    config.update model.pageFormState
+                                        (model.inFlightFetchers |> toFetcherState)
+                                        (model.transition |> Maybe.map Tuple.second)
+                                        newSharedData
+                                        newPageData
+                                        model.key
+                                        (config.onPageChange
+                                            { protocol = model.url.protocol
+                                            , host = model.url.host
+                                            , port_ = model.url.port_
+                                            , path = urlPathToPath urlWithoutRedirectResolution
+                                            , query = urlWithoutRedirectResolution.query
+                                            , fragment = urlWithoutRedirectResolution.fragment
+                                            , metadata = config.urlToRoute urlWithoutRedirectResolution
+                                            }
+                                        )
+                                        previousPageData.userModel
+                                        |> Tuple.mapSecond UserCmd
 
                             updatedModel : Model userModel pageData actionData sharedData
                             updatedModel =
@@ -656,10 +659,13 @@ update config appMsg model =
                             , currentPath = newUrl.path
                           }
                         , if not stayingOnSamePath && scrollToTopWhenDone then
-                            ScrollToTop
+                            Batch
+                                [ ScrollToTop
+                                , userEffect
+                                ]
 
                           else
-                            NoEffect
+                            userEffect
                         )
                             |> (case maybeUserMsg of
                                     Just userMsg ->
@@ -1392,7 +1398,8 @@ loadDataAndUpdateUrl ( newPageData, newSharedData, newActionData ) maybeUserMsg
                     , actionData = newActionData
                     }
 
-                ( userModel, _ ) =
+                -- TODO use userEffect here?
+                ( userModel, userEffect ) =
                     -- TODO if urlWithoutRedirectResolution is different from the url with redirect resolution, then
                     -- instead of calling update, call pushUrl (I think?)
                     -- TODO include user Cmd

package/src/Pages/Manifest.elm

@@ -2,6 +2,7 @@ module Pages.Manifest exposing
     ( Config, Icon
     , init
     , withBackgroundColor, withCategories, withDisplayMode, withIarcRatingId, withLang, withOrientation, withShortName, withThemeColor
+    , withField
     , DisplayMode(..), Orientation(..), IconPurpose(..)
     , generator
     , toJson
@@ -41,6 +42,11 @@ You pass your `Pages.Manifest.Config` record into the `Pages.application` functi
 @docs withBackgroundColor, withCategories, withDisplayMode, withIarcRatingId, withLang, withOrientation, withShortName, withThemeColor
 
 
+## Arbitrary Fields Escape Hatch
+
+@docs withField
+
+
 ## Config options
 
 @docs DisplayMode, Orientation, IconPurpose
@@ -61,6 +67,7 @@ import ApiRoute
 import Color exposing (Color)
 import Color.Convert
 import DataSource exposing (DataSource)
+import Dict exposing (Dict)
 import Head
 import Json.Encode as Encode
 import LanguageTag exposing (LanguageTag, emptySubtags)
@@ -123,6 +130,7 @@ init options =
     , shortName = Nothing
     , icons = options.icons
     , lang = usEnglish
+    , otherFields = Dict.empty
     }
 
 
@@ -191,6 +199,17 @@ withLang languageTag config =
     { config | lang = languageTag }
 
 
+{-| Escape hatch for specifying fields that aren't exposed through this module otherwise. The possible supported properties
+in a manifest file can change over time, so see [MDN manifest.json docs](https://developer.mozilla.org/en-US/docs/Mozilla/Add-ons/WebExtensions/manifest.json)
+for a full listing of the current supported properties.
+-}
+withField : String -> Encode.Value -> Config -> Config
+withField name value config =
+    { config
+        | otherFields = config.otherFields |> Dict.insert name value
+    }
+
+
 orientationToString : Orientation -> String
 orientationToString orientation =
     case orientation of
@@ -239,6 +258,7 @@ type alias Config =
     , shortName : Maybe String
     , icons : List Icon
     , lang : LanguageTag
+    , otherFields : Dict String Encode.Value
     }
 
 
@@ -420,6 +440,10 @@ toJson canonicalSiteUrl config =
       , Encode.string "/" |> Just
       )
     ]
+        ++ (config.otherFields
+                |> Dict.toList
+                |> List.map (Tuple.mapSecond Just)
+           )
         |> encodeMaybeObject
 
 

package/src/Pages/ProgramConfig.elm

@@ -65,7 +65,7 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData
         -> pageData
         -> Maybe actionData
         ->
-            { view : userModel -> { title : String, body : Html (Pages.Msg.Msg userMsg) }
+            { view : userModel -> { title : String, body : List (Html (Pages.Msg.Msg userMsg)) }
             , head : List Head.Tag
             }
     , handleRoute : route -> DataSource (Maybe NotFoundReason)
@@ -88,7 +88,10 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData
         }
         -> userMsg
     , apiRoutes :
-        (Html Never -> String)
+        (Maybe { indent : Int, newLines : Bool }
+         -> Html Never
+         -> String
+        )
         -> List (ApiRoute.ApiRoute ApiRoute.Response)
     , pathPatterns : List RoutePattern
     , basePath : List String
@@ -98,7 +101,7 @@ type alias ProgramConfig userMsg userModel route pageData actionData sharedData
     , 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))
+    , globalHeadTags : Maybe ((Maybe { indent : Int, newLines : Bool } -> Html Never -> String) -> DataSource (List Head.Tag))
     , cmdToEffect : Cmd userMsg -> effect
     , perform :
         { fetchRouteData :