mirror of
https://github.com/dillonkearns/elm-pages-v3-beta.git
synced 2024-12-26 13:21:42 +03:00
Stop copying over files that are now moved to public package.
This commit is contained in:
Dillon Kearns
parent
0e1fa9d255
commit
1fc2e80294
@ -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
|
||||
@ -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)
|
||||
@ -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) {
|
||||
|
||||
@ -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();
|
||||
|
||||
|
||||
@ -62,8 +62,7 @@
|
||||
},
|
||||
"files": [
|
||||
"index.js",
|
||||
"generator/src/",
|
||||
"elm-package/src"
|
||||
"generator/src/"
|
||||
],
|
||||
"bin": {
|
||||
"elm-pages": "generator/src/elm-pages.js"
|
||||
|
||||
Loading…
Reference in New Issue
Block a user