summaryrefslogtreecommitdiffstats
path: root/src/Zettel/Types.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Zettel/Types.hs')
-rw-r--r--src/Zettel/Types.hs86
1 files changed, 84 insertions, 2 deletions
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