Move some code back to package instead of copied code.

codegen/GenerateMain.elm

@@ -60,11 +60,11 @@ otherFile routes phaseString =
                 _ ->
                     Cli
 
-        config :
-            { declaration : Elm.Declaration
-            , reference : Elm.Expression
-            , referenceFrom : List String -> Elm.Expression
-            }
+        --config :
+        --    { declaration : Elm.Declaration
+        --    , reference : Elm.Expression
+        --    , referenceFrom : List String -> Elm.Expression
+        --    }
         config =
             { init = Elm.apply (Elm.val "init") [ Elm.nothing ]
             , update = update.value []
@@ -171,7 +171,7 @@ otherFile routes phaseString =
                         Elm.nothing
 
                     Cli ->
-                        Elm.just globalHeadTags.reference
+                        Elm.just (globalHeadTags.value [])
             , cmdToEffect =
                 Elm.value
                     { annotation = Nothing
@@ -205,21 +205,22 @@ otherFile routes phaseString =
             , errorPageToData = Elm.val "DataErrorPage____"
             , notFoundRoute = Elm.nothing
             }
-                |> Gen.Pages.ProgramConfig.make_.programConfig
-                |> Elm.withType
-                    (Gen.Pages.ProgramConfig.annotation_.programConfig
-                        (Type.named [] "Msg")
-                        (Type.named [] "Model")
-                        (Type.maybe (Type.named [ "Route" ] "Route"))
-                        (Type.named [] "PageData")
-                        (Type.named [] "ActionData")
-                        (Type.named [ "Shared" ] "Data")
-                        (Type.namedWith [ "Effect" ] "Effect" [ Type.named [] "Msg" ])
-                        (Type.var "mappedMsg")
-                        (Type.named [ "ErrorPage" ] "ErrorPage")
-                    )
-                |> topLevelValue "config"
+                |> make_
+                |> Elm.withType Type.unit
 
+        --|> Elm.withType
+        --    (Gen.Pages.ProgramConfig.annotation_.programConfig
+        --        (Type.named [] "Msg")
+        --        (Type.named [] "Model")
+        --        (Type.maybe (Type.named [ "Route" ] "Route"))
+        --        (Type.named [] "PageData")
+        --        (Type.named [] "ActionData")
+        --        (Type.named [ "Shared" ] "Data")
+        --        (Type.namedWith [ "Effect" ] "Effect" [ Type.named [] "Msg" ])
+        --        (Type.var "mappedMsg")
+        --        (Type.named [ "ErrorPage" ] "ErrorPage")
+        --    )
+        --|> topLevelValue "config"
         pathPatterns :
             { declaration : Elm.Declaration
             , reference : Elm.Expression
@@ -1798,37 +1799,40 @@ otherFile routes phaseString =
 
         globalHeadTags :
             { declaration : Elm.Declaration
-            , reference : Elm.Expression
-            , referenceFrom : List String -> Elm.Expression
+            , call : Elm.Expression -> Elm.Expression
+            , callFrom : List String -> Elm.Expression -> Elm.Expression
+            , value : List String -> Elm.Expression
             }
         globalHeadTags =
-            topLevelValue "globalHeadTags"
-                (Elm.Op.cons
-                    (Elm.value
-                        { importFrom = [ "Site" ]
-                        , annotation = Nothing
-                        , name = "config"
-                        }
-                        |> Elm.get "head"
-                    )
-                    (Elm.apply
+            Elm.Declare.fn "globalHeadTags"
+                ( "htmlToString", Nothing )
+                (\htmlToString ->
+                    Elm.Op.cons
                         (Elm.value
-                            { importFrom = [ "Api" ]
+                            { importFrom = [ "Site" ]
                             , annotation = Nothing
-                            , name = "routes"
+                            , name = "config"
                             }
+                            |> Elm.get "head"
                         )
-                        [ getStaticRoutes.reference
-                        , Gen.HtmlPrinter.values_.htmlToString
-                        ]
-                        |> Gen.List.call_.filterMap Gen.ApiRoute.values_.getGlobalHeadTagsDataSource
-                    )
-                    |> Gen.DataSource.call_.combine
-                    |> Gen.DataSource.call_.map Gen.List.values_.concat
-                    |> Elm.withType
-                        (Gen.DataSource.annotation_.dataSource
-                            (Type.list Gen.Head.annotation_.tag)
+                        (Elm.apply
+                            (Elm.value
+                                { importFrom = [ "Api" ]
+                                , annotation = Nothing
+                                , name = "routes"
+                                }
+                            )
+                            [ getStaticRoutes.reference
+                            , htmlToString
+                            ]
+                            |> Gen.List.call_.filterMap Gen.ApiRoute.values_.getGlobalHeadTagsDataSource
                         )
+                        |> Gen.DataSource.call_.combine
+                        |> Gen.DataSource.call_.map Gen.List.values_.concat
+                        |> Elm.withType
+                            (Gen.DataSource.annotation_.dataSource
+                                (Type.list Gen.Head.annotation_.tag)
+                            )
                 )
 
         encodeResponse :
@@ -2064,15 +2068,14 @@ otherFile routes phaseString =
             )
         , case phase of
             Browser ->
-                Gen.Pages.Internal.Platform.application config.reference
+                Gen.Pages.Internal.Platform.application config
                     |> Elm.declaration "main"
                     |> expose
 
             Cli ->
-                Gen.Pages.Internal.Platform.Cli.cliApplication config.reference
+                Gen.Pages.Internal.Platform.Cli.cliApplication config
                     |> Elm.declaration "main"
                     |> expose
-        , config.declaration
         , dataForRoute.declaration
         , toTriple.declaration
         , action.declaration
@@ -2297,3 +2300,105 @@ routeTemplateFunction functionName route =
         , name = "route"
         }
         |> Elm.get functionName
+
+
+make_ :
+    { init : Elm.Expression
+    , update : Elm.Expression
+    , subscriptions : Elm.Expression
+    , sharedData : Elm.Expression
+    , data : Elm.Expression
+    , action : Elm.Expression
+    , onActionData : Elm.Expression
+    , view : Elm.Expression
+    , handleRoute : Elm.Expression
+    , getStaticRoutes : Elm.Expression
+    , urlToRoute : Elm.Expression
+    , routeToPath : Elm.Expression
+    , site : Elm.Expression
+    , toJsPort : Elm.Expression
+    , fromJsPort : Elm.Expression
+    , gotBatchSub : Elm.Expression
+    , hotReloadData : Elm.Expression
+    , onPageChange : Elm.Expression
+    , apiRoutes : Elm.Expression
+    , pathPatterns : Elm.Expression
+    , basePath : Elm.Expression
+    , sendPageData : Elm.Expression
+    , byteEncodePageData : Elm.Expression
+    , byteDecodePageData : Elm.Expression
+    , encodeResponse : Elm.Expression
+    , encodeAction : Elm.Expression
+    , decodeResponse : Elm.Expression
+    , globalHeadTags : Elm.Expression
+    , cmdToEffect : Elm.Expression
+    , perform : Elm.Expression
+    , errorStatusCode : Elm.Expression
+    , notFoundPage : Elm.Expression
+    , internalError : Elm.Expression
+    , errorPageToData : Elm.Expression
+    , notFoundRoute : Elm.Expression
+    }
+    -> Elm.Expression
+make_ programConfig_args =
+    Elm.record
+        [ Tuple.pair "init" programConfig_args.init
+        , Tuple.pair "update" programConfig_args.update
+        , Tuple.pair
+            "subscriptions"
+            programConfig_args.subscriptions
+        , Tuple.pair "sharedData" programConfig_args.sharedData
+        , Tuple.pair "data" programConfig_args.data
+        , Tuple.pair "action" programConfig_args.action
+        , Tuple.pair "onActionData" programConfig_args.onActionData
+        , Tuple.pair "view" programConfig_args.view
+        , Tuple.pair "handleRoute" programConfig_args.handleRoute
+        , Tuple.pair
+            "getStaticRoutes"
+            programConfig_args.getStaticRoutes
+        , Tuple.pair "urlToRoute" programConfig_args.urlToRoute
+        , Tuple.pair "routeToPath" programConfig_args.routeToPath
+        , Tuple.pair "site" programConfig_args.site
+        , Tuple.pair "toJsPort" programConfig_args.toJsPort
+        , Tuple.pair "fromJsPort" programConfig_args.fromJsPort
+        , Tuple.pair "gotBatchSub" programConfig_args.gotBatchSub
+        , Tuple.pair
+            "hotReloadData"
+            programConfig_args.hotReloadData
+        , Tuple.pair "onPageChange" programConfig_args.onPageChange
+        , Tuple.pair "apiRoutes" programConfig_args.apiRoutes
+        , Tuple.pair "pathPatterns" programConfig_args.pathPatterns
+        , Tuple.pair "basePath" programConfig_args.basePath
+        , Tuple.pair "sendPageData" programConfig_args.sendPageData
+        , Tuple.pair
+            "byteEncodePageData"
+            programConfig_args.byteEncodePageData
+        , Tuple.pair
+            "byteDecodePageData"
+            programConfig_args.byteDecodePageData
+        , Tuple.pair
+            "encodeResponse"
+            programConfig_args.encodeResponse
+        , Tuple.pair "encodeAction" programConfig_args.encodeAction
+        , Tuple.pair
+            "decodeResponse"
+            programConfig_args.decodeResponse
+        , Tuple.pair
+            "globalHeadTags"
+            programConfig_args.globalHeadTags
+        , Tuple.pair "cmdToEffect" programConfig_args.cmdToEffect
+        , Tuple.pair "perform" programConfig_args.perform
+        , Tuple.pair
+            "errorStatusCode"
+            programConfig_args.errorStatusCode
+        , Tuple.pair "notFoundPage" programConfig_args.notFoundPage
+        , Tuple.pair
+            "internalError"
+            programConfig_args.internalError
+        , Tuple.pair
+            "errorPageToData"
+            programConfig_args.errorPageToData
+        , Tuple.pair
+            "notFoundRoute"
+            programConfig_args.notFoundRoute
+        ]

elm.json

@@ -33,11 +33,13 @@
         "Form",
         "Form.FieldView",
         "Form.Value",
+        "Pages.FormState",
         "Pages.Transition",
         "Pages.Generate",
         "Form.Validation",
         "Pages.Internal.Platform",
         "Pages.Internal.Platform.Cli",
+        "Pages.Internal.ResponseSketch",
         "Pages.Internal.Router",
         "Pages.Internal.RoutePattern",
         "Pages.Internal.NotFoundReason"

generator/src/codegen.js

@@ -29,10 +29,6 @@ async function generate(basePath) {
   const uiFileContent = elmPagesUiFile();
 
   await Promise.all([
-    copyToBoth("Pages/ProgramConfig.elm"),
-    copyToBoth("HtmlPrinter.elm"),
-    copyToBoth("Pages/Internal/ResponseSketch.elm"),
-    copyToBoth("Pages/FormState.elm"),
     copyToBoth("RouteBuilder.elm"),
     copyToBoth("SharedTemplate.elm"),
     copyToBoth("SiteConfig.elm"),
@@ -68,7 +64,6 @@ async function generate(basePath) {
     ),
     // write modified elm.json to elm-stuff/elm-pages/
     copyModifiedElmJson(),
-    ...(await listFiles("./Test")).map(copyToBoth),
     // ...(await listFiles("./Pages/Internal")).map(copyToBoth),
   ]);
 }

src/Pages/FormState.elm

@@ -1,5 +1,11 @@
 module Pages.FormState exposing (Event(..), FieldEvent, FieldState, FormState, PageFormState, init, listeners, setField, setSubmitAttempted, update)
 
+{-|
+
+@docs Event, FieldEvent, FieldState, FormState, PageFormState, init, listeners, setField, setSubmitAttempted, update
+
+-}
+
 import Dict exposing (Dict)
 import Form.FieldStatus as FieldStatus exposing (FieldStatus)
 import Html exposing (Attribute)
@@ -9,6 +15,7 @@ import Json.Decode as Decode exposing (Decoder)
 import Pages.Msg
 
 
+{-| -}
 listeners : String -> List (Attribute (Pages.Msg.Msg userMsg))
 listeners formId =
     [ Html.Events.on "focusin" (Decode.value |> Decode.map Pages.Msg.FormFieldEvent)
@@ -18,6 +25,7 @@ listeners formId =
     ]
 
 
+{-| -}
 type Event
     = InputEvent String
     | FocusEvent
@@ -25,6 +33,7 @@ type Event
     | BlurEvent
 
 
+{-| -}
 type alias FieldEvent =
     { value : String
     , formId : String
@@ -33,6 +42,7 @@ type alias FieldEvent =
     }
 
 
+{-| -}
 fieldEventDecoder : Decoder FieldEvent
 fieldEventDecoder =
     Decode.map4 FieldEvent
@@ -42,6 +52,7 @@ fieldEventDecoder =
         fieldDecoder
 
 
+{-| -}
 inputValueDecoder : Decoder String
 inputValueDecoder =
     Decode.at [ "target", "type" ] Decode.string
@@ -65,6 +76,7 @@ inputValueDecoder =
             )
 
 
+{-| -}
 fieldDecoder : Decoder Event
 fieldDecoder =
     Decode.field "type" Decode.string
@@ -87,6 +99,7 @@ fieldDecoder =
             )
 
 
+{-| -}
 update : Decode.Value -> PageFormState -> PageFormState
 update eventObject pageFormState =
     --if Dict.isEmpty pageFormState then
@@ -114,6 +127,7 @@ update eventObject pageFormState =
             pageFormState
 
 
+{-| -}
 setField : { formId : String, name : String, value : String } -> PageFormState -> PageFormState
 setField info pageFormState =
     pageFormState
@@ -144,6 +158,7 @@ setField info pageFormState =
             )
 
 
