feat: Implement visibility in the navbar

main
Henrik Böving 2021-12-13 21:27:08 +01:00
parent d2594669fa
commit ef8ecec0d7
1 changed files with 31 additions and 13 deletions

View File

@ -18,11 +18,15 @@ open IO System
structure SiteContext where structure SiteContext where
root : String root : String
result : AnalyzerResult result : AnalyzerResult
currentName : Option Name
def setCurrentName (name : Name) (ctx : SiteContext) := {ctx with currentName := some name}
abbrev HtmlM := Reader SiteContext abbrev HtmlM := Reader SiteContext
def getRoot : HtmlM String := do (←read).root def getRoot : HtmlM String := do (←read).root
def getResult : HtmlM AnalyzerResult := do (←read).result def getResult : HtmlM AnalyzerResult := do (←read).result
def getCurrentName : HtmlM (Option Name) := do (←read).currentName
def templateExtends {α β : Type} (base : α → HtmlM β) (new : HtmlM α) : HtmlM β := def templateExtends {α β : Type} (base : α → HtmlM β) (new : HtmlM α) : HtmlM β :=
new >>= base new >>= base
@ -38,19 +42,32 @@ def nameToDirectory (basePath : FilePath) (n : Name) : FilePath :=
parts := n.components.dropLast.map Name.toString parts := n.components.dropLast.map Name.toString
def moduleListFile (file : Name) : HtmlM Html := do def moduleListFile (file : Name) : HtmlM Html := do
<div «class»="nav_link"> let attributes := match ←getCurrentName with
<a href={s!"{←getRoot}{nameToUrl file}"}>{file.toString}</a> | some name =>
</div> if file == name then
#[("class", "nav_link"), ("visible", "")]
else
#[("class", "nav_link")]
| none => #[("class", "nav_link")]
let nodes := #[<a href={s!"{←getRoot}{nameToUrl file}"}>{file.toString}</a>]
return Html.element "div" attributes nodes
partial def moduleListDir (h : Hierarchy) : HtmlM Html := do partial def moduleListDir (h : Hierarchy) : HtmlM Html := do
let children := Array.mk (h.getChildren.toList.map Prod.snd) let children := Array.mk (h.getChildren.toList.map Prod.snd)
let dirs := children.filter (λ c => c.getChildren.toList.length != 0) let dirs := children.filter (λ c => c.getChildren.toList.length != 0)
let files := children.filter Hierarchy.isFile |>.map Hierarchy.getName let files := children.filter Hierarchy.isFile |>.map Hierarchy.getName
return <details «class»="nav_sect" «data-path»={nameToUrl h.getName}> let dirNodes ← (dirs.mapM moduleListDir)
<summary>{h.getName.toString}</summary> let fileNodes ← (files.mapM moduleListFile)
[(←(dirs.mapM moduleListDir))] let attributes := match ←getCurrentName with
[(←(files.mapM moduleListFile))] | some name =>
</details> if h.getName.isPrefixOf name then
#[("class", "nav_sect"), ("data-path", nameToUrl h.getName), ("open", "")]
else
#[("class", "nav_sect"), ("data-path", nameToUrl h.getName)]
| none =>
#[("class", "nav_sect"), ("data-path", nameToUrl h.getName)]
let nodes := #[<summary>{h.getName.toString}</summary>] ++ dirNodes ++ fileNodes
return Html.element "details" attributes nodes
def moduleList : HtmlM (Array Html) := do def moduleList : HtmlM (Array Html) := do
let hierarchy := (←getResult).hierarchy let hierarchy := (←getResult).hierarchy
@ -129,14 +146,15 @@ def index : HtmlM Html := do templateExtends (baseHtml "Index") $
def styleCss : String := include_str "./static/style.css" def styleCss : String := include_str "./static/style.css"
def moduleToHtml (module : Module) : HtmlM Html := do templateExtends (baseHtml module.name.toString) $ def moduleToHtml (module : Module) : HtmlM Html := withReader (setCurrentName module.name) do
templateExtends (baseHtml module.name.toString) $
<main> <main>
<h1>This is the page of {module.name.toString}</h1> <h1>This is the page of {module.name.toString}</h1>
</main> </main>
def htmlOutput (result : AnalyzerResult) : IO Unit := do def htmlOutput (result : AnalyzerResult) : IO Unit := do
-- TODO: parameterize this -- TODO: parameterize this
let config := { root := "/", result := result } let config := { root := "/", result := result, currentName := none}
let basePath := FilePath.mk "./build/doc/" let basePath := FilePath.mk "./build/doc/"
let indexHtml := ReaderT.run index config let indexHtml := ReaderT.run index config
let notFoundHtml := ReaderT.run notFound config let notFoundHtml := ReaderT.run notFound config