Add support for bibliography notes export

8 files changed, 103 insertions, 42 deletions

diff --git a/org-zk.cabal b/org-zk.cabal
index bca2ac2..5170bd1 100644
--- a/org-zk.cabal
+++ b/org-zk.cabal
@@ -50,6 +50,7 @@ executable org-zk
 
   main-is:            Main.hs
   other-modules:      Zettel
+                    , Zettel.Bibliography
                     , Zettel.Common
                     , Zettel.Links
                     , Zettel.Math
diff --git a/src/Main.hs b/src/Main.hs
index 002fbff..c819300 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -262,7 +262,7 @@ options =
     Option
       []
       ["org-bibliography"]
-      (ReqArg (\f opts -> opts {optBibliography = Just f}) "FILE")
+      (ReqArg (\f opts -> opts {optOrgBibliography = Just f}) "FILE")
       "Bibliography FILE (default: bibliography.org)",
     Option
       ['q']
@@ -305,11 +305,9 @@ main = do
     putStrLn version
     exitSuccess
 
-  graph' <- parseZettelKasten $ zip [1 ..] fl
+  graph <- parseZettelKasten (zip [1 ..] fl) (optOrgBibliography zkOpts)
 
-  let graph = transcludeMdAll graph'
-  let linkedGraph = linkAll graph
-  let wrappedGraph = wrapZettelGraph linkedGraph
+  let pipeline = transcludeMdAll >> linkAll >> wrapZettelGraph >> handleBibliography
 
   renderZettelGraphFile
     (optVerbose zkOpts)
@@ -319,4 +317,4 @@ main = do
     )
     (optBibliography zkOpts)
     (fromMaybe "output" (optOutput zkOpts))
-    wrappedGraph
+    (pipeline graph)
diff --git a/src/Zettel.hs b/src/Zettel.hs
index 63b4910..7c85ae6 100644
--- a/src/Zettel.hs
+++ b/src/Zettel.hs
@@ -5,9 +5,11 @@ module Zettel
     module Zettel.Parse,
     module Zettel.Transclusion,
     module Zettel.Math,
+    module Zettel.Bibliography,
   )
 where
 
+import Zettel.Bibliography
 import Zettel.Links
 import Zettel.Math
 import Zettel.Parse
diff --git a/src/Zettel/Bibliography.hs b/src/Zettel/Bibliography.hs
new file mode 100644
index 0000000..6186917
--- /dev/null
+++ b/src/Zettel/Bibliography.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+module Zettel.Bibliography where
+
+import Text.Pandoc.Definition (Citation (..), Inline (..), Target (..))
+import Text.Pandoc.Walk (walk)
+import Zettel.Types
+
+replaceCitation :: Citation -> ([Inline], Target)
+replaceCitation c =
+  ([Str $ "@" <> zid], ("/bib/" <> zid, ""))
+  where
+    zid = citationId c
+
+replaceCite :: Inline -> [Inline]
+replaceCite (Cite c _) =
+  [Str "("] <> map (uncurry (Link mempty) . replaceCitation) c <> [Str ")"]
+replaceCite c = [c]
+
+replaceCites :: [Inline] -> [Inline]
+replaceCites = concatMap replaceCite
+
+handleBibliography :: ZettelGraph -> ZettelGraph
+handleBibliography zg =
+  if null zg.zettelGraphBib then zg else zg {unZettelGraph = walk replaceCites zg.unZettelGraph}
diff --git a/src/Zettel/Common.hs b/src/Zettel/Common.hs
index 7b77417..515ebd5 100644
--- a/src/Zettel/Common.hs
+++ b/src/Zettel/Common.hs
@@ -8,7 +8,7 @@ import qualified Data.Text as T
 import Data.Text.Read (decimal)
 import Numeric (readInt, showIntAtBase)
 import Text.Pandoc.Builder (HasMeta (..), ToMetaValue (..))
-import Text.Pandoc.Definition (MetaValue (..), Pandoc (..))
+import Text.Pandoc.Definition (Inline (..), Meta (..), MetaValue (..), Pandoc (..))
 import Zettel.Types
 
 trySet :: (HasMeta a, ToMetaValue b) => Text -> Maybe b -> a -> a
@@ -111,3 +111,24 @@ parseLink :: Text -> ZettelId
 parseLink t = ZettelId $ parseIds ident
   where
     ident = T.takeWhile (']' /=) $ T.dropWhile ('#' /=) t
