blob: 86a905bfdb513ed6e830434fff090b5e41b5063b (
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
|
{-# LANGUAGE OverloadedRecordDot #-}
module Zettel.Transclusion where
import Data.Map.Strict ((!?))
import qualified Data.Text as T
import Text.Pandoc.Definition (Block (..), Inline (..), Pandoc (..))
import Text.Pandoc.Walk (walk)
import Zettel.Common
import Zettel.Types
parseTranscludeBlock :: Text -> ZettelId
parseTranscludeBlock t = parseLink link
where
link = T.takeWhile (']' /=) $ T.dropWhile ('[' /=) t
transcludeRawBlockWith' :: (ZettelId -> [Block]) -> Block -> [Block]
transcludeRawBlockWith' f r@(RawBlock t c)
| t == "org" = f $ parseTranscludeBlock c
| otherwise = [r]
transcludeRawBlockWith' _ p = [p]
transcludeRawBlockWith :: (ZettelId -> [Block]) -> [Block] -> [Block]
transcludeRawBlockWith f = concatMap (transcludeRawBlockWith' f)
transcludeRawBlock :: Block -> Block
transcludeRawBlock r@(RawBlock t c)
| t == "org" =
RawBlock "org-zk-transclude" . unZettelId $ parseTranscludeBlock c
| otherwise = r
transcludeRawBlock p = p
markdownIdFormat :: ZettelId -> Text
markdownIdFormat (ZettelId d) =
"{{< transclude zettel=\"" <> d <> "\" >}}"
transcludeToMarkdownLink :: Block -> Block
transcludeToMarkdownLink r@(RawBlock t c)
| t == "org" = Para [Str . markdownIdFormat $ parseTranscludeBlock c]
| otherwise = r
transcludeToMarkdownLink p = p
transclude :: Pandoc -> Pandoc
transclude = walk transcludeRawBlock
transcludeMdLink :: Pandoc -> Pandoc
transcludeMdLink = walk transcludeToMarkdownLink
wrapTransclude :: Int -> ZettelId -> [Block] -> [Block]
wrapTransclude depth zid b =
[Para [RawInline "markdown" $ "{{< transclude-" <> show depth <> " zettel=\"" <> unZettelId zid <> "\" >}}"]]
<> b
<> [Para [RawInline "markdown" $ "{{< /transclude-" <> show depth <> " >}}"]]
transcludeMd :: ZettelGraph -> Int -> Pandoc -> Pandoc
transcludeMd zg depth = walk (transcludeRawBlockWith f)
where
f ident =
concatMap
( (\(Pandoc _ b) -> wrapTransclude depth ident b)
. transcludeMd zg (depth + 1)
. zettelBody
)
. toList
$ zg.unZettelGraph !? ident
transcludeMdZettel :: ZettelGraph -> Zettel -> Zettel
transcludeMdZettel zg zettel =
zettel {zettelBody = transcludeMd zg 1 zettel.zettelBody}
transcludeMdAll :: ZettelGraph -> ZettelGraph
transcludeMdAll zg =
ZettelGraph . fmap (transcludeMdZettel zg) $ unZettelGraph zg
|
