blob: dd467de80b68af3c1156d3ce419d6fdf10c1f4ab (
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
|
{-# LANGUAGE OverloadedRecordDot #-}
-- |
-- Module : Zettel.Links
-- Description : Calculate the backlinks and forward links for each Zettel
-- Copyright : (c) 2023, Yann Herklotz
-- License : GPL-3
-- Maintainer : git [at] yannherklotz [dot] com
-- Stability : experimental
-- Portability : POSIX
module Zettel.Links where
import Data.List (nub)
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import Text.Pandoc.Definition (Inline (..))
import Text.Pandoc.Shared (stringify)
import Text.Pandoc.Walk (query, walk)
import Zettel.Common
import Zettel.Types
gatherForwardIds :: Inline -> [ZettelId]
gatherForwardIds (Link _ i _)
| T.null ident = []
| otherwise = [ZettelId ident]
where
ident = parseIds $ stringify i
gatherForwardIds (RawInline t v)
| t == "markdown" && not (T.null parsed) = [ZettelId parsed]
| otherwise = []
where
parsed = T.takeWhile (/= '"') . T.drop 1 $ T.dropWhile (/= '"') v
gatherForwardIds _ = []
addIdPresent :: ZettelGraph -> Maybe ZettelId -> [ZettelId]
addIdPresent zg (Just ident) =
[ident | ident `elem` Map.keys (unZettelGraph zg)]
addIdPresent _ Nothing = []
forwardLinkNode :: ZettelGraph -> ZettelId -> Zettel -> Zettel
forwardLinkNode zg ident zn =
zn
{ zettelNext =
nub
( query gatherForwardIds zn.zettelBody
<> addIdPresent zg (defNextId ident)
<> addIdPresent zg (defBranchId ident)
)
}
forwardLink :: ZettelGraph -> ZettelGraph
forwardLink zg =
ZettelGraph
(Map.mapWithKey (forwardLinkNode zg) $ unZettelGraph zg)
zg.zettelGraphBib
backwardLinkNode :: ZettelGraph -> ZettelId -> Zettel -> Zettel
backwardLinkNode graph ident node = Map.foldlWithKey' f node (unZettelGraph graph)
where
f :: Zettel -> ZettelId -> Zettel -> Zettel
f l ident' zg
| ident `elem` zg.zettelNext =
l {zettelPrev = ident' : l.zettelPrev}
| otherwise = l
backwardLink :: ZettelGraph -> ZettelGraph
backwardLink zg =
ZettelGraph
(Map.mapWithKey (backwardLinkNode zg) $ unZettelGraph zg)
zg.zettelGraphBib
updatePandocLinksInline :: Inline -> Inline
updatePandocLinksInline l@(Link a i (_, t))
| not $ T.null ids = Link a i ("/zettel/" <> ids, t)
| otherwise = l
where
ids = parseIds $ stringify i
updatePandocLinksInline i = i
updatePandocLinks :: ZettelGraph -> ZettelGraph
updatePandocLinks = walk updatePandocLinksInline
linkAll :: ZettelGraph -> ZettelGraph
linkAll = refreshPandocMeta . backwardLink . forwardLink . updatePandocLinks
|
