Add Zettel as source of truth

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}