+{-| -}
 updateForm : FieldEvent -> FormState -> FormState
 updateForm fieldEvent formState =
     { formState
@@ -172,6 +187,7 @@ updateForm fieldEvent formState =
     }
 
 
+{-| -}
 setSubmitAttempted : String -> PageFormState -> PageFormState
 setSubmitAttempted fieldId pageFormState =
     pageFormState
@@ -186,6 +202,7 @@ setSubmitAttempted fieldId pageFormState =
             )
 
 
+{-| -}
 init : FormState
 init =
     { fields = Dict.empty
@@ -193,22 +210,26 @@ init =
     }
 
 
+{-| -}
 type alias PageFormState =
     Dict String FormState
 
 
+{-| -}
 type alias FormState =
     { fields : Dict String FieldState
     , submitAttempted : Bool
     }
 
 
+{-| -}
 type alias FieldState =
     { value : String
     , status : FieldStatus
     }
 
 
+{-| -}
 increaseStatusTo : FieldStatus -> FieldStatus -> FieldStatus
 increaseStatusTo increaseTo currentStatus =
     if statusRank increaseTo > statusRank currentStatus then
@@ -218,6 +239,7 @@ increaseStatusTo increaseTo currentStatus =
         currentStatus
 
 
+{-| -}
 statusRank : FieldStatus -> Int
 statusRank status =
     case status of

