configurable tocs

1 files changed, 21 insertions, 2 deletions

diff --git a/site.hs b/site.hs
index 35cb2a2..938ef6d 100644
--- a/site.hs
+++ b/site.hs
@@ -3,7 +3,7 @@
 -- | The main deployment script.
 module Main where
 
-import Control.Monad ((>=>), unless, when)
+import Control.Monad ((>=>), unless, when, join)
 import Control.Monad.Extra (whenM)
 import Control.Monad.Trans.State.Lazy
 import qualified Data.Aeson as AE
@@ -15,6 +15,7 @@ import Data.Foldable (traverse_)
 import Data.List (inits, nub, sort)
 import Data.List.Extra (groupSort)
 import qualified Data.Map as M
+import qualified Data.Scientific
 import qualified Data.Set as S
 import Data.String (fromString)
 import qualified Data.Text as T
@@ -36,9 +37,11 @@ import System.FilePath
   )
 import qualified Text.Mustache as Mu
 import Text.Pandoc.Class (runIOorExplode)
+import qualified Text.Pandoc.Definition
 import Text.Pandoc.Readers.Markdown (readMarkdown)
 import Text.Pandoc.Writers (writePlain)
 import Text.Pandoc.Writers.HTML (writeHtml5String)
+import Text.Pandoc.Writers.Shared (toTableOfContents)
 import qualified Text.Parsec.Error
 
 import FormatOpts
@@ -175,6 +178,22 @@ addPageMeta pi (Y.Object m) = do
     to splitDirectories
   pure . Y.Object $ KM.insert "htags" (Y.array htagMeta) m
 
+-- | If viable for a page (by config), add the TOC field
+addTOC :: PageInfo -> Text.Pandoc.Definition.Pandoc -> Y.Value -> Site Y.Value
+addTOC pi doc meta@(Y.Object meta') =
+  let go n = do
+        toc <-
+          io . runIOorExplode $ writeHtml5String htmlWriteOpts $
+          withPandocBlocks
+            (pure . toTableOfContents (tocWriteOpts n))
+            doc
+        pure . Y.Object $ KM.insert "toc" (Y.String toc) meta'
+   in case ( pi ^? pageMeta . key "toc" . _Bool
+           , join $ pi ^? pageMeta . key "toc" . _Number . to Data.Scientific.toBoundedInteger) of
+        (Just False, _) -> pure meta
+        (_, Nothing) -> go (3 :: Int)
+        (_, Just n) -> go n
+
 -- | Render a page using the current template.
 installPage :: FilePath -> PageInfo -> Site ()
 installPage mount pi = do
@@ -189,7 +208,7 @@ installPage mount pi = do
     addHeadingLinks "header-local-anchor" fixedUrlDoc
   let Y.Object meta' = pi ^. pageMeta
       meta = Y.Object $ KM.insert "body" (Y.String body) meta'
-  meta <- addGlobalMeta meta >>= addPageMeta pi
+  meta <- addGlobalMeta meta >>= addTOC pi fixedUrlDoc >>= addPageMeta pi
   io $ do
     putStrLn $ "P -> " ++ file
     makeDirectories file