diff --git a/elm-package/src/Pages/ContentCache.elm b/elm-package/src/Pages/ContentCache.elm deleted file mode 100644 index 9ea0171c..00000000 --- a/elm-package/src/Pages/ContentCache.elm +++ /dev/null @@ -1,490 +0,0 @@ -module Pages.ContentCache exposing - ( ContentCache - , Entry(..) - , Page - , Path - , errorView - , extractMetadata - , init - , lazyLoad - , lookup - , lookupMetadata - , pagesWithErrors - , pathForUrl - , routesForCache - , update - ) - -import Dict exposing (Dict) -import Html exposing (Html) -import Html.Attributes as Attr -import Http -import Json.Decode as Decode -import Mark -import Mark.Error -import Pages.Document as Document exposing (Document) -import Pages.PagePath as PagePath exposing (PagePath) -import Result.Extra -import Task exposing (Task) -import Url exposing (Url) -import Url.Builder - - -type alias Content = - List ( List String, { extension : String, frontMatter : String, body : Maybe String } ) - - -type alias ContentCache metadata view = - Result Errors (Dict Path (Entry metadata view)) - - -type alias Errors = - Dict Path String - - -type alias ContentCacheInner metadata view = - Dict Path (Entry metadata view) - - -type Entry metadata view - = NeedContent String metadata - | Unparsed String metadata (ContentJson String) - -- TODO need to have an UnparsedMarkup entry type so the right parser is applied - | Parsed metadata (ContentJson (Result ParseError view)) - - -type alias ParseError = - String - - -type alias Path = - List String - - -extractMetadata : pathKey -> ContentCacheInner metadata view -> List ( PagePath pathKey, metadata ) -extractMetadata pathKey cache = - cache - |> Dict.toList - |> List.map (\( path, entry ) -> ( PagePath.build pathKey path, getMetadata entry )) - - -getMetadata : Entry metadata view -> metadata -getMetadata entry = - case entry of - NeedContent extension metadata -> - metadata - - Unparsed extension metadata _ -> - metadata - - Parsed metadata _ -> - metadata - - -pagesWithErrors : ContentCache metadata view -> Maybe (Dict (List String) String) -pagesWithErrors cache = - cache - |> Result.map - (\okCache -> - okCache - |> Dict.toList - |> List.filterMap - (\( path, value ) -> - case value of - Parsed metadata { body } -> - case body of - Err parseError -> - Just ( path, parseError ) - - _ -> - Nothing - - _ -> - Nothing - ) - ) - |> Result.map - (\errors -> - case errors of - [] -> - Nothing - - _ -> - errors - |> Dict.fromList - |> Just - ) - |> Result.withDefault Nothing - - -init : - Document metadata view - -> Content - -> ContentCache metadata view -init document content = - parseMetadata document content - |> List.map - (\tuple -> - Tuple.mapSecond - (\result -> - result - |> Result.mapError (\error -> ( Tuple.first tuple, error )) - ) - tuple - ) - |> combineTupleResults - |> Result.mapError Dict.fromList - |> Result.map Dict.fromList - - -parseMetadata : - Document metadata view - -> List ( List String, { extension : String, frontMatter : String, body : Maybe String } ) - -> List ( List String, Result String (Entry metadata view) ) -parseMetadata document content = - content - |> List.map - (Tuple.mapSecond - (\{ frontMatter, extension, body } -> - let - maybeDocumentEntry = - Document.get extension document - in - case maybeDocumentEntry of - Just documentEntry -> - frontMatter - |> documentEntry.frontmatterParser - |> Result.map - (\metadata -> - -- TODO do I need to handle this case? - -- case body of - -- Just presentBody -> - -- Parsed metadata - -- { body = parseContent extension presentBody document - -- , staticData = "" - -- } - -- - -- Nothing -> - NeedContent extension metadata - ) - - Nothing -> - Err ("Could not find extension '" ++ extension ++ "'") - ) - ) - - -parseContent : - String - -> String - -> Document metadata view - -> Result String view -parseContent extension body document = - let - maybeDocumentEntry = - Document.get extension document - in - case maybeDocumentEntry of - Just documentEntry -> - documentEntry.contentParser body - - Nothing -> - Err ("Could not find extension '" ++ extension ++ "'") - - -errorView : Errors -> Html msg -errorView errors = - errors - |> Dict.toList - |> List.map errorEntryView - |> Html.div - [ Attr.style "padding" "20px 100px" - ] - - -errorEntryView : ( Path, String ) -> Html msg -errorEntryView ( path, error ) = - Html.div [] - [ Html.h2 [] - [ Html.text ("/" ++ (path |> String.join "/")) - ] - , Html.p [] [ Html.text "I couldn't parse the frontmatter in this page. I ran into this error with your JSON decoder:" ] - , Html.pre [] [ Html.text error ] - ] - - -routes : List ( List String, anything ) -> List String -routes record = - record - |> List.map Tuple.first - |> List.map (String.join "/") - |> List.map (\route -> "/" ++ route) - - -routesForCache : ContentCache metadata view -> List String -routesForCache cacheResult = - case cacheResult of - Ok cache -> - cache - |> Dict.toList - |> routes - - Err _ -> - [] - - -type alias Page metadata view pathKey = - { metadata : metadata - , path : PagePath pathKey - , view : view - } - - -renderErrors : ( List String, List Mark.Error.Error ) -> Html msg -renderErrors ( path, errors ) = - Html.div [] - [ Html.text (path |> String.join "/") - , errors - |> List.map (Mark.Error.toHtml Mark.Error.Light) - |> Html.div [] - ] - - -combineTupleResults : - List ( List String, Result error success ) - -> Result (List error) (List ( List String, success )) -combineTupleResults input = - input - |> List.map - (\( path, result ) -> - result - |> Result.map (\success -> ( path, success )) - ) - |> combine - - -combine : List (Result error ( List String, success )) -> Result (List error) (List ( List String, success )) -combine list = - list - |> List.foldr resultFolder (Ok []) - - -resultFolder : Result error a -> Result (List error) (List a) -> Result (List error) (List a) -resultFolder current soFarResult = - case soFarResult of - Ok soFarOk -> - case current of - Ok currentOk -> - currentOk - :: soFarOk - |> Ok - - Err error -> - Err [ error ] - - Err soFarErr -> - case current of - Ok currentOk -> - Err soFarErr - - Err error -> - error - :: soFarErr - |> Err - - -{-| Get from the Cache... if it's not already parsed, it will -parse it before returning it and store the parsed version in the Cache --} -lazyLoad : - Document metadata view - -> Url - -> ContentCache metadata view - -> Task Http.Error (ContentCache metadata view) -lazyLoad document url cacheResult = - case cacheResult of - Err _ -> - Task.succeed cacheResult - - Ok cache -> - case Dict.get (pathForUrl url) cache of - Just entry -> - case entry of - NeedContent extension _ -> - httpTask url - |> Task.map - (\downloadedContent -> - update cacheResult - (\thing -> - parseContent extension thing document - ) - url - downloadedContent - ) - - Unparsed extension metadata content -> - update cacheResult - (\thing -> - parseContent extension thing document - ) - url - content - |> Task.succeed - - Parsed _ _ -> - Task.succeed cacheResult - - Nothing -> - Task.succeed cacheResult - - -httpTask : Url -> Task Http.Error (ContentJson String) -httpTask url = - Http.task - { method = "GET" - , headers = [] - , url = - Url.Builder.absolute - ((url.path |> String.split "/" |> List.filter (not << String.isEmpty)) - ++ [ "content.json" - ] - ) - [] - , body = Http.emptyBody - , resolver = - Http.stringResolver - (\response -> - case response of - Http.BadUrl_ url_ -> - Err (Http.BadUrl url_) - - Http.Timeout_ -> - Err Http.Timeout - - Http.NetworkError_ -> - Err Http.NetworkError - - Http.BadStatus_ metadata body -> - Err (Http.BadStatus metadata.statusCode) - - Http.GoodStatus_ metadata body -> - body - |> Decode.decodeString contentJsonDecoder - |> Result.mapError (\err -> Http.BadBody (Decode.errorToString err)) - ) - , timeout = Nothing - } - - -type alias ContentJson body = - { body : body - , staticData : Decode.Value - } - - -contentJsonDecoder : Decode.Decoder (ContentJson String) -contentJsonDecoder = - Decode.map2 ContentJson - (Decode.field "body" Decode.string) - (Decode.field "staticData" Decode.value) - - -update : - ContentCache metadata view - -> (String -> Result ParseError view) - -> Url - -> ContentJson String - -> ContentCache metadata view -update cacheResult renderer url rawContent = - case cacheResult of - Ok cache -> - Dict.update (pathForUrl url) - (\entry -> - case entry of - Just (Parsed metadata view) -> - entry - - Just (Unparsed extension metadata content) -> - Parsed metadata - { body = renderer content.body - , staticData = content.staticData - } - |> Just - - Just (NeedContent extension metadata) -> - Parsed metadata - { body = renderer rawContent.body - , staticData = rawContent.staticData - } - |> Just - - Nothing -> - -- TODO this should never happen - Nothing - ) - cache - |> Ok - - Err error -> - -- TODO update this ever??? - -- Should this be something other than the raw HTML, or just concat the error HTML? - Err error - - -pathForUrl : Url -> Path -pathForUrl url = - url.path - |> dropTrailingSlash - |> String.split "/" - |> List.drop 1 - - -lookup : - pathKey - -> ContentCache metadata view - -> Url - -> Maybe ( PagePath pathKey, Entry metadata view ) -lookup pathKey content url = - case content of - Ok dict -> - let - path = - pathForUrl url - in - Dict.get path dict - |> Maybe.map - (\entry -> - ( PagePath.build pathKey path, entry ) - ) - - Err _ -> - Nothing - - -lookupMetadata : - pathKey - -> ContentCache metadata view - -> Url - -> Maybe ( PagePath pathKey, metadata ) -lookupMetadata pathKey content url = - lookup pathKey content url - |> Maybe.map - (\( pagePath, entry ) -> - case entry of - NeedContent _ metadata -> - ( pagePath, metadata ) - - Unparsed _ metadata _ -> - ( pagePath, metadata ) - - Parsed metadata _ -> - ( pagePath, metadata ) - ) - - -dropTrailingSlash path = - if path |> String.endsWith "/" then - String.dropRight 1 path - - else - path diff --git a/elm-package/src/Pages/Platform.elm b/elm-package/src/Pages/Platform.elm deleted file mode 100644 index 04390cb3..00000000 --- a/elm-package/src/Pages/Platform.elm +++ /dev/null @@ -1,928 +0,0 @@ -module Pages.Platform exposing (Flags, Model, Msg, Page, Parser, Program, application, cliApplication) - -import Browser -import Browser.Navigation -import Dict exposing (Dict) -import Head -import Html exposing (Html) -import Html.Attributes -import Http -import Json.Decode as Decode -import Json.Encode -import List.Extra -import Mark -import Pages.ContentCache as ContentCache exposing (ContentCache) -import Pages.Document -import Pages.Manifest as Manifest -import Pages.PagePath as PagePath exposing (PagePath) -import Pages.StaticHttp as StaticHttp -import Pages.StaticHttpRequest as StaticHttpRequest -import Result.Extra -import Task exposing (Task) -import Url exposing (Url) - - -dropTrailingSlash path = - if path |> String.endsWith "/" then - String.dropRight 1 path - - else - path - - -type alias Page metadata view pathKey = - { metadata : metadata - , path : PagePath pathKey - , view : view - } - - -type alias Content = - List ( List String, { extension : String, frontMatter : String, body : Maybe String } ) - - -type alias Program userModel userMsg metadata view = - Platform.Program Flags (Model userModel userMsg metadata view) (Msg userMsg metadata view) - - -mainView : - pathKey - -> - (List ( PagePath pathKey, metadata ) - -> - { path : PagePath pathKey - , frontmatter : metadata - } - -> - ( StaticHttp.Request - , Decode.Value - -> - Result String - { view : - userModel - -> view - -> - { title : String - , body : Html userMsg - } - , head : List (Head.Tag pathKey) - } - ) - ) - -> ModelDetails userModel metadata view - -> { title : String, body : Html userMsg } -mainView pathKey pageView model = - case model.contentCache of - Ok site -> - pageViewOrError pathKey pageView model model.contentCache - - -- TODO these lookup helpers should not need it to be a Result - Err errors -> - { title = "Error parsing" - , body = ContentCache.errorView errors - } - - -urlToPagePath : pathKey -> Url -> PagePath pathKey -urlToPagePath pathKey url = - url.path - |> dropTrailingSlash - |> String.split "/" - |> List.drop 1 - |> PagePath.build pathKey - - -pageViewOrError : - pathKey - -> - (List ( PagePath pathKey, metadata ) - -> - { path : PagePath pathKey - , frontmatter : metadata - } - -> - ( StaticHttp.Request - , Decode.Value - -> - Result String - { view : - userModel - -> view - -> - { title : String - , body : Html userMsg - } - , head : List (Head.Tag pathKey) - } - ) - ) - -> ModelDetails userModel metadata view - -> ContentCache metadata view - -> { title : String, body : Html userMsg } -pageViewOrError pathKey viewFn model cache = - case ContentCache.lookup pathKey cache model.url of - Just ( pagePath, entry ) -> - case entry of - ContentCache.Parsed metadata viewResult -> - let - dummyInputString = - """ 123456789 """ - - viewFnResult = - (viewFn - (cache - |> Result.map (ContentCache.extractMetadata pathKey) - |> Result.withDefault [] - -- TODO handle error better - ) - { path = pagePath, frontmatter = metadata } - |> Tuple.second - ) - viewResult.staticData - in - case viewResult.body of - Ok viewList -> - case viewFnResult of - Ok okViewFn -> - okViewFn.view model.userModel viewList - - Err error -> - { title = "Parsing error" - , body = - Html.text <| - "Could not load static data - TODO better error here." - ++ error - } - - Err error -> - Debug.todo "asdf" - - -- { title = "Parsing error" - -- , body = Html.text error - -- } - ContentCache.NeedContent extension a -> - { title = "", body = Html.text "" } - - -- Debug.todo (Debug.toString a) - ContentCache.Unparsed extension a b -> - -- Debug.todo (Debug.toString b) - { title = "", body = Html.text "" } - - Nothing -> - { title = "Page not found" - , body = - Html.div [] - [ Html.text "Page not found. Valid routes:\n\n" - , cache - |> ContentCache.routesForCache - |> String.join ", " - |> Html.text - ] - } - - -view : - pathKey - -> Content - -> - (List ( PagePath pathKey, metadata ) - -> - { path : PagePath pathKey - , frontmatter : metadata - } - -> - ( StaticHttp.Request - , Decode.Value - -> - Result String - { view : - userModel - -> view - -> - { title : String - , body : Html userMsg - } - , head : List (Head.Tag pathKey) - } - ) - ) - -> ModelDetails userModel metadata view - -> Browser.Document (Msg userMsg metadata view) -view pathKey content viewFn model = - let - { title, body } = - mainView pathKey viewFn model - in - { title = title - , body = - [ onViewChangeElement model.url - , body |> Html.map UserMsg |> Html.map AppMsg - ] - } - - -onViewChangeElement currentUrl = - -- this is a hidden tag - -- it is used from the JS-side to reliably - -- check when Elm has changed pages - -- (and completed rendering the view) - Html.div - [ Html.Attributes.attribute "data-url" (Url.toString currentUrl) - , Html.Attributes.attribute "display" "none" - ] - [] - - -encodeHeads : String -> String -> List (Head.Tag pathKey) -> Json.Encode.Value -encodeHeads canonicalSiteUrl currentPagePath head = - Json.Encode.list (Head.toJson canonicalSiteUrl currentPagePath) head - - -type alias Flags = - {} - - -combineTupleResults : - List ( List String, Result error success ) - -> Result error (List ( List String, success )) -combineTupleResults input = - input - |> List.map - (\( path, result ) -> - result - |> Result.map (\success -> ( path, success )) - ) - |> Result.Extra.combine - - -init : - pathKey - -> String - -> Pages.Document.Document metadata view - -> (Json.Encode.Value -> Cmd (Msg userMsg metadata view)) - -> - (List ( PagePath pathKey, metadata ) - -> - { path : PagePath pathKey - , frontmatter : metadata - } - -> - ( StaticHttp.Request - , Decode.Value - -> - Result String - { view : - userModel - -> view - -> - { title : String - , body : Html userMsg - } - , head : List (Head.Tag pathKey) - } - ) - ) - -> Content - -> (Maybe (PagePath pathKey) -> ( userModel, Cmd userMsg )) - -> Flags - -> Url - -> Browser.Navigation.Key - -> ( ModelDetails userModel metadata view, Cmd (AppMsg userMsg metadata view) ) -init pathKey canonicalSiteUrl document toJsPort viewFn content initUserModel flags url key = - let - contentCache = - ContentCache.init document content - in - case contentCache of - Ok okCache -> - let - ( userModel, userCmd ) = - initUserModel maybePagePath - - cmd = - case ( maybePagePath, maybeMetadata ) of - ( Just pagePath, Just frontmatter ) -> - let - headFnResult = - viewFn - (ContentCache.extractMetadata pathKey okCache) - { path = pagePath - , frontmatter = frontmatter - } - |> Tuple.second - - -- """ 123456789 """ - -- "asdfasdf" - -- |> .head - in - Cmd.batch - [ userCmd |> Cmd.map UserMsg - , contentCache - |> ContentCache.lazyLoad document url - |> Task.attempt UpdateCache - ] - - -- case headFnResult |> Result.map .head of - -- Ok head -> - -- Cmd.batch - -- [ head - -- |> encodeHeads canonicalSiteUrl url.path - -- |> toJsPort - -- , userCmd |> Cmd.map UserMsg - -- , contentCache - -- |> ContentCache.lazyLoad document url - -- |> Task.attempt UpdateCache - -- ] - -- - -- Err error -> - -- Debug.todo error - -- Cmd.none - _ -> - -- Cmd.none - Debug.todo "Error" - - ( maybePagePath, maybeMetadata ) = - case ContentCache.lookupMetadata pathKey (Ok okCache) url of - Just ( pagePath, metadata ) -> - ( Just pagePath, Just metadata ) - - Nothing -> - ( Nothing, Nothing ) - in - ( { key = key - , url = url - , userModel = userModel - , contentCache = contentCache - } - , cmd - ) - - Err _ -> - let - ( userModel, userCmd ) = - initUserModel Nothing - in - ( { key = key - , url = url - , userModel = userModel - , contentCache = contentCache - } - , Cmd.batch - [ userCmd |> Cmd.map UserMsg - ] - -- TODO handle errors better - ) - - -type Msg userMsg metadata view - = AppMsg (AppMsg userMsg metadata view) - | CliMsg CliMsgType - - -type AppMsg userMsg metadata view - = LinkClicked Browser.UrlRequest - | UrlChanged Url.Url - | UserMsg userMsg - | UpdateCache (Result Http.Error (ContentCache metadata view)) - | UpdateCacheAndUrl Url (Result Http.Error (ContentCache metadata view)) - - -type Model userModel userMsg metadata view - = Model (ModelDetails userModel metadata view) - | CliModel - - -type alias ModelDetails userModel metadata view = - { key : Browser.Navigation.Key - , url : Url.Url - , contentCache : ContentCache metadata view - , userModel : userModel - } - - -update : - pathKey - -> (PagePath pathKey -> userMsg) - -> (Json.Encode.Value -> Cmd (Msg userMsg metadata view)) - -> Pages.Document.Document metadata view - -> (userMsg -> userModel -> ( userModel, Cmd userMsg )) - -> Msg userMsg metadata view - -> ModelDetails userModel metadata view - -> ( ModelDetails userModel metadata view, Cmd (AppMsg userMsg metadata view) ) -update pathKey onPageChangeMsg toJsPort document userUpdate msg model = - case msg of - AppMsg appMsg -> - case appMsg of - LinkClicked urlRequest -> - case urlRequest of - Browser.Internal url -> - let - navigatingToSamePage = - url.path == model.url.path - in - if navigatingToSamePage then - -- this is a workaround for an issue with anchor fragment navigation - -- see https://github.com/elm/browser/issues/39 - ( model, Browser.Navigation.load (Url.toString url) ) - - else - ( model, Browser.Navigation.pushUrl model.key (Url.toString url) ) - - Browser.External href -> - ( model, Browser.Navigation.load href ) - - UrlChanged url -> - ( model - , model.contentCache - |> ContentCache.lazyLoad document url - |> Task.attempt (UpdateCacheAndUrl url) - ) - - UserMsg userMsg -> - let - ( userModel, userCmd ) = - userUpdate userMsg model.userModel - in - ( { model | userModel = userModel }, userCmd |> Cmd.map UserMsg ) - - UpdateCache cacheUpdateResult -> - case cacheUpdateResult of - -- TODO can there be race conditions here? Might need to set something in the model - -- to keep track of the last url change - Ok updatedCache -> - ( { model | contentCache = updatedCache }, Cmd.none ) - - Err _ -> - -- TODO handle error - ( model, Cmd.none ) - - UpdateCacheAndUrl url cacheUpdateResult -> - case cacheUpdateResult of - -- TODO can there be race conditions here? Might need to set something in the model - -- to keep track of the last url change - Ok updatedCache -> - let - ( userModel, userCmd ) = - userUpdate - (onPageChangeMsg (url |> urlToPagePath pathKey)) - model.userModel - in - ( { model - | url = url - , contentCache = updatedCache - , userModel = userModel - } - , userCmd |> Cmd.map UserMsg - ) - - Err _ -> - -- TODO handle error - ( { model | url = url }, Cmd.none ) - - CliMsg _ -> - ( model, Cmd.none ) - - -type alias Parser metadata view = - Dict String String - -> List String - -> List ( List String, metadata ) - -> Mark.Document view - - -application : - { 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 - , Decode.Value - -> - Result String - { 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 (Msg userMsg metadata view) - , manifest : Manifest.Config pathKey - , canonicalSiteUrl : String - , pathKey : pathKey - , onPageChange : PagePath pathKey -> userMsg - } - -- -> Program userModel userMsg metadata view - -> Platform.Program Flags (Model userModel userMsg metadata view) (Msg userMsg metadata view) -application config = - Browser.application - { init = - \flags url key -> - init config.pathKey config.canonicalSiteUrl config.document config.toJsPort config.view config.content config.init flags url key - |> Tuple.mapFirst Model - |> Tuple.mapSecond (Cmd.map AppMsg) - , view = - \outerModel -> - case outerModel of - Model model -> - view config.pathKey config.content config.view model - - CliModel -> - { title = "Error" - , body = [ Html.text "Unexpected state" ] - } - , update = - \msg outerModel -> - case outerModel of - Model model -> - update config.pathKey config.onPageChange config.toJsPort config.document config.update msg model - |> Tuple.mapFirst Model - |> Tuple.mapSecond (Cmd.map AppMsg) - - CliModel -> - ( outerModel, Cmd.none ) - , subscriptions = - \outerModel -> - case outerModel of - Model model -> - config.subscriptions model.userModel - |> Sub.map UserMsg - |> Sub.map AppMsg - - CliModel -> - Sub.none - , onUrlChange = UrlChanged >> AppMsg - , onUrlRequest = LinkClicked >> AppMsg - } - - -type CliMsgType - = GotStaticHttpResponse { url : String, response : Result Http.Error String } - - -cliApplication : - { 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 - , Decode.Value - -> - Result String - { 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 (Msg userMsg metadata view) - , manifest : Manifest.Config pathKey - , canonicalSiteUrl : String - , pathKey : pathKey - , onPageChange : PagePath pathKey -> userMsg - } - -> Program userModel userMsg metadata view -cliApplication config = - let - contentCache = - ContentCache.init config.document config.content - - siteMetadata = - contentCache - |> Result.map - (\cache -> cache |> ContentCache.extractMetadata config.pathKey) - |> Result.mapError - (\error -> - error - |> Dict.toList - |> List.map (\( path, errorString ) -> errorString) - ) - in - Platform.worker - { init = - \flags -> - ( CliModel - , case contentCache of - Ok _ -> - case contentCache |> ContentCache.pagesWithErrors of - Just pageErrors -> - let - requests = - siteMetadata - |> Result.andThen - (\metadata -> - staticResponseForPage metadata config.view - ) - - staticResponses : StaticResponses - staticResponses = - case requests of - Ok okRequests -> - staticResponsesInit okRequests - - Err errors -> - Dict.empty - in - config.toJsPort - (Json.Encode.object - [ ( "errors", encodeErrors pageErrors ) - , ( "manifest", Manifest.toJson config.manifest ) - , ( "pages", encodeStaticResponses staticResponses ) - ] - ) - - Nothing -> - let - requests = - siteMetadata - |> Result.andThen - (\metadata -> - staticResponseForPage metadata config.view - ) - - staticResponses : StaticResponses - staticResponses = - case requests of - Ok okRequests -> - staticResponsesInit okRequests - - Err errors -> - Dict.empty - in - Cmd.batch - [ case requests of - Ok okRequests -> - performStaticHttpRequests okRequests - |> Cmd.map CliMsg - - Err errors -> - Cmd.none - ] - - Err error -> - config.toJsPort - (Json.Encode.object - [ ( "errors", encodeErrors error ) - , ( "manifest", Manifest.toJson config.manifest ) - ] - ) - ) - , update = - \msg model -> - case msg of - CliMsg (GotStaticHttpResponse { url, response }) -> - let - requests = - siteMetadata - |> Result.andThen - (\metadata -> - staticResponseForPage metadata config.view - ) - - staticResponses : StaticResponses - staticResponses = - case requests of - Ok okRequests -> - case response of - Ok okResponse -> - staticResponsesInit okRequests - |> staticResponsesUpdate - { url = url - , response = - okResponse - } - - Err error -> - Debug.todo "TODO handle error" - - Err errors -> - Dict.empty - in - ( model - , config.toJsPort - (Json.Encode.object - [ ( "manifest", Manifest.toJson config.manifest ) - , ( "pages", encodeStaticResponses staticResponses ) - ] - ) - ) - - _ -> - ( model, Cmd.none ) - , subscriptions = \_ -> Sub.none - } - - -performStaticHttpRequests : List ( PagePath pathKey, ( StaticHttp.Request, Decode.Value -> Result error value ) ) -> Cmd CliMsgType -performStaticHttpRequests staticRequests = - staticRequests - |> List.map - (\( pagePath, ( StaticHttpRequest.Request { url }, fn ) ) -> - Http.get - { url = url - , expect = - Http.expectString - (\response -> - GotStaticHttpResponse - { url = url - , response = response - } - ) - } - ) - |> Cmd.batch - - - --- --- Http.get --- { url = "" --- , expect = --- Http.expectString --- (\response -> --- GotStaticHttpResponse --- { url = "TODO url" --- , response = response --- } --- ) --- } - - -staticResponsesInit : List ( PagePath pathKey, ( StaticHttp.Request, Decode.Value -> Result error value ) ) -> StaticResponses -staticResponsesInit list = - list - |> List.map (\( path, ( staticRequest, fn ) ) -> ( PagePath.toString path, NotFetched staticRequest )) - |> Dict.fromList - - -staticResponsesUpdate : { url : String, response : String } -> StaticResponses -> StaticResponses -staticResponsesUpdate newEntry staticResponses = - staticResponses - |> Dict.update newEntry.url - (\maybeEntry -> - SuccessfullyFetched (StaticHttpRequest.Request { url = newEntry.url }) newEntry.response - |> Just - ) - - -encodeStaticResponses : StaticResponses -> Json.Encode.Value -encodeStaticResponses staticResponses = - staticResponses - |> Dict.toList - |> List.map - (\( path, result ) -> - ( path - , case result of - NotFetched (StaticHttpRequest.Request { url }) -> - Json.Encode.object - [ ( url - , Json.Encode.string "" - ) - ] - - SuccessfullyFetched (StaticHttpRequest.Request { url }) jsonResponseString -> - Json.Encode.object - [ ( url - , Json.Encode.string jsonResponseString - ) - ] - - ErrorFetching request -> - Json.Encode.string "ErrorFetching" - - ErrorDecoding request -> - Json.Encode.string "ErrorDecoding" - ) - ) - |> Json.Encode.object - - -type alias StaticResponses = - Dict String StaticHttpResult - - -type StaticHttpResult - = NotFetched StaticHttp.Request - | SuccessfullyFetched StaticHttp.Request String - | ErrorFetching StaticHttp.Request - | ErrorDecoding StaticHttp.Request - - -staticResponseForPage : - List ( PagePath pathKey, metadata ) - -> - (List ( PagePath pathKey, metadata ) - -> - { path : PagePath pathKey - , frontmatter : metadata - } - -> - ( StaticHttp.Request - , Decode.Value - -> - Result String - { view : - userModel - -> view - -> - { title : String - , body : Html userMsg - } - , head : List (Head.Tag pathKey) - } - ) - ) - -> - Result (List String) - (List - ( PagePath pathKey - , ( StaticHttp.Request - , Decode.Value - -> - Result String - { view : - userModel - -> view - -> - { title : String - , body : Html userMsg - } - , head : List (Head.Tag pathKey) - } - ) - ) - ) -staticResponseForPage siteMetadata viewFn = - siteMetadata - |> List.map - (\( pagePath, frontmatter ) -> - let - thing = - viewFn siteMetadata - { path = pagePath - , frontmatter = frontmatter - } - in - Ok ( pagePath, thing ) - ) - |> combine - - -combine : List (Result error ( key, success )) -> Result (List error) (List ( key, success )) -combine list = - list - |> List.foldr resultFolder (Ok []) - - -resultFolder : Result error a -> Result (List error) (List a) -> Result (List error) (List a) -resultFolder current soFarResult = - case soFarResult of - Ok soFarOk -> - case current of - Ok currentOk -> - currentOk - :: soFarOk - |> Ok - - Err error -> - Err [ error ] - - Err soFarErr -> - case current of - Ok currentOk -> - Err soFarErr - - Err error -> - error - :: soFarErr - |> Err - - -encodeErrors errors = - errors - |> Json.Encode.dict - (\path -> "/" ++ String.join "/" path) - (\errorsForPath -> Json.Encode.string errorsForPath) diff --git a/generator/src/elm-pages.js b/generator/src/elm-pages.js index 041cfd0c..51bfd438 100755 --- a/generator/src/elm-pages.js +++ b/generator/src/elm-pages.js @@ -84,15 +84,6 @@ function run() { "./gen/Pages.elm", elmPagesUiFile(staticRoutes, markdownContent, content) ); - ensureDirSync("./gen/Pages"); - fs.copyFileSync( - path.resolve(__dirname, "../../elm-package/src/Pages/ContentCache.elm"), - "./gen/Pages/ContentCache.elm" - ); - fs.copyFileSync( - path.resolve(__dirname, "../../elm-package/src/Pages/Platform.elm"), - "./gen/Pages/Platform.elm" - ); console.log("elm-pages DONE"); doCliStuff(staticRoutes, markdownContent, content, function(payload) { if (contents.watch) { diff --git a/generator/src/generate-elm-stuff.js b/generator/src/generate-elm-stuff.js index f6c6bfc5..795f5672 100644 --- a/generator/src/generate-elm-stuff.js +++ b/generator/src/generate-elm-stuff.js @@ -19,16 +19,6 @@ module.exports = function run( elmPagesCliFile(staticRoutes, markdownContent, markupContent) ); - ensureDirSync("./elm-stuff/elm-pages/Pages"); - fs.copyFileSync( - path.resolve(__dirname, "../../elm-package/src/Pages/ContentCache.elm"), - "./elm-stuff/elm-pages/Pages/ContentCache.elm" - ); - fs.copyFileSync( - path.resolve(__dirname, "../../elm-package/src/Pages/Platform.elm"), - "./elm-stuff/elm-pages/Pages/Platform.elm" - ); - // write modified elm.json to elm-stuff/elm-pages/ copyModifiedElmJson(); diff --git a/package.json b/package.json index f3b0d96a..12df4514 100644 --- a/package.json +++ b/package.json @@ -62,8 +62,7 @@ }, "files": [ "index.js", - "generator/src/", - "elm-package/src" + "generator/src/" ], "bin": { "elm-pages": "generator/src/elm-pages.js"