From 8d1403b13e75b5eda672af64fb52afe5a0b1f633 Mon Sep 17 00:00:00 2001 From: Yann Herklotz Date: Sun, 28 May 2023 01:55:47 +0100 Subject: Add entry for bib file in graph --- src/Zettel/Common.hs | 3 +- src/Zettel/Links.hs | 15 +++----- src/Zettel/Math.hs | 12 ++----- src/Zettel/Parse.hs | 4 ++- src/Zettel/Transclusion.hs | 2 +- src/Zettel/Types.hs | 86 ++++++++++++++++++++++++++++++++++++++++++++-- 6 files changed, 97 insertions(+), 25 deletions(-) diff --git a/src/Zettel/Common.hs b/src/Zettel/Common.hs index b44d129..f471321 100644 --- a/src/Zettel/Common.hs +++ b/src/Zettel/Common.hs @@ -38,7 +38,8 @@ refreshPandocMetaZettel zid z = z {zettelBody = refreshPandocMetaZettel' zid z . clearPandocAttr $ zettelBody z} refreshPandocMeta :: ZettelGraph -> ZettelGraph -refreshPandocMeta = ZettelGraph . Map.mapWithKey refreshPandocMetaZettel . unZettelGraph +refreshPandocMeta zg = ZettelGraph (Map.mapWithKey refreshPandocMetaZettel zg.unZettelGraph) + zg.zettelGraphBib parseIds :: Text -> Text parseIds t diff --git a/src/Zettel/Links.hs b/src/Zettel/Links.hs index 676f945..39a6f5a 100644 --- a/src/Zettel/Links.hs +++ b/src/Zettel/Links.hs @@ -41,7 +41,8 @@ forwardLinkNode zg ident zn = } forwardLink :: ZettelGraph -> ZettelGraph -forwardLink zg = ZettelGraph . Map.mapWithKey (forwardLinkNode zg) $ unZettelGraph zg +forwardLink zg = ZettelGraph (Map.mapWithKey (forwardLinkNode zg) $ unZettelGraph zg) + zg.zettelGraphBib backwardLinkNode :: ZettelGraph -> ZettelId -> Zettel -> Zettel backwardLinkNode graph ident node = Map.foldlWithKey' f node (unZettelGraph graph) @@ -53,7 +54,8 @@ backwardLinkNode graph ident node = Map.foldlWithKey' f node (unZettelGraph grap | otherwise = l backwardLink :: ZettelGraph -> ZettelGraph -backwardLink zg = ZettelGraph . Map.mapWithKey (backwardLinkNode zg) $ unZettelGraph zg +backwardLink zg = ZettelGraph (Map.mapWithKey (backwardLinkNode zg) $ unZettelGraph zg) + zg.zettelGraphBib updatePandocLinksInline :: Inline -> Inline updatePandocLinksInline l@(Link a i (_, t)) @@ -63,15 +65,8 @@ updatePandocLinksInline l@(Link a i (_, t)) ids = parseIds $ stringify i updatePandocLinksInline i = i -updatePandocLinksPandoc :: Pandoc -> Pandoc -updatePandocLinksPandoc = walk updatePandocLinksInline - -updatePandocLinksZettel :: Zettel -> Zettel -updatePandocLinksZettel zg = - zg {zettelBody = updatePandocLinksPandoc (zettelBody zg)} - updatePandocLinks :: ZettelGraph -> ZettelGraph -updatePandocLinks zg = ZettelGraph $ updatePandocLinksZettel <$> unZettelGraph zg +updatePandocLinks = walk updatePandocLinksInline linkAll :: ZettelGraph -> ZettelGraph linkAll = refreshPandocMeta . backwardLink . forwardLink . updatePandocLinks diff --git a/src/Zettel/Math.hs b/src/Zettel/Math.hs index 226f515..3e51437 100644 --- a/src/Zettel/Math.hs +++ b/src/Zettel/Math.hs @@ -1,8 +1,6 @@ -{-# LANGUAGE OverloadedRecordDot #-} - module Zettel.Math where -import Text.Pandoc.Definition (Inline (..), Pandoc (..)) +import Text.Pandoc.Definition (Inline (..)) import Text.Pandoc.Walk (walk) import Zettel.Types @@ -13,11 +11,5 @@ wrapMath = concatMap f f m@(Math _ _) = [RawInline "markdown" "{{< math >}}", m, RawInline "markdown" "{{< /math >}}"] f a = [a] -wrapMathPandoc :: Pandoc -> Pandoc -wrapMathPandoc = walk wrapMath - -wrapZettel :: Zettel -> Zettel -wrapZettel z = z {zettelBody = wrapMathPandoc z.zettelBody} - wrapZettelGraph :: ZettelGraph -> ZettelGraph -wrapZettelGraph = ZettelGraph . fmap wrapZettel . unZettelGraph +wrapZettelGraph = walk wrapMath diff --git a/src/Zettel/Parse.hs b/src/Zettel/Parse.hs index 13d8536..3fbb37b 100644 --- a/src/Zettel/Parse.hs +++ b/src/Zettel/Parse.hs @@ -153,4 +153,6 @@ parseZettelKasten fl = do let splitChunks = map (splitIntoChunks "%i.md" False Nothing 15) orgFiles let chunks = propagateNames . zip names $ map chunkedChunks splitChunks let pandocList = map (updatePandocAttr . pandocFromChunk) chunks - return . refreshPandocMeta . ZettelGraph . fromList $ map zettelFromPandoc pandocList + return . refreshPandocMeta $ ZettelGraph (fromList $ map zettelFromPandoc pandocList) Nothing + +--parseBibliography :: FilePath -> IO [Pandoc] diff --git a/src/Zettel/Transclusion.hs b/src/Zettel/Transclusion.hs index 63e1271..c9f41cb 100644 --- a/src/Zettel/Transclusion.hs +++ b/src/Zettel/Transclusion.hs @@ -95,4 +95,4 @@ transcludeMdZettel zg zettel = transcludeMdAll :: ZettelGraph -> ZettelGraph transcludeMdAll zg = - ZettelGraph . fmap (transcludeMdZettel zg) $ unZettelGraph zg + ZettelGraph (transcludeMdZettel zg <$> unZettelGraph zg) $ zettelGraphBib zg diff --git a/src/Zettel/Types.hs b/src/Zettel/Types.hs index 65d738e..2b8d23d 100644 --- a/src/Zettel/Types.hs +++ b/src/Zettel/Types.hs @@ -1,6 +1,9 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} module Zettel.Types ( Combine (..), @@ -15,7 +18,8 @@ module Zettel.Types where import Text.Pandoc.Builder (ToMetaValue (..)) -import Text.Pandoc.Definition (Inline (..), Pandoc (..)) +import Text.Pandoc.Definition (Inline (..), Pandoc (..), Block (..), Row (..), Caption (..), TableHead(..), TableBody(..), TableFoot(..), Meta(..), MetaValue(..)) +import Text.Pandoc.Walk (Walkable(..)) class Combine a where cappend :: a -> a -> a @@ -93,5 +97,83 @@ instance Combine Zettel where cempty = Zettel cempty cempty cempty cempty cempty -newtype ZettelGraph = ZettelGraph {unZettelGraph :: Map ZettelId Zettel} +walkMZettel :: (Walkable a Pandoc, Monad m, Applicative m, Functor m) + => (a -> m a) -> Zettel -> m Zettel +walkMZettel f b = do + res <- walkM f (zettelBody b) + return b {zettelBody = res} + +queryZettel f = query f . zettelBody + +instance Walkable Block Zettel where + walkM = walkMZettel + query = queryZettel + +instance Walkable Meta Zettel where + walkM = walkMZettel + query = queryZettel + +instance Walkable [Block] Zettel where + walkM = walkMZettel + query = queryZettel + +instance Walkable Pandoc Zettel where + walkM = walkMZettel + query = queryZettel + +instance Walkable Inline Zettel where + walkM = walkMZettel + query = queryZettel + +instance Walkable MetaValue Zettel where + walkM = walkMZettel + query = queryZettel + +instance Walkable [Inline] Zettel where + walkM = walkMZettel + query = queryZettel + +data ZettelGraph = ZettelGraph + { unZettelGraph :: Map ZettelId Zettel, + zettelGraphBib :: Maybe Pandoc + } deriving (Show, Eq) + +walkMZettelGraph :: (Walkable a Pandoc, Walkable a Zettel, Monad m, Applicative m, Functor m) + => (a -> m a) -> ZettelGraph -> m ZettelGraph +walkMZettelGraph f b = do + res <- traverse (walkM f) (unZettelGraph b) + newBib <- traverse (walkM f) (zettelGraphBib b) + return $ ZettelGraph res newBib + +queryZettelGraph f g = query f (unZettelGraph g) <> maybe mempty (query f) (zettelGraphBib g) + +instance Walkable Block ZettelGraph where + walkM = walkMZettelGraph + query = queryZettelGraph + +instance Walkable Meta ZettelGraph where + walkM = walkMZettelGraph + query = queryZettelGraph + +instance Walkable [Block] ZettelGraph where + walkM = walkMZettelGraph + query = queryZettelGraph + +instance Walkable Pandoc ZettelGraph where + walkM = walkMZettelGraph + query = queryZettelGraph + +instance Walkable Inline ZettelGraph where + walkM = walkMZettelGraph + query = queryZettelGraph + +instance Walkable MetaValue ZettelGraph where + walkM = walkMZettelGraph + query = queryZettelGraph + +instance Walkable [Inline] ZettelGraph where + walkM = walkMZettelGraph + query = queryZettelGraph + +--instance Walkable ZettelGraph -- cgit