From c9ad64355e00f56663b84daa3be6c6936c6ae44d Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Thu, 11 May 2023 16:56:01 +0100 Subject: Add Transclusion support --- org-zk.cabal | 1 + src/Main.hs | 13 ++++---- src/Zettel.hs | 2 ++ src/Zettel/Common.hs | 81 +++++++++++++++++++++++++++++++++++++++++++++- src/Zettel/Links.hs | 81 ++++++---------------------------------------- src/Zettel/Render.hs | 16 +++++---- src/Zettel/Transclusion.hs | 73 +++++++++++++++++++++++++++++++++++++++++ 7 files changed, 182 insertions(+), 85 deletions(-) create mode 100644 src/Zettel/Transclusion.hs 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 -- cgit