Add initial Toc model

emanote/emanote.cabal

@@ -175,6 +175,7 @@ library
     Emanote.Model.Stork.Index
     Emanote.Model.Task
     Emanote.Model.Title
+    Emanote.Model.Toc
     Emanote.Model.Type
     Emanote.Pandoc.BuiltinFilters
     Emanote.Pandoc.ExternalLink
@@ -241,6 +242,7 @@ test-suite test
     other-modules:
       Emanote.Model.Link.RelSpec
       Emanote.Model.QuerySpec
+      Emanote.Model.TocSpec
       Emanote.Pandoc.ExternalLinkSpec
       Emanote.Pandoc.Renderer.CalloutSpec
       Emanote.Route.RSpec

emanote/src/Emanote/Model/Toc.hs

@@ -0,0 +1,37 @@
+module Emanote.Model.Toc where
+
+import Data.Tree qualified as Tree
+import Relude
+import Text.Pandoc
+import Text.Pandoc.Shared (stringify)
+
+type Toc = Tree.Forest DocHeading
+
+data DocHeading = DocHeading
+  { headingId :: Text
+  , headingName :: Text
+  }
+  deriving stock (Show, Eq)
+
+-- | Collect the heading and their level
+pandocToHeadings :: Pandoc -> [(Int, DocHeading)]
+pandocToHeadings (Pandoc _ blocks) = mapMaybe toHeading blocks
+  where
+    toHeading block = case block of
+      Header hlvl (oid, _, _) inlines -> Just (hlvl, DocHeading oid (stringify inlines))
+      _ -> Nothing
+
+-- | Create the Toc
+newToc :: Pandoc -> Toc
+newToc = go [] 1 . pandocToHeadings
+  where
+    go acc lvl ((headingLvl, heading) : rest)
+      | lvl == headingLvl =
+          let
+            -- collect following headings that are childs
+            childs = go [] (lvl + 1) rest
+            newAcc = Tree.Node heading childs : acc
+            childCount = sum $ map length childs
+           in
+            go newAcc lvl (drop childCount rest)
+    go acc _ _ = reverse acc

emanote/test/Emanote/Model/TocSpec.hs

@@ -0,0 +1,34 @@
+module Emanote.Model.TocSpec where
+
+import Control.Monad.Writer (runWriterT)
+import Data.Tree
+import Emanote.Model.Note (parseNoteOrg)
+import Emanote.Model.Toc
+import Relude
+import Test.Hspec
+
+spec :: Spec
+spec = do
+  describe "basic-toc" $ do
+    it "create toc tree" $ do
+      ((doc, _), []) <- runWriterT $ parseNoteOrg demo
+      (fmap headingName <$> newToc doc)
+        `shouldBe` [ Node
+                      { rootLabel = "h1 1"
+                      , subForest =
+                          [ Node {rootLabel = "h2 1", subForest = []}
+                          , Node {rootLabel = "h2 2", subForest = []}
+                          ]
+                      }
+                   , Node {rootLabel = "h1 2", subForest = []}
+                   ]
+  where
+    demo =
+      unlines
+        [ "* h1  1"
+        , "** h2 1"
+        , "** h2 2"
+        , "* h1  2"
+        , -- this is ignored because of missing h2 heading
+          "*** h3 1"
+        ]