+
+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
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)
diff --git a/src/Zettel/Render.hs b/src/Zettel/Render.hs
index 2451163..662742d 100644
--- a/src/Zettel/Render.hs
+++ b/src/Zettel/Render.hs
@@ -10,7 +10,7 @@ import System.FilePath ((<.>), (</>))
 import Text.Pandoc.App (applyFilters)
 import Text.Pandoc.Builder (HasMeta (..))
 import Text.Pandoc.Class (runIOorExplode)
-import Text.Pandoc.Definition (Block (..), Inline (..))
+import Text.Pandoc.Definition (Block (..), Inline (..), Meta (..), MetaValue (..), Pandoc (..))
 import Text.Pandoc.Extensions (Extension (..), disableExtension)
 import Text.Pandoc.Filter (Environment (..), Filter (..))
 import Text.Pandoc.Options (ReaderOptions (..), WriterOptions (..), getDefaultExtensions, multimarkdownExtensions)
@@ -91,8 +91,21 @@ renderZettelFile v csl bib dir ident zettel = do
   t <- renderZettel csl bib ident zettel
   writeFileText path t
   where
-    path = dir </> toString (unZettelId ident) <.> "md"
+    path = dir </> "zettel" </> toString (unZettelId ident) <.> "md"
+
+renderBibFile :: Bool -> FilePath -> Maybe FilePath -> FilePath -> BibId -> Zettel -> IO ()
+renderBibFile v csl bib dir (BibId ident) zettel = do
+  when v . putStrLn $ "Writing " <> path
+  t <- renderZettel csl bib (ZettelId ident) zettel
+  writeFileText path t
+  where
+    path = dir </> "bib" </> toString ident <.> "md"
 
 renderZettelGraphFile :: Bool -> FilePath -> Maybe FilePath -> FilePath -> ZettelGraph -> IO ()
 renderZettelGraphFile v csl bib fp zg =
-  forM_ (Map.assocs (unZettelGraph zg)) $ uncurry (renderZettelFile v csl bib fp)
+  forM_
+    (Map.assocs (unZettelGraph zg))
+    (uncurry (renderZettelFile v csl bib fp))
+    >> forM_
+      (Map.assocs (zettelGraphBib zg))
+      (uncurry (renderBibFile v csl bib fp))
diff --git a/src/Zettel/Types.hs b/src/Zettel/Types.hs
index 1e8f750..791bc9c 100644
--- a/src/Zettel/Types.hs
+++ b/src/Zettel/Types.hs
@@ -14,6 +14,7 @@ module Zettel.Types
     ZettelMetadata (..),
     Zettel (..),
     ZettelGraph (..),
+    BibId (..),
   )
 where
 
@@ -49,6 +50,10 @@ newtype ZettelId = ZettelId {unZettelId :: Text}
   deriving (Show, Eq, Ord, IsString, ToString, Semigroup, Monoid, ToMetaValue)
   deriving (Combine) via (UseCombine ZettelId)
 
+newtype BibId = BibId {unBibId :: Text}
+  deriving (Show, Eq, Ord, IsString, ToString, Semigroup, Monoid, ToMetaValue)
+  deriving (Combine) via (UseCombine BibId)
+
 newtype ZettelTag = ZettelTag {unZettelTag :: Text}
   deriving (Show, Eq, Ord, IsString, ToString, Semigroup, Monoid, ToMetaValue)
   deriving (Combine) via (UseCombine ZettelId)
@@ -140,7 +145,7 @@ instance Walkable [Inline] Zettel where
 
 data ZettelGraph = ZettelGraph
   { unZettelGraph :: Map ZettelId Zettel,
-    zettelGraphBib :: Maybe Pandoc
+    zettelGraphBib :: Map BibId Zettel
   }
   deriving (Show, Eq)
 
@@ -150,8 +155,8 @@ walkMZettelGraph ::
   ZettelGraph ->
   m ZettelGraph
 walkMZettelGraph f b = do
-  res <- traverse (walkM f) (unZettelGraph b)
-  newBib <- traverse (walkM f) (zettelGraphBib b)
+  res <- walkM f (unZettelGraph b)
+  newBib <- walkM f (zettelGraphBib b)
   return $ ZettelGraph res newBib
 
 queryZettelGraph ::
@@ -159,7 +164,7 @@ queryZettelGraph ::
   (a2 -> a1) ->
   ZettelGraph ->
   a1
-queryZettelGraph f g = query f (unZettelGraph g) <> maybe mempty (query f) (zettelGraphBib g)
+queryZettelGraph f g = query f (unZettelGraph g) <> query f (zettelGraphBib g)
 
 instance Walkable Block ZettelGraph where
   walkM = walkMZettelGraph