{-# LANGUAGE OverloadedRecordDot #-} -- | -- Module : Zettel.Render -- Description : Render the Zettelgraph to multiple markdown files -- Copyright : (c) 2023, Yann Herklotz -- License : GPL-3.0-only -- Maintainer : git [at] yannherklotz [dot] com -- Stability : experimental -- Portability : POSIX module Zettel.Render where import Control.Logging import Data.Default (def) import qualified Data.Map.Strict as Map import qualified Data.Text as T import Paths_org_zk (getDataFileName) 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.Extensions (Extension (..), disableExtension) import Text.Pandoc.Filter (Environment (..), Filter (..)) import Text.Pandoc.Options (ReaderOptions (..), WriterOptions (..), getDefaultExtensions, multimarkdownExtensions) import Text.Pandoc.Scripting (noEngine) import Text.Pandoc.Templates (WithDefaultPartials (..), compileTemplate) import Text.Pandoc.Walk (query) import Text.Pandoc.Writers (writeMarkdown) import Zettel.Types zettelIdToLink :: ZettelId -> Inline zettelIdToLink ident = Link mempty [Str $ "#" <> unZettelId ident] ("/" <> unZettelId ident, "") renderZettelLinks :: [ZettelId] -> Block renderZettelLinks = BulletList . map (\ident -> [Para [zettelIdToLink ident]]) toInlines :: Text -> [Inline] toInlines t = intersperse Space . map Str $ T.words t 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 :: FilePath -> Maybe FilePath -> ZettelId -> Zettel -> IO Text renderZettel csl bib _ 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 $ if unMB (query checkCitation zettel.zettelBody) && isJust bib then let pandoc = setMeta "csl" (csl :: FilePath) $ setMeta "bibliography" ([fromMaybe "references.bib" bib] :: [FilePath]) zettel.zettelBody in applyFilters noEngine ( Environment def {readerExtensions = getDefaultExtensions "org"} writeOpts { writerExtensions = -- Counter-intuitively, you need to disable citation -- support so that the citations are inserted in the -- markdown directly, instead of just referenced. disableExtension Ext_citations writeOpts.writerExtensions } ) [CiteprocFilter] ["org"] pandoc >>= writeMarkdown writeOpts else writeMarkdown writeOpts zettel.zettelBody renderZettelFile :: FilePath -> Maybe FilePath -> FilePath -> ZettelId -> Zettel -> IO () renderZettelFile csl bib dir ident zettel = do log $ "Writing " <> T.pack path t <- renderZettel csl bib ident zettel writeFileText path t where path = dir "zettel" toString (unZettelId ident) <.> "md" renderBibFile :: FilePath -> Maybe FilePath -> FilePath -> BibId -> Zettel -> IO () renderBibFile csl bib dir (BibId ident) zettel = do log $ "Writing " <> T.pack path t <- renderZettel csl bib (ZettelId ident) zettel writeFileText path t where path = dir "bib" toString ident <.> "md" renderZettelGraphFile :: FilePath -> Maybe FilePath -> FilePath -> ZettelGraph -> IO () renderZettelGraphFile csl bib fp zg = forM_ (Map.assocs (unZettelGraph zg)) (uncurry (renderZettelFile csl bib fp)) >> forM_ (Map.assocs (zettelGraphBib zg)) (uncurry (renderBibFile csl bib fp))