From 1c867914453a817c46297eed2734dfc9a62ec869 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Wed, 10 May 2023 17:34:15 +0100 Subject: Add Zettel as source of truth --- data/markdown.template | 2 +- org-zk.cabal | 3 ++- src/Zettel/Links.hs | 40 ++++++++++------------------------------ src/Zettel/Parse.hs | 11 +++++------ src/Zettel/Render.hs | 6 +++--- src/Zettel/Types.hs | 35 +++++++++++++---------------------- 6 files changed, 34 insertions(+), 63 deletions(-) diff --git a/data/markdown.template b/data/markdown.template index 9a36af3..236018f 100644 --- a/data/markdown.template +++ b/data/markdown.template @@ -6,7 +6,7 @@ $endif$tags = [$for(tags)$"$tags$"$sep$, $endfor$] categories = [$for(categories)$"$categories$"$sep$, $endfor$] backlinks = [$for(backlinks)$"$backlinks$"$sep$, $endfor$] forwardlinks = [$for(forwardlinks)$"$forwardlinks$"$sep$, $endfor$] -$if(custom_id)$customid = "$custom_id$" +$if(zettelid)$zettelid = "$zettelid$" $endif$+++ $body$ diff --git a/org-zk.cabal b/org-zk.cabal index 9bb1d2d..493813c 100644 --- a/org-zk.cabal +++ b/org-zk.cabal @@ -49,8 +49,9 @@ executable org-zk main-is: Main.hs other-modules: Zettel - , Zettel.Parse + , Zettel.Common , Zettel.Links + , Zettel.Parse , Zettel.Render , Zettel.Types , Paths_org_zk diff --git a/src/Zettel/Links.hs b/src/Zettel/Links.hs index 6857d45..05659cf 100644 --- a/src/Zettel/Links.hs +++ b/src/Zettel/Links.hs @@ -8,10 +8,10 @@ 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 (..)) 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 @@ -90,12 +90,12 @@ addIdPresent zg (Just ident) = [ident | ident `elem` Map.keys (unZettelGraph zg)] addIdPresent _ Nothing = [] -forwardLinkNode :: ZettelGraph -> ZettelId -> ZettelNode -> ZettelNode +forwardLinkNode :: ZettelGraph -> ZettelId -> Zettel -> Zettel forwardLinkNode zg ident zn = zn - { zettelNodeNext = + { zettelNext = nub - ( query gatherForwardIds (zn.zettelNodeZettel.zettelBody) + ( query gatherForwardIds zn.zettelBody <> addIdPresent zg (defNextId ident) <> addIdPresent zg (defBranchId ident) ) @@ -104,13 +104,13 @@ forwardLinkNode zg ident zn = forwardLink :: ZettelGraph -> ZettelGraph forwardLink zg = ZettelGraph . Map.mapWithKey (forwardLinkNode zg) $ unZettelGraph zg -backwardLinkNode :: ZettelGraph -> ZettelId -> ZettelNode -> ZettelNode +backwardLinkNode :: ZettelGraph -> ZettelId -> Zettel -> Zettel backwardLinkNode graph ident node = Map.foldlWithKey' f node (unZettelGraph graph) where - f :: ZettelNode -> ZettelId -> ZettelNode -> ZettelNode + f :: Zettel -> ZettelId -> Zettel -> Zettel f l ident' zg - | ident `elem` zg.zettelNodeNext = - l {zettelNodePrev = ident' : l.zettelNodePrev} + | ident `elem` zg.zettelNext = + l {zettelPrev = ident' : l.zettelPrev} | otherwise = l backwardLink :: ZettelGraph -> ZettelGraph @@ -127,32 +127,12 @@ updatePandocLinksInline i = i updatePandocLinksPandoc :: Pandoc -> Pandoc updatePandocLinksPandoc = walk updatePandocLinksInline -updatePandocLinksAttr :: [ZettelId] -> [ZettelId] -> Pandoc -> Pandoc -updatePandocLinksAttr back forw = - setMeta "backlinks" back - . setMeta "forwardlinks" forw - updatePandocLinksZettel :: Zettel -> Zettel updatePandocLinksZettel zg = zg {zettelBody = updatePandocLinksPandoc (zettelBody zg)} -updatePandocLinksZettelNode :: ZettelNode -> ZettelNode -updatePandocLinksZettelNode zg = - zg {zettelNodeZettel = updatePandocLinksZettel (zettelNodeZettel zg)} - -updatePandocAttrZettel :: [ZettelId] -> [ZettelId] -> Zettel -> Zettel -updatePandocAttrZettel back forw zg = - zg {zettelBody = updatePandocLinksAttr back forw (zettelBody zg)} - -updatePandocAttrZettelNode :: ZettelNode -> ZettelNode -updatePandocAttrZettelNode zg = - zg {zettelNodeZettel = updatePandocAttrZettel (zettelNodePrev zg) (zettelNodeNext zg) (zettelNodeZettel zg)} - updatePandocLinks :: ZettelGraph -> ZettelGraph -updatePandocLinks zg = ZettelGraph $ updatePandocLinksZettelNode <$> unZettelGraph zg - -updatePandocAttrL :: ZettelGraph -> ZettelGraph -updatePandocAttrL zg = ZettelGraph $ updatePandocAttrZettelNode <$> unZettelGraph zg +updatePandocLinks zg = ZettelGraph $ updatePandocLinksZettel <$> unZettelGraph zg linkAll :: ZettelGraph -> ZettelGraph -linkAll = updatePandocAttrL . backwardLink . forwardLink . updatePandocLinks +linkAll = refreshPandocMeta . backwardLink . forwardLink . updatePandocLinks diff --git a/src/Zettel/Parse.hs b/src/Zettel/Parse.hs index d6d8aa9..cf2604a 100644 --- a/src/Zettel/Parse.hs +++ b/src/Zettel/Parse.hs @@ -10,6 +10,7 @@ import Text.Pandoc.Definition (Block (..), Inline (..), Meta (..), MetaValue (.. import Text.Pandoc.Readers (readOrg) import Text.Pandoc.Shared (stringify) import Text.Pandoc.Walk (query, walk) +import Zettel.Common import Zettel.Types decode :: ByteString -> Text @@ -84,7 +85,8 @@ zettelMetaFromMeta t m = (lookupString "date" m) (lookupString "modified" m) t - [] + cempty + (Just "Yann Herklotz") pandocFromChunk :: Chunk -> Pandoc pandocFromChunk c = @@ -99,14 +101,11 @@ pandocFromChunk c = zettelFromPandoc :: Pandoc -> (ZettelId, Zettel) zettelFromPandoc p@(Pandoc attr _) = - (ZettelId ident, Zettel title (zettelMetaFromMeta tags attr) p) + (ZettelId ident, Zettel title (zettelMetaFromMeta tags attr) p cempty cempty) where ident = fromMaybe "" $ lookupString "custom_id" attr (title, tags) = maybe ([], []) separateTitleTags $ lookupInlines "title" attr -initNode :: Zettel -> ZettelNode -initNode zettel = ZettelNode zettel cempty cempty - updatePandocAttr :: Pandoc -> Pandoc updatePandocAttr (Pandoc attr b) = Pandoc @@ -137,4 +136,4 @@ parseZettelKasten fl = do orgFiles <- mapM (runIOorExplode . readOrg def . decode) fs let splitChunks = map (splitIntoChunks "%i.md" False Nothing 15) orgFiles let pandocList = map (updatePandocAttr . pandocFromChunk) $ concatMap chunkedChunks splitChunks - return . ZettelGraph . fromList $ map (second initNode . zettelFromPandoc) pandocList + return . refreshPandocMeta . ZettelGraph . fromList $ map zettelFromPandoc pandocList diff --git a/src/Zettel/Render.hs b/src/Zettel/Render.hs index c64a910..27e8664 100644 --- a/src/Zettel/Render.hs +++ b/src/Zettel/Render.hs @@ -27,7 +27,7 @@ renderTitleLinks :: Int -> Text -> [ZettelId] -> [Block] renderTitleLinks level title ids = [Header level mempty (toInlines title), renderZettelLinks ids] -renderZettel :: ZettelId -> ZettelNode -> IO Text +renderZettel :: ZettelId -> Zettel -> IO Text renderZettel _ zettel = do templateFile <- getDataFileName "data/markdown.template" template <- decodeUtf8 <$> readFileBS templateFile @@ -35,9 +35,9 @@ renderZettel _ zettel = do runIOorExplode $ writeMarkdown (def {writerTemplate = Just templ, writerExtensions = multimarkdownExtensions}) - (zettel.zettelNodeZettel.zettelBody) + zettel.zettelBody -renderZettelFile :: FilePath -> ZettelId -> ZettelNode -> IO () +renderZettelFile :: FilePath -> ZettelId -> Zettel -> IO () renderZettelFile dir ident zettel = do t <- renderZettel ident zettel writeFileText (dir <> "/" <> toString (unZettelId ident <> ".md")) t diff --git a/src/Zettel/Types.hs b/src/Zettel/Types.hs index 26dee7f..65d738e 100644 --- a/src/Zettel/Types.hs +++ b/src/Zettel/Types.hs @@ -10,7 +10,6 @@ module Zettel.Types ZettelTag (..), ZettelMetadata (..), Zettel (..), - ZettelNode (..), ZettelGraph (..), ) where @@ -62,15 +61,17 @@ data ZettelMetadata = ZettelMetadata -- | Optional tags. zettelTags :: [ZettelTag], -- | Optional Category - zettelCategory :: [ZettelCat] + zettelCats :: [ZettelCat], + -- | Author + zettelAuthor :: Maybe Text } deriving (Show, Eq) instance Combine ZettelMetadata where - cappend (ZettelMetadata c m t a) (ZettelMetadata c' m' t' a') = - ZettelMetadata (cappend c c') (cappend m m') (cappend t t') (cappend a a') + cappend (ZettelMetadata c m t a b) (ZettelMetadata c' m' t' a' b') = + ZettelMetadata (cappend c c') (cappend m m') (cappend t t') (cappend a a') (cappend b b') - cempty = ZettelMetadata cempty cempty cempty cempty + cempty = ZettelMetadata cempty cempty cempty cempty cempty data Zettel = Zettel { -- | The title of the Zettel, which should also be present in the body, @@ -80,27 +81,17 @@ data Zettel = Zettel zettelMetadata :: ZettelMetadata, -- | The text body of the Zettel, which is stored as a Pandoc document to -- make it easy to export to other documents. - zettelBody :: Pandoc + zettelBody :: Pandoc, + zettelNext :: [ZettelId], + zettelPrev :: [ZettelId] } deriving (Show, Eq) instance Combine Zettel where - cappend (Zettel b c d) (Zettel b' c' d') = - Zettel (cappend b b') (cappend c c') (cappend d d') + cappend (Zettel b c d e f) (Zettel b' c' d' e' f') = + Zettel (cappend b b') (cappend c c') (cappend d d') (cappend e e') (cappend f f') - cempty = Zettel cempty cempty cempty + cempty = Zettel cempty cempty cempty cempty cempty -data ZettelNode = ZettelNode - { zettelNodeZettel :: Zettel, - zettelNodeNext :: [ZettelId], - zettelNodePrev :: [ZettelId] - } +newtype ZettelGraph = ZettelGraph {unZettelGraph :: Map ZettelId Zettel} deriving (Show, Eq) - -instance Combine ZettelNode where - cappend (ZettelNode b c d) (ZettelNode b' c' d') = - ZettelNode (cappend b b') (cappend c c') (cappend d d') - - cempty = ZettelNode cempty cempty cempty - -newtype ZettelGraph = ZettelGraph {unZettelGraph :: Map ZettelId ZettelNode} -- cgit