From 8d1403b13e75b5eda672af64fb52afe5a0b1f633 Mon Sep 17 00:00:00 2001
From: Yann Herklotz <git@yannherklotz.com>
Date: Sun, 28 May 2023 01:55:47 +0100
Subject: Add entry for bib file in graph

---
 src/Zettel/Types.hs | 86 +++++++++++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 84 insertions(+), 2 deletions(-)

(limited to 'src/Zettel/Types.hs')

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