Generate navigation from documentation files tree (#74)

* Generate navigation from documentation files tree
KovalevDima · Dec 4, 2024 · 3c182a2 · 3c182a2
1 parent 29039b7
commit 3c182a2
Show file tree

Hide file tree

Showing 6 changed files with 37 additions and 60 deletions.
diff --git a/QA/QA.cabal b/QA/QA.cabal
@@ -37,7 +37,7 @@ executable documentation-compiler
     , filepath
     , time
     , pandoc
-  ghc-options: -threaded
+  ghc-options: -threaded -Wall
 
 -- * Testing
 

diff --git a/QA/README.md b/QA/README.md
@@ -1,11 +1,3 @@
-# Documentation
-
-Want to contribute to library?
-
-- [development](/development)
-- [usage](/usage)
-- [testing](/testing)
-
 # Design
 
 ClickHaskell was designed to **avoid boilerplate** code\

diff --git a/QA/development/README.md b/QA/development/README.md
diff --git a/QA/documentation-compiler/documentation-compiler.hs b/QA/documentation-compiler/documentation-compiler.hs
@@ -1,10 +1,7 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
 
-import Data.List (stripPrefix)
-import Data.Maybe (fromMaybe)
 import GHC.IO.Encoding as Encoding (setLocaleEncoding, utf8)
-import System.FilePath ( (</>), takeDirectory )
+import System.FilePath ((</>), takeFileName, replaceExtension, takeBaseName, normalise, dropFileName, replaceFileName)
 import Hakyll
 
 configuration :: Configuration
@@ -15,35 +12,34 @@ main = do
   Encoding.setLocaleEncoding Encoding.utf8
 
   hakyllWith configuration $ do
-    match "./README.md" $ do
-      route (constRoute "index.html")
-      compile $
-        pandocCompiler
-          >>= loadAndApplyTemplate "documentation-compiler/tmpl-code.html" defaultContext
-          >>= loadAndApplyTemplate "documentation-compiler/tmpl-main.html" defaultContext
-          >>= relativizeUrls
 
-    let indexFilePattern    = "**/README.md" .||. "**/README.lhs"
-        nonIndexFilePattern = "**.lhs" .||. "**.md"
-
-    match
-      (nonIndexFilePattern .&&. complement indexFilePattern)
-      (do
-        route (setExtension "html")
-        compile $
-          pandocCompiler
-            >>= loadAndApplyTemplate "documentation-compiler/tmpl-code.html" defaultContext
-            >>= loadAndApplyTemplate "documentation-compiler/tmpl-main.html" defaultContext
-            >>= relativizeUrls
-      )
-
-    match indexFilePattern
-      $ do
-      route $ customRoute ((</> "index.html") . takeDirectory . toFilePath)
-      compile $
+    match "documentation-compiler/tmpl-*" $ compile templateCompiler
+
+    let pattern = ("**.lhs" .||. "**.md")
+
+    match pattern $ do
+      let
+        filePathToUrlPath filePath =
+          case takeBaseName filePath of
+            "README" -> replaceFileName filePath "index.html"
+            _        -> replaceExtension filePath "html" 
+
+        trailIndexHtml path
+          | takeFileName path == "index.html" = dropFileName path
+          | otherwise                         = path
+
+      route (customRoute $ filePathToUrlPath . toFilePath)
+      compile $ do
+        navigation <-
+          traverse (makeItem . MkNavigationLink . normalise . ("/" </>) . trailIndexHtml . filePathToUrlPath . toFilePath)
+            =<< getMatches pattern
+
         pandocCompiler
           >>= loadAndApplyTemplate "documentation-compiler/tmpl-code.html" defaultContext
-          >>= loadAndApplyTemplate "documentation-compiler/tmpl-main.html" defaultContext
+          >>= loadAndApplyTemplate "documentation-compiler/tmpl-main.html" (defaultContext <> listField "nav" mkLinkCtx (pure navigation))
           >>= relativizeUrls
 
-    match "documentation-compiler/tmpl-*" $ compile templateCompiler
+data NavigationLink = MkNavigationLink { link :: FilePath }
+
+mkLinkCtx :: Context NavigationLink
+mkLinkCtx = mconcat [field "link" (pure . link . itemBody)]
diff --git a/QA/documentation-compiler/tmpl-main.html b/QA/documentation-compiler/tmpl-main.html
@@ -30,7 +30,7 @@
 
 <body>
     <style type="text/css">
-        nav {
+        header {
             padding: 4px 8px;
             align-items: center;
             display: flex;
@@ -42,7 +42,7 @@
         };
         ol li p {margin: 0;}
     </style>
-    <nav>
+    <header>
             <a href="https://github.com/KovalevDima/ClickHaskell">
                 <svg width="36px" xmlns="http://www.w3.org/2000/svg" viewBox="0 0 128 128">
                     <g fill="rgb(240, 246, 252)">
@@ -54,6 +54,13 @@
         <div>
             <a style="font-size:24px; color: rgb(240, 246, 252); text-decoration: none;" href="/">ClickHaskell</a>
         </div>
+    </header>
+    <nav>
+        <ul>
+        $for(nav)$
+            <li><a href="$link$">$link$</a></li>
+        $endfor$
+        </ul>
     </nav>
     <main role="main">
         $body$

diff --git a/QA/usage/README.md b/QA/usage/README.md