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
|
-- | @since 1.4.5
module Documentation.Haddock.Markup (
markup
, idMarkup
, plainMarkup
) where
import Documentation.Haddock.Types
import Data.Maybe ( fromMaybe )
markup :: DocMarkupH mod id a -> DocH mod id -> a
markup m DocEmpty = markupEmpty m
markup m (DocAppend d1 d2) = markupAppend m (markup m d1) (markup m d2)
markup m (DocString s) = markupString m s
markup m (DocParagraph d) = markupParagraph m (markup m d)
markup m (DocIdentifier x) = markupIdentifier m x
markup m (DocIdentifierUnchecked x) = markupIdentifierUnchecked m x
markup m (DocModule mod0) = markupModule m mod0
markup m (DocWarning d) = markupWarning m (markup m d)
markup m (DocEmphasis d) = markupEmphasis m (markup m d)
markup m (DocBold d) = markupBold m (markup m d)
markup m (DocMonospaced d) = markupMonospaced m (markup m d)
markup m (DocUnorderedList ds) = markupUnorderedList m (map (markup m) ds)
markup m (DocOrderedList ds) = markupOrderedList m (map (markup m) ds)
markup m (DocDefList ds) = markupDefList m (map (markupPair m) ds)
markup m (DocCodeBlock d) = markupCodeBlock m (markup m d)
markup m (DocHyperlink (Hyperlink u l)) = markupHyperlink m (Hyperlink u (fmap (markup m) l))
markup m (DocAName ref) = markupAName m ref
markup m (DocPic img) = markupPic m img
markup m (DocMathInline mathjax) = markupMathInline m mathjax
markup m (DocMathDisplay mathjax) = markupMathDisplay m mathjax
markup m (DocProperty p) = markupProperty m p
markup m (DocExamples e) = markupExample m e
markup m (DocHeader (Header l t)) = markupHeader m (Header l (markup m t))
markup m (DocTable (Table h b)) = markupTable m (Table (map (fmap (markup m)) h) (map (fmap (markup m)) b))
markupPair :: DocMarkupH mod id a -> (DocH mod id, DocH mod id) -> (a, a)
markupPair m (a,b) = (markup m a, markup m b)
-- | The identity markup
idMarkup :: DocMarkupH mod id (DocH mod id)
idMarkup = Markup {
markupEmpty = DocEmpty,
markupString = DocString,
markupParagraph = DocParagraph,
markupAppend = DocAppend,
markupIdentifier = DocIdentifier,
markupIdentifierUnchecked = DocIdentifierUnchecked,
markupModule = DocModule,
markupWarning = DocWarning,
markupEmphasis = DocEmphasis,
markupBold = DocBold,
markupMonospaced = DocMonospaced,
markupUnorderedList = DocUnorderedList,
markupOrderedList = DocOrderedList,
markupDefList = DocDefList,
markupCodeBlock = DocCodeBlock,
markupHyperlink = DocHyperlink,
markupAName = DocAName,
markupPic = DocPic,
markupMathInline = DocMathInline,
markupMathDisplay = DocMathDisplay,
markupProperty = DocProperty,
markupExample = DocExamples,
markupHeader = DocHeader,
markupTable = DocTable
}
-- | Map a 'DocH' into a best estimate of an alternate string. The idea is to
-- strip away any formatting while preserving as much of the actual text as
-- possible.
plainMarkup :: (mod -> String) -> (id -> String) -> DocMarkupH mod id String
plainMarkup plainMod plainIdent = Markup {
markupEmpty = "",
markupString = id,
markupParagraph = id,
markupAppend = (<>),
markupIdentifier = plainIdent,
markupIdentifierUnchecked = plainMod,
markupModule = id,
markupWarning = id,
markupEmphasis = id,
markupBold = id,
markupMonospaced = id,
markupUnorderedList = const "",
markupOrderedList = const "",
markupDefList = const "",
markupCodeBlock = id,
markupHyperlink = \(Hyperlink url lbl) -> fromMaybe url lbl,
markupAName = id,
markupPic = \(Picture uri title) -> fromMaybe uri title,
markupMathInline = id,
markupMathDisplay = id,
markupProperty = id,
markupExample = const "",
markupHeader = \(Header _ title) -> title,
markupTable = const ""
}
|
