Add Transclusion support

7 files changed, 182 insertions, 85 deletions

diff --git a/org-zk.cabal b/org-zk.cabal
index 493813c..7d61a34 100644
--- a/org-zk.cabal
+++ b/org-zk.cabal
@@ -53,6 +53,7 @@ executable org-zk
                     , Zettel.Links
                     , Zettel.Parse
                     , Zettel.Render
+                    , Zettel.Transclusion
                     , Zettel.Types
                     , Paths_org_zk
   hs-source-dirs:     src
diff --git a/src/Main.hs b/src/Main.hs
index 7db7885..88c8d1b 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -202,13 +202,14 @@ import Zettel
 main :: IO ()
 main = do
   let fl =
-        [ "/Users/ymherklotz/Dropbox/zk/verification.org",
-          "/Users/ymherklotz/Dropbox/zk/mathematics.org",
-          "/Users/ymherklotz/Dropbox/zk/hls.org",
-          "/Users/ymherklotz/Dropbox/zk/computing.org",
-          "/Users/ymherklotz/Dropbox/zk/hardware.org"
+        [ "/home/ymherklotz/Dropbox/zk/verification.org",
+          "/home/ymherklotz/Dropbox/zk/mathematics.org",
+          "/home/ymherklotz/Dropbox/zk/hls.org",
+          "/home/ymherklotz/Dropbox/zk/computing.org",
+          "/home/ymherklotz/Dropbox/zk/hardware.org"
         ]
-  graph <- parseZettelKasten fl
+  graph' <- parseZettelKasten fl
+  let graph = transcludeMdAll graph'
   let linkedGraph = linkAll graph
   renderZettelGraphFile "test/content/tree" linkedGraph
   return ()
diff --git a/src/Zettel.hs b/src/Zettel.hs
index c6fe936..8c4720b 100644
--- a/src/Zettel.hs
+++ b/src/Zettel.hs
@@ -3,10 +3,12 @@ module Zettel
     module Zettel.Render,
     module Zettel.Links,
     module Zettel.Parse,
+    module Zettel.Transclusion,
   )
 where
 
 import Zettel.Links
 import Zettel.Parse
 import Zettel.Render
+import Zettel.Transclusion
 import Zettel.Types
diff --git a/src/Zettel/Common.hs b/src/Zettel/Common.hs
index 5ad9ef3..b44d129 100644
--- a/src/Zettel/Common.hs
+++ b/src/Zettel/Common.hs
@@ -2,9 +2,16 @@
 
 module Zettel.Common where
 
+import Data.Char (isAlphaNum, isLetter, isNumber)
+import Data.List (nub)
 import qualified Data.Map.Strict as Map
+import qualified Data.Text as T
+import Data.Text.Read (decimal)
+import Numeric (readInt, showIntAtBase)
 import Text.Pandoc.Builder (HasMeta (..), ToMetaValue (..))
-import Text.Pandoc.Definition (MetaValue (..), Pandoc (..))
+import Text.Pandoc.Definition (Inline (..), MetaValue (..), Pandoc (..))
+import Text.Pandoc.Shared (stringify)
+import Text.Pandoc.Walk (query, walk)
 import Zettel.Types
 
 trySet :: (HasMeta a, ToMetaValue b) => Text -> Maybe b -> a -> a
@@ -32,3 +39,75 @@ refreshPandocMetaZettel zid z =
 
 refreshPandocMeta :: ZettelGraph -> ZettelGraph
 refreshPandocMeta = ZettelGraph . Map.mapWithKey refreshPandocMetaZettel . unZettelGraph
