blob: 7b77417729763932a7610820354e7160535a1990 (
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
|
{-# LANGUAGE OverloadedRecordDot #-}
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 (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
|
