Move code over to package for a new design to expose docs for Pages.Platform on package docs site.

This commit is contained in:
Dillon Kearns 2019-10-21 15:25:59 -07:00
parent d1d6d91fa8
commit 0e1fa9d255
6 changed files with 1530 additions and 0 deletions

View File

@ -11,6 +11,7 @@
"Pages.ImagePath",
"Pages.PagePath",
"Pages.Directory",
"Pages.Platform",
"Pages.Manifest",
"Pages.Manifest.Category"
],

490
src/Pages/ContentCache.elm Normal file
View File

@ -0,0 +1,490 @@
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

17
src/Pages/Internal.elm Normal file
View File

@ -0,0 +1,17 @@
module Pages.Internal exposing (..)
import Json.Encode
import Pages.Internal.Platform
type ApplicationType
= Browser
| Cli
type alias Internal pathKey =
{ applicationType : ApplicationType
, content : Pages.Internal.Platform.Content
, pathKey : pathKey
, toJsPort : Json.Encode.Value -> Cmd Never
}

View File

@ -0,0 +1,932 @@
module Pages.Internal.Platform exposing (Content, 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 Never
, 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 >> Cmd.map never) 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 >> Cmd.map never) 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 Never
, 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 )
]
)
|> Cmd.map never
--(Msg userMsg metadata view)
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 )
]
)
|> Cmd.map never
)
, 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 )
]
)
|> Cmd.map never
)
_ ->
( 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)

90
src/Pages/Platform.elm Normal file
View File

@ -0,0 +1,90 @@
module Pages.Platform exposing (application, Program)
{-| TODO
@docs application, Program
-}
import Head
import Html exposing (Html)
import Json.Decode
import Pages.Document as Document
import Pages.Internal
import Pages.Internal.Platform
import Pages.Manifest exposing (DisplayMode, Orientation)
import Pages.PagePath exposing (PagePath)
import Pages.StaticHttp as StaticHttp
{-| TODO
-}
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
, Json.Decode.Value
->
Result String
{ view :
userModel
-> view
->
{ title : String
, body : Html userMsg
}
, head : List (Head.Tag pathKey)
}
)
, documents : List ( String, Document.DocumentHandler metadata view )
, manifest : Pages.Manifest.Config pathKey
, onPageChange : PagePath pathKey -> userMsg
, canonicalSiteUrl : String
, internals : Pages.Internal.Internal pathKey
}
-> Program userModel userMsg metadata view
application config =
case config.internals.applicationType of
Pages.Internal.Browser ->
Pages.Internal.Platform.application
{ init = config.init
, view = config.view
, update = config.update
, subscriptions = config.subscriptions
, document = Document.fromList config.documents
, content = config.internals.content
, toJsPort = config.internals.toJsPort
, manifest = config.manifest
, canonicalSiteUrl = config.canonicalSiteUrl
, onPageChange = config.onPageChange
, pathKey = config.internals.pathKey
}
Pages.Internal.Cli ->
Pages.Internal.Platform.cliApplication
{ init = config.init
, view = config.view
, update = config.update
, subscriptions = config.subscriptions
, document = Document.fromList config.documents
, content = config.internals.content
, toJsPort = config.internals.toJsPort
, manifest = config.manifest
, canonicalSiteUrl = config.canonicalSiteUrl
, onPageChange = config.onPageChange
, pathKey = config.internals.pathKey
}
{-| TODO
-}
type alias Program model msg metadata view =
Pages.Internal.Platform.Program model msg metadata view