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
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
|
{-# LANGUAGE OverloadedStrings #-}
{- |
Module : Text.Pandoc.Readers.Org.BlockStarts
Copyright : Copyright (C) 2014-2024 Albert Krewinkel
License : GNU GPL, version 2 or above
Maintainer : Albert Krewinkel <[email protected]>
Parsers for Org-mode inline elements.
-}
module Text.Pandoc.Readers.Org.BlockStarts
( exampleLineStart
, hline
, noteMarker
, tableStart
, drawerStart
, headerStart
, metaLineStart
, latexEnvStart
, commentLineStart
, bulletListStart
, orderedListStart
, endOfBlock
) where
import Control.Monad (void, guard)
import Data.Text (Text)
import Text.Pandoc.Readers.Org.Parsing
import Text.Pandoc.Definition as Pandoc
import Text.Pandoc.Shared (safeRead)
import Text.Pandoc.Parsing (lowerAlpha, upperAlpha)
import Text.Pandoc.Extensions
import Text.Pandoc.Readers.LaTeX.Math (inlineEnvironmentNames)
import Data.Functor (($>))
-- | Horizontal Line (five -- dashes or more)
hline :: Monad m => OrgParser m ()
hline = try $ do
skipSpaces
string "-----"
many (char '-')
skipSpaces
newline
return ()
-- | Read the start of a header line, return the header level
headerStart :: Monad m => OrgParser m Int
headerStart = try $
(length <$> many1 (char '*')) <* many1 (char ' ') <* updateLastPreCharPos
tableStart :: Monad m => OrgParser m Char
tableStart = try $ skipSpaces *> char '|'
gridTableStart :: Monad m => OrgParser m ()
gridTableStart = try $ skipSpaces <* char '+' <* char '-'
latexEnvStart :: Monad m => OrgParser m Text
latexEnvStart = try $ do
skipSpaces
string "\\begin{"
name <- latexEnvName
char '}'
guard $ name `notElem` inlineEnvironmentNames
pure name
where
latexEnvName :: Monad m => OrgParser m Text
latexEnvName = try $ mappend <$> many1Char alphaNum <*> option "" (textStr "*")
listCounterCookie :: Monad m => OrgParser m Int
listCounterCookie = try $
string "[@"
*> parseNum
<* char ']'
<* (skipSpaces <|> lookAhead eol)
where parseNum = (safeRead =<< many1Char digit)
<|> snd <$> (lowerAlpha <|> upperAlpha)
bulletListStart :: Monad m => OrgParser m Int
bulletListStart = try $ do
ind <- length <$> many spaceChar
-- Unindented lists cannot use '*' bullets.
oneOf (if ind == 0 then "+-" else "*+-")
skipSpaces1 <|> lookAhead eol
optionMaybe listCounterCookie
return (ind + 1)
eol :: Monad m => OrgParser m ()
eol = void (char '\n')
orderedListStart :: Monad m => OrgParser m (Int, ListAttributes)
orderedListStart = try $ do
ind <- length <$> many spaceChar
fancy <- option False $ True <$ guardEnabled Ext_fancy_lists
-- Ordered list markers allowed in org-mode
let styles = (many1Char digit $> (if fancy
then Decimal
else DefaultStyle))
: if fancy
then [ fst <$> lowerAlpha
, fst <$> upperAlpha ]
else []
let delims = [ char '.' $> (if fancy
then Period
else DefaultDelim)
, char ')' $> (if fancy
then OneParen
else DefaultDelim)
]
style <- choice styles
delim <- choice delims
skipSpaces1 <|> lookAhead eol
start <- option 1 listCounterCookie
return (ind + 1, (start, style, delim))
drawerStart :: Monad m => OrgParser m Text
drawerStart = try $ skipSpaces *> drawerName <* skipSpaces <* newline
where drawerName = char ':' *> manyTillChar nonspaceChar (char ':')
metaLineStart :: Monad m => OrgParser m ()
metaLineStart = try $ skipSpaces <* string "#+"
commentLineStart :: Monad m => OrgParser m ()
commentLineStart = try $
-- the first char after '#' must be a plain space character or a newline
skipSpaces <* string "#" <* lookAhead (oneOf " \n")
exampleLineStart :: Monad m => OrgParser m ()
exampleLineStart = () <$ try (skipSpaces *> char ':' *> (void (char ' ') <|> lookAhead eol))
noteMarker :: Monad m => OrgParser m Text
noteMarker = try $ do
char '['
choice [ many1TillChar digit (char ']')
, (<>) <$> textStr "fn:"
<*> many1TillChar (noneOf "\n\r\t ") (char ']')
]
-- | Succeeds if the parser is at the end of a block.
endOfBlock :: Monad m => OrgParser m ()
endOfBlock = lookAhead . try $
void blankline <|> anyBlockStart
where
-- Succeeds if there is a new block starting at this position.
anyBlockStart :: Monad m => OrgParser m ()
anyBlockStart = try . choice $
[ exampleLineStart
, hline
, metaLineStart
, commentLineStart
, gridTableStart
, void noteMarker
, void tableStart
, void drawerStart
, void headerStart
, void latexEnvStart
, void bulletListStart
, void orderedListStart
]
|
