blob: fe43e3aebb4c002afe962e9b9b0608d7bdac4a12 (
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
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
{-# LANGUAGE OverloadedRecordDot #-}
-- |
-- Module : Zettel.Common
-- Description : Shared functions used throughout the project
-- Copyright : (c) 2023, Yann Herklotz
-- License : GPL-3.0-only
-- Maintainer : git [at] yannherklotz [dot] com
-- Stability : experimental
-- Portability : POSIX
module Zettel.Common where
import Data.Char (isAlphaNum, isLetter, isNumber)
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import Data.Text.Read (decimal)
import Numeric (readInt, showIntAtBase)
import Text.Pandoc.Builder (HasMeta (..), ToMetaValue (..))
import Text.Pandoc.Definition (Inline (..), Meta (..), 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 zg =
ZettelGraph
(Map.mapWithKey refreshPandocMetaZettel zg.unZettelGraph)
zg.zettelGraphBib
parseIds :: Text -> Text
parseIds t
| T.null t = ""
| T.head t == '#' && T.all isAlphaNum (T.tail t) = T.tail t
| otherwise = ""
splitId :: ZettelId -> [Text]
splitId (ZettelId zid)
| T.null zid = []
| isNumber (T.head zid) = T.takeWhile isNumber zid : (splitId . ZettelId $ T.dropWhile isNumber zid)
| isLetter (T.head zid) = T.takeWhile isLetter zid : (splitId . ZettelId $ T.dropWhile isLetter zid)
| otherwise = []
combineId :: [Text] -> ZettelId
combineId = ZettelId . fold
intToDigit26 :: Int -> Char
intToDigit26 i
| i <= 25 && i >= 0 = toEnum $ fromEnum 'a' + i
| otherwise = error "Integer out of range."
digitToInt26 :: Char -> Int
digitToInt26 c = fromEnum c - fromEnum 'a'
fromBase :: Int -> String -> Maybe Int
fromBase base = fmap fst . viaNonEmpty head . readInt base ((< base) . digitToInt26) digitToInt26
toBase :: Int -> Int -> String
toBase base num = showIntAtBase base intToDigit26 num ""
opOnBase26 :: (Int -> Int) -> Text -> Maybe Text
opOnBase26 f t =
fromString . toBase 26 . f <$> fromBase 26 (toString t)
opOnIdPart :: (Int -> Int) -> Text -> Maybe Text
opOnIdPart f t
| T.null t = Nothing
| isNumber $ T.head t =
case decimal t of
Right (a, _) -> Just . show $ f a
_ -> Nothing
| isLetter $ T.head t = opOnBase26 f t
| otherwise = Nothing
defPredId :: ZettelId -> Maybe ZettelId
defPredId z =
case nonEmpty (splitId z) of
Just ne ->
if last ne == "a" || last ne == "1"
then Just (combineId (init ne))
else combineId . (init ne <>) . (: []) <$> opOnIdPart (subtract 1) (last ne)
Nothing -> Nothing
defNextId :: ZettelId -> Maybe ZettelId
defNextId z =
case nonEmpty (splitId z) of
Just ne ->
combineId . (init ne <>) . (: []) <$> opOnIdPart (+ 1) (last ne)
Nothing -> Nothing
defBranchId :: ZettelId -> Maybe ZettelId
defBranchId (ZettelId t)
| T.null t = Nothing
| isNumber $ T.last t = Just (ZettelId (t <> "a"))
| isLetter $ T.last t = Just (ZettelId (t <> "1"))
| otherwise = Nothing
parseLink :: Text -> ZettelId
parseLink t = ZettelId $ parseIds ident
where
ident = T.takeWhile (']' /=) $ T.dropWhile ('#' /=) t
metaToString :: MetaValue -> Maybe Text
metaToString (MetaString t) = Just t
metaToString _ = Nothing
metaToInlines :: MetaValue -> Maybe [Inline]
metaToInlines (MetaInlines t) = Just t
metaToInlines _ = Nothing
metaToTextList :: MetaValue -> Maybe [Text]
metaToTextList (MetaList t) = traverse metaToString t
metaToTextList _ = Nothing
lookupString :: Text -> Meta -> Maybe Text
lookupString t m = Map.lookup t (unMeta m) >>= metaToString
lookupInlines :: Text -> Meta -> Maybe [Inline]
lookupInlines t m = Map.lookup t (unMeta m) >>= metaToInlines
lookupTextList :: Text -> Meta -> Maybe [Text]
lookupTextList t m = Map.lookup t (unMeta m) >>= metaToTextList
|
