summaryrefslogtreecommitdiffstats
path: root/src/Zettel/Render.hs
blob: 0e7f436b67486611b028295b2d6915be3f91dbf1 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
{-# 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))