1 files changed, 73 insertions, 0 deletions
diff --git a/src/Zettel/Transclusion.hs b/src/Zettel/Transclusion.hs
new file mode 100644
index 0000000..86a905b
--- /dev/null
+++ b/src/Zettel/Transclusion.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+module Zettel.Transclusion where
+
+import Data.Map.Strict ((!?))
+import qualified Data.Text as T
+import Text.Pandoc.Definition (Block (..), Inline (..), Pandoc (..))
+import Text.Pandoc.Walk (walk)
+import Zettel.Common
+import Zettel.Types
+
+parseTranscludeBlock :: Text -> ZettelId
+parseTranscludeBlock t = parseLink link
+  where
+    link = T.takeWhile (']' /=) $ T.dropWhile ('[' /=) t
+
+transcludeRawBlockWith' :: (ZettelId -> [Block]) -> Block -> [Block]
+transcludeRawBlockWith' f r@(RawBlock t c)
+  | t == "org" = f $ parseTranscludeBlock c
+  | otherwise = [r]
+transcludeRawBlockWith' _ p = [p]
+
+transcludeRawBlockWith :: (ZettelId -> [Block]) -> [Block] -> [Block]
+transcludeRawBlockWith f = concatMap (transcludeRawBlockWith' f)
+
+transcludeRawBlock :: Block -> Block
+transcludeRawBlock r@(RawBlock t c)
+  | t == "org" =
+      RawBlock "org-zk-transclude" . unZettelId $ parseTranscludeBlock c
+  | otherwise = r
+transcludeRawBlock p = p
+
+markdownIdFormat :: ZettelId -> Text
+markdownIdFormat (ZettelId d) =
+  "{{< transclude zettel=\"" <> d <> "\" >}}"
+
+transcludeToMarkdownLink :: Block -> Block
+transcludeToMarkdownLink r@(RawBlock t c)
+  | t == "org" = Para [Str . markdownIdFormat $ parseTranscludeBlock c]
+  | otherwise = r
+transcludeToMarkdownLink p = p
+
+transclude :: Pandoc -> Pandoc
+transclude = walk transcludeRawBlock
+
+transcludeMdLink :: Pandoc -> Pandoc
+transcludeMdLink = walk transcludeToMarkdownLink
+
+wrapTransclude :: Int -> ZettelId -> [Block] -> [Block]
+wrapTransclude depth zid b =
+  [Para [RawInline "markdown" $ "{{< transclude-" <> show depth <> " zettel=\"" <> unZettelId zid <> "\" >}}"]]
+    <> b
+    <> [Para [RawInline "markdown" $ "{{< /transclude-" <> show depth <> " >}}"]]
+
+transcludeMd :: ZettelGraph -> Int -> Pandoc -> Pandoc
+transcludeMd zg depth = walk (transcludeRawBlockWith f)
+  where
+    f ident =
+      concatMap
+        ( (\(Pandoc _ b) -> wrapTransclude depth ident b)
+            . transcludeMd zg (depth + 1)
+            . zettelBody
+        )
+        . toList
+        $ zg.unZettelGraph !? ident
+
+transcludeMdZettel :: ZettelGraph -> Zettel -> Zettel
+transcludeMdZettel zg zettel =
+  zettel {zettelBody = transcludeMd zg 1 zettel.zettelBody}
+
+transcludeMdAll :: ZettelGraph -> ZettelGraph
+transcludeMdAll zg =
+  ZettelGraph . fmap (transcludeMdZettel zg) $ unZettelGraph zg