src/Pages/Internal/Platform/Cli.elm

@@ -435,6 +435,10 @@ initLegacy :
     -> ( Model route, Effect )
 initLegacy site renderRequest { staticHttpCache, isDevServer } config =
     let
+        globalHeadTags : DataSource (List Head.Tag)
+        globalHeadTags =
+            (config.globalHeadTags |> Maybe.withDefault (\_ -> DataSource.succeed [])) HtmlPrinter.htmlToString
+
         staticResponses : StaticResponses
         staticResponses =
             case renderRequest of
@@ -463,7 +467,7 @@ initLegacy site renderRequest { staticHttpCache, isDevServer } config =
                                                             DataSource.map3 (\_ _ _ -> ())
                                                                 (config.data serverRequestPayload.frontmatter)
                                                                 config.sharedData
-                                                                (config.globalHeadTags |> Maybe.withDefault (DataSource.succeed []))
+                                                                globalHeadTags
 
                                                         PageServerResponse.ServerResponse _ ->
                                                             DataSource.succeed something
@@ -474,7 +478,7 @@ initLegacy site renderRequest { staticHttpCache, isDevServer } config =
                                         DataSource.map3 (\_ _ _ -> ())
                                             (config.data serverRequestPayload.frontmatter)
                                             config.sharedData
