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
|
-- | Special parser combinators for Pandoc readers.
module Text.ParserCombinators.Pandoc (
many1Till,
followedBy',
notFollowedBy',
oneOfStrings,
spaceChar,
skipSpaces,
blankline,
blanklines,
escaped,
enclosed,
blankBlock,
nullBlock,
stringAnyCase
) where
import Text.ParserCombinators.Parsec
import Text.Pandoc.Definition
import Text.Pandoc.Shared
import Char ( toUpper, toLower )
-- | Parses a character and returns 'Null' (so that the parser can move on
-- if it gets stuck).
nullBlock :: GenParser Char st Block
nullBlock = do
anyChar
return Null
-- | Parses one or more blank lines; returns 'Blank'.
blankBlock :: GenParser Char st Block
blankBlock = do
blanklines
return Blank
-- | Parses a space or tab.
spaceChar :: CharParser st Char
spaceChar = oneOf " \t"
-- | Skips zero or more spaces or tabs.
skipSpaces :: GenParser Char st ()
skipSpaces = skipMany spaceChar
-- | Skips zero or more spaces or tabs, then reads a newline.
blankline :: GenParser Char st Char
blankline = try (do
skipSpaces
newline)
-- | Parses one or more blank lines and returns a string of newlines.
blanklines :: GenParser Char st [Char]
blanklines = try (do
many1 blankline)
-- | Parses backslash, then applies character parser.
escaped :: GenParser Char st Char -- ^ Parser for character to escape
-> GenParser Char st Inline
escaped parser = try (do
char '\\'
result <- parser
return (Str [result]))
-- | Parses material enclosed between start and end parsers.
enclosed :: GenParser Char st t -- ^ start parser
-> GenParser Char st end -- ^ end parser
-> GenParser Char st a -- ^ content parser (to be used repeatedly)
-> GenParser Char st [a]
enclosed start end parser = try (do
start
notFollowedBy space
result <- many1Till parser (try end)
return result)
-- | Like @manyTill@, but reads at least one item.
many1Till :: GenParser tok st a
-> GenParser tok st end
-> GenParser tok st [a]
many1Till p end = try (do
first <- p
rest <- manyTill p end
return (first:rest))
-- | A more general form of @notFollowedBy@. This one allows any type of parser to
-- be specified, and succeeds only if that parser fails. It does not consume any input.
notFollowedBy' :: Show b => GenParser a st b -> GenParser a st ()
notFollowedBy' parser = try (do{ c <- parser; unexpected (show c) }
<|> return ()
)
-- | The inverse of @notFollowedBy'@. Fails if parser will fail, otherwise
-- returns @()@ (but does not consume any input).
followedBy' :: (Show b) => GenParser a st b -> GenParser a st ()
followedBy' parser = do
isNotFollowed <- option False (do{ notFollowedBy' parser; return True})
if isNotFollowed then
fail "not followed by parser"
else
return ()
-- | Parses one of a list of strings (tried in order).
oneOfStrings :: [String] -> GenParser Char st String
oneOfStrings listOfStrings = choice $ map (try . string) listOfStrings
-- | Parse string, case insensitive.
stringAnyCase :: [Char] -> CharParser st String
stringAnyCase [] = string ""
stringAnyCase (x:xs) = try (do
firstChar <- choice [ char (toUpper x), char (toLower x) ]
rest <- stringAnyCase xs
return (firstChar:rest))
|
