diff --git a/examples/docs/elm.json b/examples/docs/elm.json index 6422dfd0..b7a5c1cd 100644 --- a/examples/docs/elm.json +++ b/examples/docs/elm.json @@ -9,6 +9,7 @@ "dependencies": { "direct": { "avh4/elm-color": "1.0.0", + "billstclair/elm-xml-eeue56": "1.0.1", "dillonkearns/elm-markdown": "1.1.3", "dillonkearns/elm-oembed": "1.0.0", "elm/browser": "1.0.2", diff --git a/examples/docs/src/Feed.elm b/examples/docs/src/Feed.elm new file mode 100644 index 00000000..760ae961 --- /dev/null +++ b/examples/docs/src/Feed.elm @@ -0,0 +1,84 @@ +module Feed exposing (fileToGenerate) + +import Dict +import Metadata exposing (Metadata(..)) +import Pages +import Pages.PagePath as PagePath exposing (PagePath) +import RssFeed +import Time +import Xml +import Xml.Encode exposing (..) + + +fileToGenerate : + String + -> + List + { path : PagePath Pages.PathKey + , frontmatter : Metadata + } + -> + { path : List String + , content : String + } +fileToGenerate siteTagline siteMetadata = + { path = [ "feed.xml" ] + , content = + generate siteTagline siteMetadata |> Xml.Encode.encode 0 + } + + +generate : + String + -> + List + { path : PagePath Pages.PathKey + , frontmatter : Metadata + } + -> Xml.Value +generate siteTagline siteMetadata = + RssFeed.generate + { title = "elm-pages Blog" + , description = siteTagline + , url = "https://elm-pages.com/blog" + , lastBuildTime = Pages.builtAt + , generator = + Just + { name = "elm-pages" + , uri = Just "https://elm-pages.com" + , version = Nothing + } + , items = siteMetadata |> List.filterMap metadataToRssItem + } + + +metadataToRssItem : + { path : PagePath Pages.PathKey + , frontmatter : Metadata + } + -> Maybe RssFeed.Item +metadataToRssItem page = + case page.frontmatter of + Article article -> + Just + { title = article.title + , description = article.description + , url = PagePath.toString page.path + , guid = PagePath.toString page.path + , categories = [] + , author = article.author.name + , pubDate = article.published + , content = Nothing + } + + Page pageMetadata -> + Nothing + + Doc docMetadata -> + Nothing + + Author author -> + Nothing + + BlogIndex -> + Nothing diff --git a/examples/docs/src/Main.elm b/examples/docs/src/Main.elm index 1848b352..f99c31e6 100644 --- a/examples/docs/src/Main.elm +++ b/examples/docs/src/Main.elm @@ -10,6 +10,7 @@ import Element.Background import Element.Border import Element.Font as Font import Element.Region +import Feed import Head import Head.Seo as Seo import Html exposing (Html) @@ -62,11 +63,27 @@ main = , documents = [ markdownDocument ] , manifest = manifest , canonicalSiteUrl = canonicalSiteUrl + , generateFiles = generateFiles , onPageChange = OnPageChange , internals = Pages.internals } +generateFiles : + List + { path : PagePath Pages.PathKey + , frontmatter : Metadata + } + -> + List + { path : List String + , content : String + } +generateFiles siteMetadata = + [ Feed.fileToGenerate siteTagline siteMetadata + ] + + markdownDocument : ( String, Pages.Document.DocumentHandler Metadata ( MarkdownRenderer.TableOfContents, List (Element Msg) ) ) markdownDocument = Pages.Document.parser diff --git a/examples/docs/src/RssFeed.elm b/examples/docs/src/RssFeed.elm new file mode 100644 index 00000000..293f44af --- /dev/null +++ b/examples/docs/src/RssFeed.elm @@ -0,0 +1,131 @@ +module RssFeed exposing (Item, generate) + +import Date exposing (Date) +import Dict +import Time +import Xml +import Xml.Encode exposing (..) + + +type alias Item = + { title : String + , description : String + , url : String + , guid : String + , categories : List String + , author : String + , pubDate : Date + , content : Maybe String + + {- + lat optional number The latitude coordinate of the item. + long optional number The longitude coordinate of the item. + custom_elements optional array Put additional elements in the item (node-xml syntax) + enclosure optional object An enclosure object + -} + } + + +generate : + { title : String + , description : String + , url : String + , lastBuildTime : Time.Posix + , generator : + Maybe + { name : String + , uri : Maybe String + , version : Maybe String + } + , items : List Item + } + -> Xml.Value +generate feed = + let + lastBuildTimeString = + -- TODO + --feed.lastBuildTime + "" + in + object + [ ( "rss" + , Dict.fromList + [ ( "xmlns", string "http://www.w3.org/2005/Atom" ) + , ( "xmlns:dc", string "http://purl.org/dc/elements/1.1/" ) + , ( "xmlns:content", string "http://purl.org/rss/1.0/modules/content/" ) + , ( "xmlns:atom", string "http://www.w3.org/2005/Atom" ) + , ( "version", string "2.0" ) + ] + , object + [ ( "channel" + , Dict.empty + , list + ([ keyValue "title" feed.title + , keyValue "description" feed.description + , keyValue "link" feed.url + , keyValue "lastBuildDate" lastBuildTimeString + ] + ++ List.map itemXml feed.items + ++ ([ feed.generator |> Maybe.map generatorXml + ] + |> List.filterMap identity + ) + ) + ) + ] + ) + ] + + +itemXml : Item -> Xml.Value +itemXml item = + object + [ ( "item" + , Dict.empty + , list + ([ keyValue "title" item.title + , keyValue "description" item.description + , keyValue "link" item.url + , keyValue "guid" item.guid + , keyValue "pubDate" (formatDate item.pubDate) + ] + ++ ([ item.content |> Maybe.map (\content -> keyValue "content" content) + ] + |> List.filterMap identity + ) + ) + ) + ] + + +formatDate : Date -> String +formatDate date = + Date.toIsoString date + + + +--Date.format "EE, dd MM yyyy" date + + +generatorXml : + { name : String + , uri : Maybe String + , version : Maybe String + } + -> Xml.Value +generatorXml generator = + Xml.Encode.object + [ ( "generator" + , [ generator.uri |> Maybe.map (\uri -> ( "uri", string uri )) + , generator.version |> Maybe.map (\version -> ( "version", string version )) + ] + |> List.filterMap identity + |> Dict.fromList + , Xml.Encode.string generator.name + ) + ] + + +keyValue : String -> String -> Xml.Value +keyValue key value = + object [ ( key, Dict.empty, string value ) ] diff --git a/src/Pages/Internal/Platform.elm b/src/Pages/Internal/Platform.elm index 5876f213..e8237152 100644 --- a/src/Pages/Internal/Platform.elm +++ b/src/Pages/Internal/Platform.elm @@ -497,6 +497,16 @@ application : , content : Content , toJsPort : Json.Encode.Value -> Cmd Never , manifest : Manifest.Config pathKey + , generateFiles : + List + { path : PagePath pathKey + , frontmatter : metadata + } + -> + List + { path : List String + , content : String + } , canonicalSiteUrl : String , pathKey : pathKey , onPageChange : PagePath pathKey -> userMsg @@ -564,6 +574,16 @@ cliApplication : , content : Content , toJsPort : Json.Encode.Value -> Cmd Never , manifest : Manifest.Config pathKey + , generateFiles : + List + { path : PagePath pathKey + , frontmatter : metadata + } + -> + List + { path : List String + , content : String + } , canonicalSiteUrl : String , pathKey : pathKey , onPageChange : PagePath pathKey -> userMsg diff --git a/src/Pages/Internal/Platform/Cli.elm b/src/Pages/Internal/Platform/Cli.elm index d3681cd3..b317c42b 100644 --- a/src/Pages/Internal/Platform/Cli.elm +++ b/src/Pages/Internal/Platform/Cli.elm @@ -150,34 +150,47 @@ type Msg = GotStaticHttpResponse { request : { masked : RequestDetails, unmasked : RequestDetails }, response : Result Http.Error String } +type alias Config pathKey userMsg userModel metadata view = + { init : Maybe (PagePath pathKey) -> ( userModel, Cmd userMsg ) + , update : userMsg -> userModel -> ( userModel, Cmd userMsg ) + , subscriptions : userModel -> Sub userMsg + , view : + List ( PagePath pathKey, metadata ) + -> + { path : PagePath pathKey + , frontmatter : metadata + } + -> + StaticHttp.Request + { view : userModel -> view -> { title : String, body : Html userMsg } + , head : List (Head.Tag pathKey) + } + , document : Pages.Document.Document metadata view + , content : Content + , toJsPort : Json.Encode.Value -> Cmd Never + , manifest : Manifest.Config pathKey + , generateFiles : + List + { path : PagePath pathKey + , frontmatter : metadata + } + -> + List + { path : List String + , content : String + } + , canonicalSiteUrl : String + , pathKey : pathKey + , onPageChange : PagePath pathKey -> userMsg + } + + cliApplication : (Msg -> msg) -> (msg -> Maybe Msg) -> (Model -> model) -> (model -> Maybe Model) - -> - { init : Maybe (PagePath pathKey) -> ( userModel, Cmd userMsg ) - , update : userMsg -> userModel -> ( userModel, Cmd userMsg ) - , subscriptions : userModel -> Sub userMsg - , view : - List ( PagePath pathKey, metadata ) - -> - { path : PagePath pathKey - , frontmatter : metadata - } - -> - StaticHttp.Request - { view : userModel -> view -> { title : String, body : Html userMsg } - , head : List (Head.Tag pathKey) - } - , document : Pages.Document.Document metadata view - , content : Content - , toJsPort : Json.Encode.Value -> Cmd Never - , manifest : Manifest.Config pathKey - , canonicalSiteUrl : String - , pathKey : pathKey - , onPageChange : PagePath pathKey -> userMsg - } + -> Config pathKey userMsg userModel metadata view -> Platform.Program Flags model msg cliApplication cliMsgConstructor narrowMsg toModel fromModel config = let @@ -199,7 +212,7 @@ cliApplication cliMsgConstructor narrowMsg toModel fromModel config = \msg model -> case ( narrowMsg msg, fromModel model ) of ( Just cliMsg, Just cliModel ) -> - update config cliMsg cliModel + update siteMetadata config cliMsg cliModel |> Tuple.mapSecond (perform cliMsgConstructor config.toJsPort) |> Tuple.mapFirst toModel @@ -270,21 +283,7 @@ init : (Model -> model) -> ContentCache.ContentCache metadata view -> Result (List BuildError) (List ( PagePath pathKey, metadata )) - -> - { config - | view : - List ( PagePath pathKey, metadata ) - -> - { path : PagePath pathKey - , frontmatter : metadata - } - -> - StaticHttp.Request - { view : userModel -> view -> { title : String, body : Html userMsg } - , head : List (Head.Tag pathKey) - } - , manifest : Manifest.Config pathKey - } + -> Config pathKey userMsg userModel metadata view -> Decode.Value -> ( model, Effect pathKey ) init toModel contentCache siteMetadata config flags = @@ -320,7 +319,7 @@ init toModel contentCache siteMetadata config flags = staticResponsesInit [] ( updatedRawResponses, effect ) = - sendStaticResponsesIfDone mode secrets Dict.empty [] staticResponses config.manifest + sendStaticResponsesIfDone config siteMetadata mode secrets Dict.empty [] staticResponses in ( Model staticResponses secrets [] updatedRawResponses mode |> toModel , effect @@ -346,6 +345,8 @@ init toModel contentCache siteMetadata config flags = staticResponsesInit [] in updateAndSendPortIfDone + config + siteMetadata (Model staticResponses secrets @@ -354,10 +355,11 @@ init toModel contentCache siteMetadata config flags = mode ) toModel - config.manifest Err metadataParserErrors -> updateAndSendPortIfDone + config + siteMetadata (Model Dict.empty secrets (metadataParserErrors |> List.map Tuple.second) @@ -365,10 +367,11 @@ init toModel contentCache siteMetadata config flags = mode ) toModel - config.manifest Err error -> updateAndSendPortIfDone + config + siteMetadata (Model Dict.empty SecretsDict.masked [ { title = "Internal Error" @@ -379,20 +382,25 @@ init toModel contentCache siteMetadata config flags = Dev ) toModel - config.manifest -updateAndSendPortIfDone : Model -> (Model -> model) -> Manifest.Config pathKey -> ( model, Effect pathKey ) -updateAndSendPortIfDone model toModel manifest = +updateAndSendPortIfDone : + Config pathKey userMsg userModel metadata view + -> Result (List BuildError) (List ( PagePath pathKey, metadata )) + -> Model + -> (Model -> model) + -> ( model, Effect pathKey ) +updateAndSendPortIfDone config siteMetadata model toModel = let ( updatedAllRawResponses, effect ) = sendStaticResponsesIfDone + config + siteMetadata model.mode model.secrets model.allRawResponses model.errors model.staticResponses - manifest in ( { model | allRawResponses = updatedAllRawResponses } |> toModel , effect @@ -404,24 +412,12 @@ type alias PageErrors = update : - { config - | view : - List ( PagePath pathKey, metadata ) - -> - { path : PagePath pathKey - , frontmatter : metadata - } - -> - StaticHttp.Request - { view : userModel -> view -> { title : String, body : Html userMsg } - , head : List (Head.Tag pathKey) - } - , manifest : Manifest.Config pathKey - } + Result (List BuildError) (List ( PagePath pathKey, metadata )) + -> Config pathKey userMsg userModel metadata view -> Msg -> Model -> ( Model, Effect pathKey ) -update config msg model = +update siteMetadata config msg model = case msg of GotStaticHttpResponse { request, response } -> let @@ -478,7 +474,7 @@ update config msg model = } ( updatedAllRawResponses, effect ) = - sendStaticResponsesIfDone updatedModel.mode updatedModel.secrets updatedModel.allRawResponses updatedModel.errors updatedModel.staticResponses config.manifest + sendStaticResponsesIfDone config siteMetadata updatedModel.mode updatedModel.secrets updatedModel.allRawResponses updatedModel.errors updatedModel.staticResponses in ( { updatedModel | allRawResponses = updatedAllRawResponses } , effect @@ -607,8 +603,16 @@ isJust maybeValue = False -sendStaticResponsesIfDone : Mode -> SecretsDict -> Dict String (Maybe String) -> List BuildError -> StaticResponses -> Manifest.Config pathKey -> ( Dict String (Maybe String), Effect pathKey ) -sendStaticResponsesIfDone mode secrets allRawResponses errors staticResponses manifest = +sendStaticResponsesIfDone : + Config pathKey userMsg userModel metadata view + -> Result (List BuildError) (List ( PagePath pathKey, metadata )) + -> Mode + -> SecretsDict + -> Dict String (Maybe String) + -> List BuildError + -> StaticResponses + -> ( Dict String (Maybe String), Effect pathKey ) +sendStaticResponsesIfDone config siteMetadata mode secrets allRawResponses errors staticResponses = let pendingRequests = staticResponses @@ -759,6 +763,17 @@ sendStaticResponsesIfDone mode secrets allRawResponses errors staticResponses ma let updatedAllRawResponses = Dict.empty + + generatedFiles = + siteMetadata + |> Result.withDefault [] + |> List.map + (\( pagePath, metadata ) -> + { path = pagePath + , frontmatter = metadata + } + ) + |> config.generateFiles in ( updatedAllRawResponses , SendJsData @@ -766,11 +781,8 @@ sendStaticResponsesIfDone mode secrets allRawResponses errors staticResponses ma Success (ToJsSuccessPayload (encodeStaticResponses mode staticResponses) - manifest - [ { path = [ "hello.txt" ] - , content = "Hello generated files!" - } - ] + config.manifest + generatedFiles ) else diff --git a/src/Pages/Platform.elm b/src/Pages/Platform.elm index da0862ca..1b8afda8 100644 --- a/src/Pages/Platform.elm +++ b/src/Pages/Platform.elm @@ -77,6 +77,16 @@ application : } , documents : List ( String, Document.DocumentHandler metadata view ) , manifest : Pages.Manifest.Config pathKey + , generateFiles : + List + { path : PagePath pathKey + , frontmatter : metadata + } + -> + List + { path : List String + , content : String + } , onPageChange : PagePath pathKey -> userMsg , canonicalSiteUrl : String , internals : Pages.Internal.Internal pathKey @@ -97,6 +107,7 @@ application config = , subscriptions = config.subscriptions , document = Document.fromList config.documents , content = config.internals.content + , generateFiles = config.generateFiles , toJsPort = config.internals.toJsPort , manifest = config.manifest , canonicalSiteUrl = config.canonicalSiteUrl