-                                            (config.globalHeadTags |> Maybe.withDefault (DataSource.succeed []))
+                                            globalHeadTags
                                 )
                                 (if isDevServer then
                                     config.handleRoute serverRequestPayload.frontmatter
@@ -487,14 +491,14 @@ initLegacy site renderRequest { staticHttpCache, isDevServer } config =
                             StaticResponses.renderApiRequest
                                 (DataSource.map2 (\_ _ -> ())
                                     (apiRequest.matchesToResponse path)
-                                    (config.globalHeadTags |> Maybe.withDefault (DataSource.succeed []))
+                                    globalHeadTags
                                 )
 
                         RenderRequest.NotFound _ ->
                             StaticResponses.renderApiRequest
                                 (DataSource.map2 (\_ _ -> ())
                                     (DataSource.succeed [])
-                                    (config.globalHeadTags |> Maybe.withDefault (DataSource.succeed []))
+                                    globalHeadTags
                                 )
 
         unprocessedPages : List ( Path, route )
@@ -936,10 +940,14 @@ sendSinglePageProgress site contentJson config model info =
                         contentJson
                         |> Result.mapError (StaticHttpRequest.toBuildError currentUrl.path)
 
+                globalHeadTags : DataSource (List Head.Tag)
+                globalHeadTags =
+                    (config.globalHeadTags |> Maybe.withDefault (\_ -> DataSource.succeed [])) HtmlPrinter.htmlToString
+
                 siteDataResult : Result BuildError (List Head.Tag)
                 siteDataResult =
                     StaticHttpRequest.resolve
-                        (config.globalHeadTags |> Maybe.withDefault (DataSource.succeed []))
+                        globalHeadTags
                         model.allRawResponses
                         |> Result.mapError (StaticHttpRequest.toBuildError "Site.elm")
             in

src/Pages/Internal/ResponseSketch.elm

@@ -1,10 +1,17 @@
 module Pages.Internal.ResponseSketch exposing (ResponseSketch(..))
 
+{-|
+
+@docs ResponseSketch
+
+-}
+
 import Bytes exposing (Bytes)
 import Pages.Internal.NotFoundReason exposing (NotFoundReason)
 import Path exposing (Path)
 
 
+{-| -}
 type ResponseSketch data action shared
     = RenderPage data (Maybe action)
     | HotUpdate data shared (Maybe action)

src/Pages/ProgramConfig.elm

@@ -98,7 +98,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 (DataSource (List Head.Tag))
+    , globalHeadTags : Maybe ((Html Never -> String) -> DataSource (List Head.Tag))
     , cmdToEffect : Cmd userMsg -> effect
     , perform :
         { fetchRouteData :