From 6b1efad0b1d4bc6bf6db2892fd6a55d82c600f07 Mon Sep 17 00:00:00 2001
From: Yann Herklotz <git@yannherklotz.com>
Date: Fri, 12 May 2023 21:45:42 +0100
Subject: Add support for categories and tags

---
 org-zk.cabal         |  1 +
 src/Main.hs          | 13 +++++++------
 src/Zettel/Parse.hs  | 52 ++++++++++++++++++++++++++++++++++------------------
 src/Zettel/Render.hs |  4 ++--
 4 files changed, 44 insertions(+), 26 deletions(-)

diff --git a/org-zk.cabal b/org-zk.cabal
index 7d61a34..fda804d 100644
--- a/org-zk.cabal
+++ b/org-zk.cabal
@@ -34,6 +34,7 @@ executable org-zk
     , text
     , with-utf8
     , directory
+    , filepath
 
   mixins:
     base hiding (Prelude),
diff --git a/src/Main.hs b/src/Main.hs
index 8789ac2..b66d2ab 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -202,14 +202,15 @@ import Zettel
 main :: IO ()
 main = do
   let fl =
-        [ "/home/ymherklotz/Dropbox/zk/verification.org",
-          "/home/ymherklotz/Dropbox/zk/mathematics.org",
-          "/home/ymherklotz/Dropbox/zk/hls.org",
-          "/home/ymherklotz/Dropbox/zk/computing.org",
-          "/home/ymherklotz/Dropbox/zk/hardware.org"
+        [ (3, "/Users/ymherklotz/Dropbox/zk/verification.org"),
+          (4, "/Users/ymherklotz/Dropbox/zk/mathematics.org"),
+          (1, "/Users/ymherklotz/Dropbox/zk/hls.org"),
+          (2, "/Users/ymherklotz/Dropbox/zk/computing.org"),
+          (5, "/Users/ymherklotz/Dropbox/zk/hardware.org"),
+          (6, "/Users/ymherklotz/Dropbox/zk/general.org")
         ]
   graph' <- parseZettelKasten fl
   let graph = transcludeMdAll graph'
   let linkedGraph = linkAll graph
-  renderZettelGraphFile "../zettelkasten/content/zettel" linkedGraph
+  renderZettelGraphFile "../zk-web/content/zettel" linkedGraph
   return ()
diff --git a/src/Zettel/Parse.hs b/src/Zettel/Parse.hs
index 6ce74fd..13d8536 100644
--- a/src/Zettel/Parse.hs
+++ b/src/Zettel/Parse.hs
@@ -11,6 +11,7 @@ import Text.Pandoc.Options (ReaderOptions (..), getDefaultExtensions)
 import Text.Pandoc.Readers (readOrg)
 import Text.Pandoc.Shared (stringify)
 import Text.Pandoc.Walk (query, walk)
+import System.FilePath (takeBaseName)
 import Zettel.Common
 import Zettel.Types
 
@@ -48,12 +49,19 @@ metaToInlines :: MetaValue -> Maybe [Inline]
 metaToInlines (MetaInlines t) = Just t
 metaToInlines _ = Nothing
 
+metaToTextList :: MetaValue -> Maybe [Text]
+metaToTextList (MetaList t) = traverse metaToString t
+metaToTextList _ = Nothing
+
 lookupString :: Text -> Meta -> Maybe Text
 lookupString t m = Map.lookup t (unMeta m) >>= metaToString
 
 lookupInlines :: Text -> Meta -> Maybe [Inline]
 lookupInlines t m = Map.lookup t (unMeta m) >>= metaToInlines
 
+lookupTextList :: Text -> Meta -> Maybe [Text]
+lookupTextList t m = Map.lookup t (unMeta m) >>= metaToTextList
+
 removeSpan :: [Inline] -> [Inline]
 removeSpan = concatMap removeSpan'
   where
@@ -80,32 +88,36 @@ parseDate t
 parseDateVal :: MetaValue -> Maybe MetaValue
 parseDateVal v = MetaString <$> (metaToString v >>= parseDate)
 
-zettelMetaFromMeta :: [ZettelTag] -> Meta -> ZettelMetadata
-zettelMetaFromMeta t m =
+zettelMetaFromMeta :: [ZettelTag] -> [ZettelCat] -> Meta -> ZettelMetadata
+zettelMetaFromMeta t c m =
   ZettelMetadata
     (lookupString "date" m)
     (lookupString "modified" m)
     t
-    cempty
+    c
     (Just "Yann Herklotz")
 
-pandocFromChunk :: Chunk -> Pandoc
-pandocFromChunk c =
+pandocFromChunk :: (Int, Text, Chunk) -> Pandoc
+pandocFromChunk (_, t, c) =
   walk removeMathNL
     . walk removeDiv
     . walk removeHeadings
     . Pandoc
-      (Meta (fromList (("custom_id", MetaString (chunkId c)) : headingMeta)))
+      (Meta (fromList (("categories", toMetaValue [t])
+                       : ("zettelid", MetaString (chunkId c))
+                       : headingMeta)))
     $ chunkContents c
   where
     headingMeta = queryHeaderMetaData $ chunkContents c
 
 zettelFromPandoc :: Pandoc -> (ZettelId, Zettel)
 zettelFromPandoc p@(Pandoc attr _) =
-  (ZettelId ident, Zettel title (zettelMetaFromMeta tags attr) p cempty cempty)
+  (ZettelId ident, Zettel title (zettelMetaFromMeta tags cats attr) p cempty cempty)
   where
-    ident = fromMaybe "" $ lookupString "custom_id" attr
-    (title, tags) = maybe ([], []) separateTitleTags $ lookupInlines "title" attr
+    ident = fromMaybe "" $ lookupString "zettelid" attr
+    title = fromMaybe [] $ lookupInlines "title" attr
+    tags = maybe [] (map ZettelTag) $ lookupTextList "tags" attr
+    cats = maybe [] (map ZettelCat) $ lookupTextList "categories" attr
 
 updatePandocAttr :: Pandoc -> Pandoc
 updatePandocAttr (Pandoc attr b) =
@@ -114,9 +126,9 @@ updatePandocAttr (Pandoc attr b) =
         ( Map.insert
             "tags"
             tags
-            . Map.update
-              (fmap (MetaInlines . fst . separateTitleTags) . metaToInlines)
+            . Map.insert
               "title"
+              (MetaInlines title')
             . Map.update
               parseDateVal
               "modified"
@@ -126,15 +138,19 @@ updatePandocAttr (Pandoc attr b) =
     )
     b
   where
-    tags =
-      toMetaValue . map unZettelTag $
-        maybe [] (snd . separateTitleTags) $
-          lookupInlines "title" attr
+    tags = toMetaValue $ map unZettelTag tags'
+    (title', tags') = maybe ([], []) separateTitleTags $ lookupInlines "title" attr
+
+propagateNames :: [((Int, Text), [Chunk])] -> [(Int, Text, Chunk)]
+propagateNames n =
+  [(i, name, chunk) | ((i, name), namedChunk) <- n, chunk <- namedChunk]
 
-parseZettelKasten :: [FilePath] -> IO ZettelGraph
+parseZettelKasten :: [(Int, FilePath)] -> IO ZettelGraph
 parseZettelKasten fl = do
-  fs <- mapM readFileBS fl
+  let names = map (second (T.pack . takeBaseName)) fl
+  fs <- mapM (readFileBS . snd) fl
   orgFiles <- mapM (runIOorExplode . readOrg (def {readerExtensions = getDefaultExtensions "org"}) . decode) fs
   let splitChunks = map (splitIntoChunks "%i.md" False Nothing 15) orgFiles
-  let pandocList = map (updatePandocAttr . pandocFromChunk) $ concatMap chunkedChunks splitChunks
+  let chunks = propagateNames . zip names $ map chunkedChunks splitChunks
+  let pandocList = map (updatePandocAttr . pandocFromChunk) chunks
   return . refreshPandocMeta . ZettelGraph . fromList $ map zettelFromPandoc pandocList
diff --git a/src/Zettel/Render.hs b/src/Zettel/Render.hs
index 28d6923..b63e0d2 100644
--- a/src/Zettel/Render.hs
+++ b/src/Zettel/Render.hs
@@ -61,10 +61,10 @@ renderZettel _ zettel = do
     if unMB $ query checkCitation zettel.zettelBody
       then
         let pandoc =
-              setMeta "csl" ("/home/ymherklotz/Dropbox/zk/assets/ieee.csl" :: FilePath) $
+              setMeta "csl" ("/Users/ymherklotz/Dropbox/zk/assets/ieee.csl" :: FilePath) $
                 setMeta
                   "bibliography"
-                  (["/home/ymherklotz/bibliography/references.bib"] :: [FilePath])
+                  (["/Users/ymherklotz/bibliography/references.bib"] :: [FilePath])
                   zettel.zettelBody
          in applyFilters
               noEngine
-- 
cgit