mirror of
https://github.com/roc-lang/roc.git
synced 2025-10-02 16:21:11 +00:00
8dedd9f03c
Implements the new app header syntax as discussed in Zulip [1].
app [main] {
cli: platform "../platform/main.roc",
json: "../json/main.roc"
}
Old headers still parse and are automatically upgraded to the new
syntax by the formatter.
[1] 418444862
65 lines
2.1 KiB
Text
65 lines
2.1 KiB
Text
app [transformFileContent] { pf: platform "platform/main.roc" }
|
|
|
|
import pf.Html exposing [html, head, body, div, text, a, ul, li, link, meta]
|
|
import pf.Html.Attributes exposing [httpEquiv, content, href, rel, lang, class, title]
|
|
|
|
NavLink : {
|
|
url : Str,
|
|
title : Str,
|
|
text : Str,
|
|
}
|
|
|
|
navLinks : List NavLink
|
|
navLinks = [
|
|
{ url: "subFolder/apple.html", title: "Exempli Gratia Pagina Pomi", text: "Apple" },
|
|
{ url: "banana.html", title: "Exempli Gratia Pagina Musa", text: "Banana" },
|
|
{ url: "cherry.html", title: "Exempli Pagina Cerasus", text: "Cherry" },
|
|
]
|
|
|
|
transformFileContent : Str, Str -> Str
|
|
transformFileContent = \currentUrl, htmlContent ->
|
|
List.findFirst navLinks (\{ url } -> url == currentUrl)
|
|
|> Result.map (\currentNavLink -> view currentNavLink htmlContent)
|
|
|> Result.map Html.render
|
|
|> Result.withDefault ""
|
|
|
|
view : NavLink, Str -> Html.Node
|
|
view = \currentNavLink, htmlContent ->
|
|
html [lang "en"] [
|
|
head [] [
|
|
meta [httpEquiv "content-type", content "text/html; charset=utf-8"],
|
|
Html.title [] [text currentNavLink.title],
|
|
link [rel "stylesheet", href "style.css"],
|
|
],
|
|
body [] [
|
|
div [class "main"] [
|
|
div [class "navbar"] [
|
|
viewNavbar currentNavLink,
|
|
],
|
|
div [class "article"] [
|
|
# For now `text` is not escaped so we can use it to insert HTML
|
|
# We'll probably want something more explicit in the long term though!
|
|
text htmlContent,
|
|
],
|
|
],
|
|
],
|
|
]
|
|
|
|
viewNavbar : NavLink -> Html.Node
|
|
viewNavbar = \currentNavLink ->
|
|
ul
|
|
[]
|
|
(List.map navLinks \nl -> viewNavLink (nl == currentNavLink) nl)
|
|
|
|
viewNavLink : Bool, NavLink -> Html.Node
|
|
viewNavLink = \isCurrent, navlink ->
|
|
if isCurrent then
|
|
li [class "nav-link nav-link--current"] [
|
|
text navlink.text,
|
|
]
|
|
else
|
|
li [class "nav-link"] [
|
|
a
|
|
[href navlink.url, title navlink.title]
|
|
[text navlink.text],
|
|
]
|