Move some code back to package instead of copied code.

This commit is contained in:
Dillon Kearns 2022-10-03 14:35:14 -07:00
parent 520961ec32
commit 381b5844f5
14 changed files with 197 additions and 58 deletions

View File

@ -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,12 +1799,15 @@ 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.Declare.fn "globalHeadTags"
( "htmlToString", Nothing )
(\htmlToString ->
Elm.Op.cons
(Elm.value
{ importFrom = [ "Site" ]
, annotation = Nothing
@ -1819,7 +1823,7 @@ otherFile routes phaseString =
}
)
[ getStaticRoutes.reference
, Gen.HtmlPrinter.values_.htmlToString
, htmlToString
]
|> Gen.List.call_.filterMap Gen.ApiRoute.values_.getGlobalHeadTagsDataSource
)
@ -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
]

View File

@ -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"

View File

@ -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),
]);
}

View File

@ -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

View File

@ -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

View File

@ -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)

View File

@ -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 :