Add entry for bib file in graph

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