From 02d36d9c5c55d49bdfedf29fb9aff9202f19cf53 Mon Sep 17 00:00:00 2001
From: Yann Herklotz <git@yannherklotz.com>
Date: Sun, 28 May 2023 03:52:10 +0100
Subject: Add support for bibliography notes export

---
 src/Zettel/Parse.hs | 52 ++++++++++++++++++++++++----------------------------
 1 file changed, 24 insertions(+), 28 deletions(-)

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

diff --git a/src/Zettel/Parse.hs b/src/Zettel/Parse.hs
index bb08291..943e343 100644
--- a/src/Zettel/Parse.hs
+++ b/src/Zettel/Parse.hs
@@ -41,27 +41,6 @@ queryHeaderMetaData = query headingAttr
       | s == "export_date" = "date"
       | otherwise = s
 
-metaToString :: MetaValue -> Maybe Text
-metaToString (MetaString t) = Just t
-metaToString _ = Nothing
-
-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
@@ -124,6 +103,9 @@ zettelFromPandoc p@(Pandoc attr _) =
     tags = maybe [] (map ZettelTag) $ lookupTextList "tags" attr
     cats = maybe [] (map ZettelCat) $ lookupTextList "categories" attr
 
+bibFromPandoc :: Pandoc -> (BibId, Zettel)
+bibFromPandoc p = first (\(ZettelId i) -> BibId i) $ zettelFromPandoc p
+
 updatePandocAttr :: Pandoc -> Pandoc
 updatePandocAttr (Pandoc attr b) =
   Pandoc
@@ -150,14 +132,28 @@ propagateNames :: [((Int, Text), [Chunk])] -> [(Int, Text, Chunk)]
 propagateNames n =
   [(i, name, chunk) | ((i, name), namedChunk) <- n, chunk <- namedChunk]
 
-parseZettelKasten :: [(Int, FilePath)] -> IO ZettelGraph
-parseZettelKasten fl = do
+readFileUtf8 :: FilePath -> IO Text
+readFileUtf8 = fmap decode . readFileBS
+
+readOrgFile :: Text -> IO Pandoc
+readOrgFile = runIOorExplode . readOrg (def {readerExtensions = getDefaultExtensions "org"})
+
+parseBibliography :: FilePath -> IO [Pandoc]
+parseBibliography fp = do
+  pandoc <- readFileUtf8 fp >>= readOrgFile
+  let splitChunks = chunkedChunks $ splitIntoChunks "%i.md" False Nothing 1 pandoc
+  return $ map (updatePandocAttr . pandocFromChunk . (\c -> (8, "bibliography", c))) splitChunks
+
+parseZettelKasten :: [(Int, FilePath)] -> Maybe FilePath -> IO ZettelGraph
+parseZettelKasten fl bibPath = do
   let names = map (second (T.pack . takeBaseName)) fl
-  fs <- mapM (readFileBS . snd) fl
-  orgFiles <- mapM (runIOorExplode . readOrg (def {readerExtensions = getDefaultExtensions "org"}) . decode) fs
+  fs <- mapM (readFileUtf8 . snd) fl
+  orgFiles <- mapM readOrgFile fs
   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) Nothing
-
--- parseBibliography :: FilePath -> IO [Pandoc]
+  bibliography <- maybe mempty parseBibliography bibPath
+  return . refreshPandocMeta $
+    ZettelGraph
+      (fromList $ map zettelFromPandoc pandocList)
+      (fromList $ map bibFromPandoc bibliography)
-- 
cgit