+
+parseIds :: Text -> Text
+parseIds t
+  | T.null t = ""
+  | T.head t == '#' && T.all isAlphaNum (T.tail t) = T.tail t
+  | otherwise = ""
+
+splitId :: ZettelId -> [Text]
+splitId (ZettelId zid)
+  | T.null zid = []
+  | isNumber (T.head zid) = T.takeWhile isNumber zid : (splitId . ZettelId $ T.dropWhile isNumber zid)
+  | isLetter (T.head zid) = T.takeWhile isLetter zid : (splitId . ZettelId $ T.dropWhile isLetter zid)
+  | otherwise = []
+
+combineId :: [Text] -> ZettelId
+combineId = ZettelId . fold
+
+intToDigit26 :: Int -> Char
+intToDigit26 i
+  | i <= 25 && i >= 0 = toEnum $ fromEnum 'a' + i
+  | otherwise = error "Integer out of range."
+
+digitToInt26 :: Char -> Int
+digitToInt26 c = fromEnum c - fromEnum 'a'
+
+fromBase :: Int -> String -> Maybe Int
+fromBase base = fmap fst . viaNonEmpty head . readInt base ((< base) . digitToInt26) digitToInt26
+
+toBase :: Int -> Int -> String
+toBase base num = showIntAtBase base intToDigit26 num ""
+
+opOnBase26 :: (Int -> Int) -> Text -> Maybe Text
+opOnBase26 f t =
+  fromString . toBase 26 . f <$> fromBase 26 (toString t)
+
+opOnIdPart :: (Int -> Int) -> Text -> Maybe Text
+opOnIdPart f t
+  | T.null t = Nothing
+  | isNumber $ T.head t =
+      case decimal t of
+        Right (a, _) -> Just . show $ f a
+        _ -> Nothing
+  | isLetter $ T.head t = opOnBase26 f t
+  | otherwise = Nothing
+
+defPredId :: ZettelId -> Maybe ZettelId
+defPredId z =
+  case nonEmpty (splitId z) of
+    Just ne ->
+      if last ne == "a" || last ne == "1"
+        then Just (combineId (init ne))
+        else combineId . (init ne <>) . (: []) <$> opOnIdPart (subtract 1) (last ne)
+    Nothing -> Nothing
+
+defNextId :: ZettelId -> Maybe ZettelId
+defNextId z =
+  case nonEmpty (splitId z) of
+    Just ne ->
+      combineId . (init ne <>) . (: []) <$> opOnIdPart (+ 1) (last ne)
+    Nothing -> Nothing
+
+defBranchId :: ZettelId -> Maybe ZettelId
+defBranchId (ZettelId t)
+  | T.null t = Nothing
+  | isNumber $ T.last t = Just (ZettelId (t <> "a"))
+  | isLetter $ T.last t = Just (ZettelId (t <> "1"))
+  | otherwise = Nothing
+
+parseLink :: Text -> ZettelId
+parseLink t = ZettelId $ parseIds ident
+  where
+    ident = T.takeWhile (']' /=) $ T.dropWhile ('#' /=) t
diff --git a/src/Zettel/Links.hs b/src/Zettel/Links.hs
index 05659cf..f5638ad 100644
--- a/src/Zettel/Links.hs
+++ b/src/Zettel/Links.hs
@@ -2,87 +2,26 @@
 
 module Zettel.Links where
 
-import Data.Char (isAlphaNum, isLetter, isNumber)
 import Data.List (nub)
 import qualified Data.Map.Strict as Map
 import qualified Data.Text as T
-import Data.Text.Read (decimal)
-import Numeric (readInt, showIntAtBase)
 import Text.Pandoc.Definition (Inline (..), Pandoc (..))
 import Text.Pandoc.Shared (stringify)
 import Text.Pandoc.Walk (query, walk)
 import Zettel.Common
 import Zettel.Types
 
-parseIds :: Text -> Text
-parseIds t
-  | T.null t = ""
-  | T.head t == '#' && T.all isAlphaNum (T.tail t) = T.tail t
-  | otherwise = ""
-
-splitId :: ZettelId -> [Text]
-splitId (ZettelId zid)
-  | T.null zid = []
-  | isNumber (T.head zid) = T.takeWhile isNumber zid : (splitId . ZettelId $ T.dropWhile isNumber zid)
-  | isLetter (T.head zid) = T.takeWhile isLetter zid : (splitId . ZettelId $ T.dropWhile isLetter zid)
-  | otherwise = []
-
-combineId :: [Text] -> ZettelId
-combineId = ZettelId . fold
-
-intToDigit26 :: Int -> Char
-intToDigit26 i
-  | i <= 25 && i >= 0 = toEnum $ fromEnum 'a' + i
-  | otherwise = error "Integer out of range."
-
-digitToInt26 :: Char -> Int
-digitToInt26 c = fromEnum c - fromEnum 'a'
-
-fromBase :: Int -> String -> Maybe Int
-fromBase base = fmap fst . viaNonEmpty head . readInt base ((< base) . digitToInt26) digitToInt26
-
-toBase :: Int -> Int -> String
-toBase base num = showIntAtBase base intToDigit26 num ""
-
-opOnBase26 :: (Int -> Int) -> Text -> Maybe Text
-opOnBase26 f t =
-  fromString . toBase 26 . f <$> fromBase 26 (toString t)
-
-opOnIdPart :: (Int -> Int) -> Text -> Maybe Text
-opOnIdPart f t
-  | T.null t = Nothing
-  | isNumber $ T.head t =
-      case decimal t of
-        Right (a, _) -> Just . show $ f a
-        _ -> Nothing
-  | isLetter $ T.head t = opOnBase26 f t
-  | otherwise = Nothing
-
-defPredId :: ZettelId -> Maybe ZettelId
-defPredId z =
-  case nonEmpty (splitId z) of
-    Just ne ->
-      if last ne == "a" || last ne == "1"
-        then Just (combineId (init ne))
-        else combineId . (init ne <>) . (: []) <$> opOnIdPart (subtract 1) (last ne)
-    Nothing -> Nothing
-
-defNextId :: ZettelId -> Maybe ZettelId
-defNextId z =
-  case nonEmpty (splitId z) of
-    Just ne ->
-      combineId . (init ne <>) . (: []) <$> opOnIdPart (+ 1) (last ne)
-    Nothing -> Nothing
-
-defBranchId :: ZettelId -> Maybe ZettelId
-defBranchId (ZettelId t)
-  | T.null t = Nothing
-  | isNumber $ T.last t = Just (ZettelId (t <> "a"))
-  | isLetter $ T.last t = Just (ZettelId (t <> "1"))
-  | otherwise = Nothing
-
 gatherForwardIds :: Inline -> [ZettelId]
