Add cannonical attributes

3 files changed, 85 insertions, 5 deletions

diff --git a/src/Zettel/Common.hs b/src/Zettel/Common.hs
new file mode 100644
index 0000000..5ad9ef3
--- /dev/null
+++ b/src/Zettel/Common.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedRecordDot #-}
+
+module Zettel.Common where
+
+import qualified Data.Map.Strict as Map
+import Text.Pandoc.Builder (HasMeta (..), ToMetaValue (..))
+import Text.Pandoc.Definition (MetaValue (..), Pandoc (..))
+import Zettel.Types
+
+trySet :: (HasMeta a, ToMetaValue b) => Text -> Maybe b -> a -> a
+trySet t (Just b) a = setMeta t b a
+trySet _ Nothing a = a
+
+refreshPandocMetaZettel' :: (HasMeta a) => ZettelId -> Zettel -> a -> a
+refreshPandocMetaZettel' zid z =
+  trySet "modified" z.zettelMetadata.zettelModifiedDate
+    . trySet "date" z.zettelMetadata.zettelCreationDate
+    . trySet "author" z.zettelMetadata.zettelAuthor
+    . setMeta "title" (MetaInlines z.zettelTitle)
+    . setMeta "tags" z.zettelMetadata.zettelTags
+    . setMeta "categories" z.zettelMetadata.zettelCats
+    . setMeta "backlinks" z.zettelPrev
+    . setMeta "forwardlinks" z.zettelNext
+    . setMeta "zettelid" zid
+
+clearPandocAttr :: Pandoc -> Pandoc
+clearPandocAttr (Pandoc _ b) = Pandoc mempty b
+
+refreshPandocMetaZettel :: ZettelId -> Zettel -> Zettel
+refreshPandocMetaZettel zid z =
+  z {zettelBody = refreshPandocMetaZettel' zid z . clearPandocAttr $ zettelBody z}
+
+refreshPandocMeta :: ZettelGraph -> ZettelGraph
+refreshPandocMeta = ZettelGraph . Map.mapWithKey refreshPandocMetaZettel . unZettelGraph
diff --git a/src/Zettel/Parse.hs b/src/Zettel/Parse.hs
index cf2604a..6ce74fd 100644
--- a/src/Zettel/Parse.hs
+++ b/src/Zettel/Parse.hs
@@ -7,6 +7,7 @@ import Text.Pandoc.Builder (toMetaValue)
 import Text.Pandoc.Chunks (Chunk (..), ChunkedDoc (..), splitIntoChunks)
 import Text.Pandoc.Class (runIOorExplode)
 import Text.Pandoc.Definition (Block (..), Inline (..), Meta (..), MetaValue (..), Pandoc (..))
+import Text.Pandoc.Options (ReaderOptions (..), getDefaultExtensions)
 import Text.Pandoc.Readers (readOrg)
 import Text.Pandoc.Shared (stringify)
 import Text.Pandoc.Walk (query, walk)
@@ -133,7 +134,7 @@ updatePandocAttr (Pandoc attr b) =
 parseZettelKasten :: [FilePath] -> IO ZettelGraph
 parseZettelKasten fl = do
   fs <- mapM readFileBS fl
-  orgFiles <- mapM (runIOorExplode . readOrg def . decode) fs
+  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
   return . refreshPandocMeta . ZettelGraph . fromList $ map zettelFromPandoc pandocList
diff --git a/src/Zettel/Render.hs b/src/Zettel/Render.hs
index 27e8664..276ea9b 100644
--- a/src/Zettel/Render.hs
+++ b/src/Zettel/Render.hs
@@ -2,14 +2,21 @@
 
 module Zettel.Render where
 
+import Control.Monad as M (when)
 import Data.Default (def)
 import qualified Data.Map.Strict as Map
 import qualified Data.Text as T
 import Paths_org_zk (getDataFileName)
+import Text.Pandoc.App (applyFilters)
+import Text.Pandoc.Builder (HasMeta (..), ToMetaValue (..))
 import Text.Pandoc.Class (runIOorExplode)
 import Text.Pandoc.Definition (Block (..), Inline (..))
-import Text.Pandoc.Options (WriterOptions (..), multimarkdownExtensions)
+import Text.Pandoc.Extensions (Extension (..), disableExtension, enableExtension)
+import Text.Pandoc.Filter (Environment (..), Filter (..))
+import Text.Pandoc.Options (CiteMethod (..), ReaderOptions (..), WriterOptions (..), getDefaultExtensions, multimarkdownExtensions)
+import Text.Pandoc.Scripting (noEngine)
 import Text.Pandoc.Templates (WithDefaultPartials (..), compileTemplate)
+import Text.Pandoc.Walk (query, walk)
 import Text.Pandoc.Writers (writeMarkdown)
 import Zettel.Types
 
@@ -27,15 +34,53 @@ renderTitleLinks :: Int -> Text -> [ZettelId] -> [Block]
 renderTitleLinks level title ids =
   [Header level mempty (toInlines title), renderZettelLinks ids]
 
+newtype MB = MB {unMB :: Bool} deriving (Show, Eq)
+
+instance Semigroup MB where
+  MB a <> MB b = MB $ a || b
+
+instance Monoid MB where
+  mempty = MB False
+
+checkCitation :: Inline -> MB
+checkCitation Cite {} = MB True
+checkCitation _ = MB False
+
 renderZettel :: ZettelId -> Zettel -> IO Text
 renderZettel _ zettel = do
   templateFile <- getDataFileName "data/markdown.template"
   template <- decodeUtf8 <$> readFileBS templateFile
   Right templ <- runIOorExplode . runWithDefaultPartials $ compileTemplate "" template
+  let writeOpts =
+        ( def
+            { writerTemplate = Just templ,
+              writerExtensions = multimarkdownExtensions,
+              writerReferenceLinks = True
+            }
+        )
   runIOorExplode $
-    writeMarkdown
-      (def {writerTemplate = Just templ, writerExtensions = multimarkdownExtensions})
-      zettel.zettelBody
+    if unMB $ query checkCitation zettel.zettelBody
+      then
+        let pandoc =
+              setMeta "csl" ("/Users/ymherklotz/Dropbox/zk/assets/ieee.csl" :: FilePath) $
+                setMeta
+                  "bibliography"
+                  (["/Users/ymherklotz/bibliography/references.bib"] :: [FilePath])
+                  zettel.zettelBody
+         in applyFilters
+              noEngine
+              ( Environment
+                  def {readerExtensions = getDefaultExtensions "org"}
+                  writeOpts
+                    { writerExtensions =
+                        disableExtension Ext_citations writeOpts.writerExtensions
+                    }
+              )
+              [CiteprocFilter]
+              ["org"]
+              pandoc
+              >>= writeMarkdown writeOpts
+      else writeMarkdown writeOpts zettel.zettelBody
 
 renderZettelFile :: FilePath -> ZettelId -> Zettel -> IO ()
 renderZettelFile dir ident zettel = do