From 91891fc4fd29132c19046493358d9fec04447c10 Mon Sep 17 00:00:00 2001
From: Siddharth Bhat <siddu.druid@gmail.com>
Date: Tue, 15 Feb 2022 11:12:17 +0000
Subject: [PATCH] Generate relative paths for documentation.

We keep track of the current nesting depth in our Context,
and use this to generate the correct relative path to the root.
---
 DocGen4/Output.lean      | 29 ++++++++++++++++++-----------
 DocGen4/Output/Base.lean | 15 +++++++++++----
 Main.lean                | 10 ++++------
 3 files changed, 33 insertions(+), 21 deletions(-)

diff --git a/DocGen4/Output.lean b/DocGen4/Output.lean
index 4f549c2..21f28a6 100644
--- a/DocGen4/Output.lean
+++ b/DocGen4/Output.lean
@@ -61,21 +61,24 @@ def sourceLinker : IO (Name → Option DeclarationRange → String) := do
     | some range => s!"{basic}#L{range.pos.line}-L{range.endPos.line}"
     | none => basic
 
-def htmlOutput (result : AnalyzerResult) (root : String) : IO Unit := do
-  let config := { root := root, result := result, currentName := none, sourceLinker := ←sourceLinker}
-  let basePath := FilePath.mk "." / "build" / "doc"
-  let indexHtml := ReaderT.run index config 
-  let notFoundHtml := ReaderT.run notFound config
+def htmlOutput (result : AnalyzerResult) : IO Unit := do
+  let basePath := FilePath.mk "./build/doc/"
+  let config := { depthToRoot := 0, result := result, currentName := none, sourceLinker := ←sourceLinker}
   FS.createDirAll basePath
   FS.createDirAll (basePath / "find")
+  let indexHtml := ReaderT.run index config 
+  let notFoundHtml := ReaderT.run notFound config
 
   let mut declList := #[]
-  for (_, mod) in result.moduleInfo.toArray do
+  for (module, mod) in result.moduleInfo.toArray do
     for decl in filterMapDocInfo mod.members do
-      let findHtml := ReaderT.run (findRedirectHtml decl.getName) config
       let findDir := basePath / "find" / decl.getName.toString
+      let findFile := (findDir / "index.html")
+      -- path: 'basePath/find/decl.getName.toString'
+      let config := { config with depthToRoot := 2 }
+      let findHtml := ReaderT.run (findRedirectHtml decl.getName) config
       FS.createDirAll findDir
-      FS.writeFile (findDir / "index.html") findHtml.toString
+      FS.writeFile findFile findHtml.toString
       let obj := Json.mkObj [("name", decl.getName.toString), ("description", decl.getDocString.getD "")]
       declList := declList.push obj
   let json := Json.arr declList
@@ -88,10 +91,14 @@ def htmlOutput (result : AnalyzerResult) (root : String) : IO Unit := do
   FS.writeFile (basePath / "search.js") searchJs
   FS.writeFile (basePath / "mathjax-config.js") mathjaxConfigJs
   for (module, content) in result.moduleInfo.toArray do
+    let fileDir := moduleNameToDirectory basePath module
+    let filePath := moduleNameToFile basePath module
+    -- path: 'basePath/module/components/till/last.html'
+    -- The last component is the file name, so we drop it from the depth to root.
+    let config := { config with depthToRoot := module.components.dropLast.length }
     let moduleHtml := ReaderT.run (moduleToHtml content) config
-    let path := moduleNameToFile basePath module
-    FS.createDirAll $ moduleNameToDirectory basePath module
-    FS.writeFile path moduleHtml.toString
+    FS.createDirAll $ fileDir
+    FS.writeFile filePath moduleHtml.toString
 
 end DocGen4
 
diff --git a/DocGen4/Output/Base.lean b/DocGen4/Output/Base.lean
index 68812a8..0723518 100644
--- a/DocGen4/Output/Base.lean
+++ b/DocGen4/Output/Base.lean
@@ -14,10 +14,9 @@ open scoped DocGen4.Jsx
 open Lean System Widget Elab
 
 structure SiteContext where
-  root : String
   result : AnalyzerResult
+  depthToRoot: Nat
   currentName : Option Name
-  -- Generates a URL pointing to the source of the given module Name
   sourceLinker : Name → Option DeclarationRange → String
 
 def setCurrentName (name : Name) (ctx : SiteContext) := {ctx with currentName := some name}
@@ -25,7 +24,13 @@ def setCurrentName (name : Name) (ctx : SiteContext) := {ctx with currentName :=
 abbrev HtmlT := ReaderT SiteContext
 abbrev HtmlM := HtmlT Id
 
-def getRoot : HtmlM String := do pure (←read).root
+def getRoot : HtmlM String := do
+  let rec go: Nat -> String
+  | 0 => "./"
+  | Nat.succ n' => "../" ++ go n'
+  let d <- SiteContext.depthToRoot <$> read
+  return (go d)
+
 def getResult : HtmlM AnalyzerResult := do pure (←read).result
 def getCurrentName : HtmlM (Option Name) := do pure (←read).currentName
 def getSourceUrl (module : Name) (range : Option DeclarationRange): HtmlM String := do pure $ (←read).sourceLinker module range
@@ -35,12 +40,14 @@ def templateExtends {α β : Type} (base : α → HtmlM β) (new : HtmlM α) : H
 
 def moduleNameToLink (n : Name) : HtmlM String := do
   let parts := n.components.map Name.toString
-  pure $ (←getRoot) ++ (parts.intersperse "/").foldl (· ++ ·) "" ++ ".html"
+  pure $ (<- getRoot) ++ (parts.intersperse "/").foldl (. ++ ·) "" ++ ".html"
 
 def moduleNameToFile (basePath : FilePath) (n : Name) : FilePath :=
   let parts := n.components.map Name.toString
   FilePath.withExtension (basePath / parts.foldl (· / ·) (FilePath.mk ".")) "html"
 
+
+
 def moduleNameToDirectory (basePath : FilePath) (n : Name) : FilePath :=
   let parts := n.components.dropLast.map Name.toString
   basePath / parts.foldl (· / ·) (FilePath.mk ".")
diff --git a/Main.lean b/Main.lean
index 13e530b..062cf6b 100644
--- a/Main.lean
+++ b/Main.lean
@@ -3,15 +3,13 @@ import Lean
 
 open DocGen4 Lean IO
 
-def main (args : List String) : IO Unit := do
-  if args.isEmpty then
-    IO.println "Usage: doc-gen4 root/url/ Module1 Module2 ..."
+def main (modules : List String) : IO Unit := do
+  if modules.isEmpty then
+    IO.println "Usage: doc-gen4 Module1 Module2 ..."
     IO.Process.exit 1
     return
-  let root := args.head!
-  let modules := args.tail!
   let path ← lakeSetupSearchPath (←getLakePath) modules.toArray
   IO.println s!"Loading modules from: {path}"
   let doc ← load $ modules.map Name.mkSimple
   IO.println "Outputting HTML"
-  htmlOutput doc root
+  htmlOutput doc