-gatherForwardIds (Link _ i _) = [ZettelId . parseIds $ stringify i]
+gatherForwardIds (Link _ i _)
+  | T.null ident = []
+  | otherwise = [ZettelId ident]
+  where
+    ident = parseIds $ stringify i
+gatherForwardIds (RawInline t v)
+  | t == "markdown" && not (T.null parsed) = [ZettelId parsed]
+  | otherwise = []
+  where
+    parsed = T.takeWhile (/= '"') . T.drop 1 $ T.dropWhile (/= '"') v
 gatherForwardIds _ = []
 
 addIdPresent :: ZettelGraph -> Maybe ZettelId -> [ZettelId]
diff --git a/src/Zettel/Render.hs b/src/Zettel/Render.hs
index 276ea9b..28d6923 100644
--- a/src/Zettel/Render.hs
+++ b/src/Zettel/Render.hs
@@ -2,21 +2,20 @@
 
 module Zettel.Render where
 
-import Control.Monad as M (when)
 import Data.Default (def)
 import qualified Data.Map.Strict as Map
 import qualified Data.Text as T
 import Paths_org_zk (getDataFileName)
 import Text.Pandoc.App (applyFilters)
-import Text.Pandoc.Builder (HasMeta (..), ToMetaValue (..))
+import Text.Pandoc.Builder (HasMeta (..))
 import Text.Pandoc.Class (runIOorExplode)
 import Text.Pandoc.Definition (Block (..), Inline (..))
-import Text.Pandoc.Extensions (Extension (..), disableExtension, enableExtension)
+import Text.Pandoc.Extensions (Extension (..), disableExtension)
 import Text.Pandoc.Filter (Environment (..), Filter (..))
-import Text.Pandoc.Options (CiteMethod (..), ReaderOptions (..), WriterOptions (..), getDefaultExtensions, multimarkdownExtensions)
+import Text.Pandoc.Options (ReaderOptions (..), WriterOptions (..), getDefaultExtensions, multimarkdownExtensions)
 import Text.Pandoc.Scripting (noEngine)
 import Text.Pandoc.Templates (WithDefaultPartials (..), compileTemplate)
-import Text.Pandoc.Walk (query, walk)
+import Text.Pandoc.Walk (query)
 import Text.Pandoc.Writers (writeMarkdown)
 import Zettel.Types
 
@@ -62,10 +61,10 @@ renderZettel _ zettel = do
     if unMB $ query checkCitation zettel.zettelBody
       then
         let pandoc =
-              setMeta "csl" ("/Users/ymherklotz/Dropbox/zk/assets/ieee.csl" :: FilePath) $
+              setMeta "csl" ("/home/ymherklotz/Dropbox/zk/assets/ieee.csl" :: FilePath) $
                 setMeta
                   "bibliography"
-                  (["/Users/ymherklotz/bibliography/references.bib"] :: [FilePath])
+                  (["/home/ymherklotz/bibliography/references.bib"] :: [FilePath])
                   zettel.zettelBody
          in applyFilters
               noEngine
@@ -73,6 +72,9 @@ renderZettel _ zettel = do
                   def {readerExtensions = getDefaultExtensions "org"}
                   writeOpts
                     { writerExtensions =
+                        -- Counter-intuitively, you need to disable citation
+                        -- support so that the citations are inserted in the
+                        -- markdown directly, instead of just referenced.
                         disableExtension Ext_citations writeOpts.writerExtensions
                     }
               )
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