@@ -32,12 +32,11 @@ module Text.Pandoc.Shared (
3232 splitBy,
3333 splitByIndices,
3434 substitute,
35− -- * Text processing
3635 joinWithSep,
36+ -- * Text processing
3737 tabsToSpaces,
3838 backslashEscapes,
3939 escapeStringUsing,
40− endsWith,
4140 stripTrailingNewlines,
4241 removeLeadingTrailingSpace,
4342 removeLeadingSpace,
@@ -46,8 +45,33 @@ module Text.Pandoc.Shared (
4645 camelCaseToHyphenated,
4746 toRomanNumeral,
4847 -- * Parsing
48+ (>>~),
49+ anyLine,
50+ many1Till,
51+ notFollowedBy',
52+ oneOfStrings,
53+ spaceChar,
54+ skipSpaces,
55+ blankline,
56+ blanklines,
57+ enclosed,
58+ stringAnyCase,
59+ parseFromString,
60+ lineClump,
61+ charsInBalanced,
62+ charsInBalanced',
63+ romanNumeral,
64+ withHorizDisplacement,
65+ nullBlock,
66+ failIfStrict,
67+ escaped,
68+ anyOrderedListMarker,
69+ orderedListMarker,
70+ charRef,
4971 readWith,
5072 testStringWith,
73+ ParserState (..),
74+ defaultParserState,
5175 Reference (..),
5276 isNoteBlock,
5377 isKeyBlock,
@@ -55,14 +79,10 @@ module Text.Pandoc.Shared (
5579 HeaderType (..),
5680 ParserContext (..),
5781 QuoteContext (..),
58− ParserState (..),
5982 NoteTable,
60− defaultParserState,
61− nullBlock,
62− failIfStrict,
63− escaped,
64− anyOrderedListMarker,
65− orderedListMarker,
83+ KeyTable,
84+ lookupKeySrc,
85+ refsMatch,
6686 -- * Native format prettyprinting
6787 prettyPandoc,
6888 -- * Pandoc block and inline list processing
@@ -74,214 +94,387 @@ module Text.Pandoc.Shared (
7494 isHeaderBlock,
7595 -- * Writer options
7696 WriterOptions (..),
77− defaultWriterOptions,
78− -- * Reference key lookup functions
79− KeyTable,
80− lookupKeySrc,
81− refsMatch,
97+ defaultWriterOptions
8298 ) where
99+
83100import Text.Pandoc.Definition
84101import Text.ParserCombinators.Parsec
85−import Text.Pandoc.ParserCombinators
86−import Text.Pandoc.Entities ( decodeEntities, escapeStringForXML )
102+import Text.Pandoc.CharacterReferences ( characterReference )
87103import Data.Char ( toLower, toUpper, ord, chr, isLower, isUpper )
88−import Data.List ( find, groupBy, isPrefixOf )
104+import Data.List ( find, groupBy, isPrefixOf, isSuffixOf )
89105
90−-- | Parse a string with a given parser and state.
91−readWith :: GenParser Char ParserState a -- ^ parser
92− -> ParserState -- ^ initial state
93− -> String -- ^ input string
94− -> a
95−readWith parser state input =
96− case runParser parser state "source" input of
97− Left err -> error $ "\nError:\n" ++ show err
98− Right result -> result
106+--
107+-- List processing
108+--
99109
100−-- | Parse a string with @parser@ (for testing).
101−testStringWith :: (Show a) =>
102− GenParser Char ParserState a
103− -> String
104− -> IO ()
105−testStringWith parser str = putStrLn $ show $
106− readWith parser defaultParserState str
110+-- | Split list by groups of one or more sep.
111+splitBy :: (Eq a) => a -> [a] -> [[a]]
112+splitBy _ [] = []
113+splitBy sep lst =
114+ let (first, rest) = break (== sep) lst
115+ rest' = dropWhile (== sep) rest
116+ in first:(splitBy sep rest')
107117
108−data HeaderType
109− = SingleHeader Char -- ^ Single line of characters underneath
110− | DoubleHeader Char -- ^ Lines of characters above and below
111− deriving (Eq, Show)
118+-- | Split list into chunks divided at specified indices.
119+splitByIndices :: [Int] -> [a] -> [[a]]
120+splitByIndices [] lst = [lst]
121+splitByIndices (x:xs) lst =
122+ let (first, rest) = splitAt x lst in
123+ first:(splitByIndices (map (\y -> y - x) xs) rest)
112124
113−data ParserContext
114− = ListItemState -- ^ Used when running parser on list item contents
115− | NullState -- ^ Default state
116− deriving (Eq, Show)
125+-- | Replace each occurrence of one sublist in a list with another.
126+substitute :: (Eq a) => [a] -> [a] -> [a] -> [a]
127+substitute _ _ [] = []
128+substitute [] _ lst = lst
129+substitute target replacement lst =
130+ if target `isPrefixOf` lst
131+ then replacement ++ (substitute target replacement $ drop (length target) lst)
132+ else (head lst):(substitute target replacement $ tail lst)
117133
118−data QuoteContext
119− = InSingleQuote -- ^ Used when we're parsing inside single quotes
120− | InDoubleQuote -- ^ Used when we're parsing inside double quotes
121− | NoQuote -- ^ Used when we're not parsing inside quotes
122− deriving (Eq, Show)
134+-- | Joins a list of lists, separated by another list.
135+joinWithSep :: [a] -- ^ List to use as separator
136+ -> [[a]] -- ^ Lists to join
137+ -> [a]
138+joinWithSep sep [] = []
139+joinWithSep sep lst = foldr1 (\a b -> a ++ sep ++ b) lst
123140
124−type KeyTable = [([Inline], Target)]
141+--
142+-- Text processing
143+--
125144
126−type NoteTable = [(String, [Block])]
145+-- | Convert tabs to spaces (with adjustable tab stop).
146+tabsToSpaces :: Int -- ^ Tabstop
147+ -> String -- ^ String to convert
148+ -> String
149+tabsToSpaces tabstop str =
150+ unlines $ map (tabsInLine tabstop tabstop) (lines str)
127151
128−-- | References from preliminary parsing
129−data Reference
130− = KeyBlock [Inline] Target -- ^ Key for reference-style link (label URL title)
131− | NoteBlock String [Block] -- ^ Footnote reference and contents
132− | LineClump String -- ^ Raw clump of lines with blanks at end
133− deriving (Eq, Read, Show)
152+-- | Convert tabs to spaces in one line.
153+tabsInLine :: Int -- ^ Number of spaces to next tab stop
154+ -> Int -- ^ Tabstop
155+ -> String -- ^ Line to convert
156+ -> String
157+tabsInLine num tabstop [] = ""
158+tabsInLine num tabstop (c:cs) =
159+ let (replacement, nextnum) = if c == '\t'
160+ then (replicate num ' ', tabstop)
161+ else if num > 1
162+ then ([c], num - 1)
163+ else ([c], tabstop)
164+ in replacement ++ tabsInLine nextnum tabstop cs
134165
135−-- | Auxiliary functions used in preliminary parsing
136−isNoteBlock :: Reference -> Bool
137−isNoteBlock (NoteBlock _ _) = True
138−isNoteBlock _ = False
166+-- | Returns an association list of backslash escapes for the
167+-- designated characters.
168+backslashEscapes :: [Char] -- ^ list of special characters to escape
169+ -> [(Char, String)]
170+backslashEscapes = map (\ch -> (ch, ['\\',ch]))
139171
140−isKeyBlock :: Reference -> Bool
141−isKeyBlock (KeyBlock _ _) = True
142−isKeyBlock _ = False
172+-- | Escape a string of characters, using an association list of
173+-- characters and strings.
174+escapeStringUsing :: [(Char, String)] -> String -> String
175+escapeStringUsing escapeTable [] = ""
176+escapeStringUsing escapeTable (x:xs) =
177+ case (lookup x escapeTable) of
178+ Just str -> str ++ rest
179+ Nothing -> x:rest
180+ where rest = escapeStringUsing escapeTable xs
143181
144−isLineClump :: Reference -> Bool
145−isLineClump (LineClump _) = True
146−isLineClump _ = False
182+-- | Strip trailing newlines from string.
183+stripTrailingNewlines :: String -> String
184+stripTrailingNewlines = reverse . dropWhile (== '\n') . reverse
147185
148−data ParserState = ParserState
149− { stateParseRaw :: Bool, -- ^ Parse untranslatable HTML
150− -- and LaTeX?
151− stateParserContext :: ParserContext, -- ^ What are we parsing?
152− stateQuoteContext :: QuoteContext, -- ^ Inside quoted environment?
153− stateKeys :: KeyTable, -- ^ List of reference keys
154− stateNotes :: NoteTable, -- ^ List of notes
155− stateTabStop :: Int, -- ^ Tab stop
156− stateStandalone :: Bool, -- ^ If @True@, parse
157− -- bibliographic info
158− stateTitle :: [Inline], -- ^ Title of document
159− stateAuthors :: [String], -- ^ Authors of document
160− stateDate :: String, -- ^ Date of document
161− stateStrict :: Bool, -- ^ Use strict markdown syntax
162− stateSmart :: Bool, -- ^ Use smart typography
163− stateColumns :: Int, -- ^ Number of columns in
164− -- terminal (used for tables)
165− stateHeaderTable :: [HeaderType] -- ^ List of header types used,
166− -- in what order (rst only)
167− }
168− deriving Show
186+-- | Remove leading and trailing space (including newlines) from string.
187+removeLeadingTrailingSpace :: String -> String
188+removeLeadingTrailingSpace = removeLeadingSpace . removeTrailingSpace
169189
170−defaultParserState :: ParserState
171−defaultParserState =
172− ParserState { stateParseRaw = False,
173− stateParserContext = NullState,
174− stateQuoteContext = NoQuote,
175− stateKeys = [],
176− stateNotes = [],
177− stateTabStop = 4,
178− stateStandalone = False,
179− stateTitle = [],
180− stateAuthors = [],
181− stateDate = [],
182− stateStrict = False,
183− stateSmart = False,
184− stateColumns = 80,
185− stateHeaderTable = [] }
190+-- | Remove leading space (including newlines) from string.
191+removeLeadingSpace :: String -> String
192+removeLeadingSpace = dropWhile (`elem` " \n\t")
193+
194+-- | Remove trailing space (including newlines) from string.
195+removeTrailingSpace :: String -> String
196+removeTrailingSpace = reverse . removeLeadingSpace . reverse
197+
198+-- | Strip leading and trailing characters from string
199+stripFirstAndLast :: String -> String
200+stripFirstAndLast str =
201+ drop 1 $ take ((length str) - 1) str
202+
203+-- | Change CamelCase word to hyphenated lowercase (e.g., camel-case).
204+camelCaseToHyphenated :: String -> String
205+camelCaseToHyphenated [] = ""
206+camelCaseToHyphenated (a:b:rest) | isLower a && isUpper b =
207+ a:'-':(toLower b):(camelCaseToHyphenated rest)
208+camelCaseToHyphenated (a:rest) = (toLower a):(camelCaseToHyphenated rest)
209+
210+-- | Convert number < 4000 to uppercase roman numeral.
211+toRomanNumeral :: Int -> String
212+toRomanNumeral x =
213+ if x >= 4000 || x < 0
214+ then "?"
215+ else case x of
216+ x | x >= 1000 -> "M" ++ toRomanNumeral (x - 1000)
217+ x | x >= 900 -> "CM" ++ toRomanNumeral (x - 900)
218+ x | x >= 500 -> "D" ++ toRomanNumeral (x - 500)
219+ x | x >= 400 -> "CD" ++ toRomanNumeral (x - 400)
220+ x | x >= 100 -> "C" ++ toRomanNumeral (x - 100)
221+ x | x >= 90 -> "XC" ++ toRomanNumeral (x - 90)
222+ x | x >= 50 -> "L" ++ toRomanNumeral (x - 50)
223+ x | x >= 40 -> "XL" ++ toRomanNumeral (x - 40)
224+ x | x >= 10 -> "X" ++ toRomanNumeral (x - 10)
225+ x | x >= 9 -> "IX" ++ toRomanNumeral (x - 5)
226+ x | x >= 5 -> "V" ++ toRomanNumeral (x - 5)
227+ x | x >= 4 -> "IV" ++ toRomanNumeral (x - 4)
228+ x | x >= 1 -> "I" ++ toRomanNumeral (x - 1)
229+ 0 -> ""
230+
231+--
232+-- Parsing
233+--
234+
235+-- | Like >>, but returns the operation on the left.
236+-- (Suggested by Tillmann Rendel on Haskell-cafe list.)
237+(>>~) :: (Monad m) => m a -> m b -> m a
238+a >>~ b = a >>= \x -> b >> return x
239+
240+-- | Parse any line of text
241+anyLine :: GenParser Char st [Char]
242+anyLine = try (manyTill anyChar newline) <|> many1 anyChar
243+ -- second alternative is for a line ending with eof
244+
245+-- | Like @manyTill@, but reads at least one item.
246+many1Till :: GenParser tok st a
247+ -> GenParser tok st end
248+ -> GenParser tok st [a]
249+many1Till p end = do
250+ first <- p
251+ rest <- manyTill p end
252+ return (first:rest)
253+
254+-- | A more general form of @notFollowedBy@. This one allows any
255+-- type of parser to be specified, and succeeds only if that parser fails.
256+-- It does not consume any input.
257+notFollowedBy' :: Show b => GenParser a st b -> GenParser a st ()
258+notFollowedBy' parser = try $ (do result <- try parser
259+ unexpected (show result))
260+ <|> return ()
261+
262+-- | Parses one of a list of strings (tried in order).
263+oneOfStrings :: [String] -> GenParser Char st String
264+oneOfStrings listOfStrings = choice $ map (try . string) listOfStrings
265+
266+-- | Parses a space or tab.
267+spaceChar :: CharParser st Char
268+spaceChar = oneOf " \t"
269+
270+-- | Skips zero or more spaces or tabs.
271+skipSpaces :: GenParser Char st ()
272+skipSpaces = skipMany spaceChar
273+
274+-- | Skips zero or more spaces or tabs, then reads a newline.
275+blankline :: GenParser Char st Char
276+blankline = try $ skipSpaces >> newline
277+
278+-- | Parses one or more blank lines and returns a string of newlines.
279+blanklines :: GenParser Char st [Char]
280+blanklines = many1 blankline
281+
282+-- | Parses material enclosed between start and end parsers.
283+enclosed :: GenParser Char st t -- ^ start parser
284+ -> GenParser Char st end -- ^ end parser
285+ -> GenParser Char st a -- ^ content parser (to be used repeatedly)
286+ -> GenParser Char st [a]
287+enclosed start end parser = try $
288+ start >> notFollowedBy space >> many1Till parser (try end)
289+
290+-- | Parse string, case insensitive.
291+stringAnyCase :: [Char] -> CharParser st String
292+stringAnyCase [] = string ""
293+stringAnyCase (x:xs) = try $ do
294+ firstChar <- choice [ char (toUpper x), char (toLower x) ]
295+ rest <- stringAnyCase xs
296+ return (firstChar:rest)
297+
298+-- | Parse contents of 'str' using 'parser' and return result.
299+parseFromString :: GenParser tok st a -> [tok] -> GenParser tok st a
300+parseFromString parser str = try $ do
301+ oldInput <- getInput
302+ setInput str
303+ result <- parser
304+ setInput oldInput
305+ return result
306+
307+-- | Parse raw line block up to and including blank lines.
308+lineClump :: GenParser Char st String
309+lineClump = do
310+ lines <- many1 (notFollowedBy blankline >> anyLine)
311+ blanks <- blanklines <|> (eof >> return "\n")
312+ return $ (unlines lines) ++ blanks
313+
314+-- | Parse a string of characters between an open character
315+-- and a close character, including text between balanced
316+-- pairs of open and close. For example,
317+-- @charsInBalanced '(' ')'@ will parse "(hello (there))"
318+-- and return "hello (there)". Stop if a blank line is
319+-- encountered.
320+charsInBalanced :: Char -> Char -> GenParser Char st String
321+charsInBalanced open close = try $ do
322+ char open
323+ raw <- manyTill ( (do res <- charsInBalanced open close
324+ return $ [open] ++ res ++ [close])
325+ <|> (do notFollowedBy' (blankline >> blanklines)
326+ count 1 anyChar))
327+ (char close)
328+ return $ concat raw
329+
330+-- | Like @charsInBalanced@, but allow blank lines in the content.
331+charsInBalanced' :: Char -> Char -> GenParser Char st String
332+charsInBalanced' open close = try $ do
333+ char open
334+ raw <- manyTill ( (do res <- charsInBalanced open close
335+ return $ [open] ++ res ++ [close])
336+ <|> count 1 anyChar)
337+ (char close)
338+ return $ concat raw
339+
340+-- | Parses a roman numeral (uppercase or lowercase), returns number.
341+romanNumeral :: Bool -- ^ Uppercase if true
342+ -> GenParser Char st Int
343+romanNumeral upper = try $ do
344+ let charAnyCase c = char (if upper then toUpper c else c)
345+ let one = charAnyCase 'i'
346+ let five = charAnyCase 'v'
347+ let ten = charAnyCase 'x'
348+ let fifty = charAnyCase 'l'
349+ let hundred = charAnyCase 'c'
350+ let fivehundred = charAnyCase 'd'
351+ let thousand = charAnyCase 'm'
352+ thousands <- many thousand >>= (return . (1000 *) . length)
353+ ninehundreds <- option 0 $ try $ hundred >> thousand >> return 900
354+ fivehundreds <- many fivehundred >>= (return . (500 *) . length)
355+ fourhundreds <- option 0 $ try $ hundred >> fivehundred >> return 400
356+ hundreds <- many hundred >>= (return . (100 *) . length)
357+ nineties <- option 0 $ try $ ten >> hundred >> return 90
358+ fifties <- many fifty >>= (return . (50 *) . length)
359+ forties <- option 0 $ try $ ten >> fifty >> return 40
360+ tens <- many ten >>= (return . (10 *) . length)
361+ nines <- option 0 $ try $ one >> ten >> return 9
362+ fives <- many five >>= (return . (5 *) . length)
363+ fours <- option 0 $ try $ one >> five >> return 4
364+ ones <- many one >>= (return . length)
365+ let total = thousands + ninehundreds + fivehundreds + fourhundreds +
366+ hundreds + nineties + fifties + forties + tens + nines +
367+ fives + fours + ones
368+ if total == 0
369+ then fail "not a roman numeral"
370+ else return total
371+
372+-- | Applies a parser, returns tuple of its results and its horizontal
373+-- displacement (the difference between the source column at the end
374+-- and the source column at the beginning). Vertical displacement
375+-- (source row) is ignored.
376+withHorizDisplacement :: GenParser Char st a -- ^ Parser to apply
377+ -> GenParser Char st (a, Int) -- ^ (result, displacement)
378+withHorizDisplacement parser = do
379+ pos1 <- getPosition
380+ result <- parser
381+ pos2 <- getPosition
382+ return (result, sourceColumn pos2 - sourceColumn pos1)
186383
187384-- | Parses a character and returns 'Null' (so that the parser can move on
188385-- if it gets stuck).
189386nullBlock :: GenParser Char st Block
190−nullBlock = do
191− anyChar
192− return Null
387+nullBlock = anyChar >> return Null
193388
194389-- | Fail if reader is in strict markdown syntax mode.
195390failIfStrict :: GenParser Char ParserState ()
196391failIfStrict = do
197392 state <- getState
198− if stateStrict state then fail "Strict mode" else return ()
393+ if stateStrict state then fail "strict mode" else return ()
199394
200395-- | Parses backslash, then applies character parser.
201396escaped :: GenParser Char st Char -- ^ Parser for character to escape
202397 -> GenParser Char st Inline
203−escaped parser = try (do
204− char '\\'
205− result <- parser
206− return (Str [result]))
398+escaped parser = try $ do
399+ char '\\'
400+ result <- parser
401+ return (Str [result])
207402
208403-- | Parses an uppercase roman numeral and returns (UpperRoman, number).
209404upperRoman :: GenParser Char st (ListNumberStyle, Int)
210405upperRoman = do
211− num <- romanNumeral True
212− return (UpperRoman, num)
406+ num <- romanNumeral True
407+ return (UpperRoman, num)
213408
214409-- | Parses a lowercase roman numeral and returns (LowerRoman, number).
215410lowerRoman :: GenParser Char st (ListNumberStyle, Int)
216411lowerRoman = do
217− num <- romanNumeral False
218− return (LowerRoman, num)
412+ num <- romanNumeral False
413+ return (LowerRoman, num)
219414
220415-- | Parses a decimal numeral and returns (Decimal, number).
221416decimal :: GenParser Char st (ListNumberStyle, Int)
222417decimal = do
223− num <- many1 digit
224− return (Decimal, read num)
418+ num <- many1 digit
419+ return (Decimal, read num)
225420
226421-- | Parses a '#' returns (DefaultStyle, 1).
227422defaultNum :: GenParser Char st (ListNumberStyle, Int)
228423defaultNum = do
229− char '#'
230− return (DefaultStyle, 1)
424+ char '#'
425+ return (DefaultStyle, 1)
231426
232427-- | Parses a lowercase letter and returns (LowerAlpha, number).
233428lowerAlpha :: GenParser Char st (ListNumberStyle, Int)
234429lowerAlpha = do
235− ch <- oneOf ['a'..'z']
236− return (LowerAlpha, ord ch - ord 'a' + 1)
430+ ch <- oneOf ['a'..'z']
431+ return (LowerAlpha, ord ch - ord 'a' + 1)
237432
238433-- | Parses an uppercase letter and returns (UpperAlpha, number).
239434upperAlpha :: GenParser Char st (ListNumberStyle, Int)
240435upperAlpha = do
241− ch <- oneOf ['A'..'Z']
242− return (UpperAlpha, ord ch - ord 'A' + 1)
436+ ch <- oneOf ['A'..'Z']
437+ return (UpperAlpha, ord ch - ord 'A' + 1)
243438
244439-- | Parses a roman numeral i or I
245440romanOne :: GenParser Char st (ListNumberStyle, Int)
246−romanOne = (do char 'i'
247− return (LowerRoman, 1)) <|>
248− (do char 'I'
249− return (UpperRoman, 1))
441+romanOne = (char 'i' >> return (LowerRoman, 1)) <|>
442+ (char 'I' >> return (UpperRoman, 1))
250443
251444-- | Parses an ordered list marker and returns list attributes.
252445anyOrderedListMarker :: GenParser Char st ListAttributes
253−anyOrderedListMarker = choice $ [delimParser numParser | delimParser <-
254− [inPeriod, inOneParen, inTwoParens],
255− numParser <- [decimal, defaultNum, romanOne,
256− lowerAlpha, lowerRoman, upperAlpha, upperRoman]]
446+anyOrderedListMarker = choice $
447+ [delimParser numParser | delimParser <- [inPeriod, inOneParen, inTwoParens],
448+ numParser <- [decimal, defaultNum, romanOne,
449+ lowerAlpha, lowerRoman, upperAlpha, upperRoman]]
257450
258451-- | Parses a list number (num) followed by a period, returns list attributes.
259452inPeriod :: GenParser Char st (ListNumberStyle, Int)
260453 -> GenParser Char st ListAttributes
261454inPeriod num = try $ do
262− (style, start) <- num
263− char '.'
264− let delim = if style == DefaultStyle
265− then DefaultDelim
266− else Period
267− return (start, style, delim)
455+ (style, start) <- num
456+ char '.'
457+ let delim = if style == DefaultStyle
458+ then DefaultDelim
459+ else Period
460+ return (start, style, delim)
268461
269462-- | Parses a list number (num) followed by a paren, returns list attributes.
270463inOneParen :: GenParser Char st (ListNumberStyle, Int)
271464 -> GenParser Char st ListAttributes
272465inOneParen num = try $ do
273− (style, start) <- num
274− char ')'
275− return (start, style, OneParen)
466+ (style, start) <- num
467+ char ')'
468+ return (start, style, OneParen)
276469
277470-- | Parses a list number (num) enclosed in parens, returns list attributes.
278471inTwoParens :: GenParser Char st (ListNumberStyle, Int)
279472 -> GenParser Char st ListAttributes
280473inTwoParens num = try $ do
281− char '('
282− (style, start) <- num
283− char ')'
284− return (start, style, TwoParens)
474+ char '('
475+ (style, start) <- num
476+ char ')'
477+ return (start, style, TwoParens)
285478
286479-- | Parses an ordered list marker with a given style and delimiter,
287480-- returns number.
@@ -289,21 +482,158 @@ orderedListMarker :: ListNumberStyle
289482 -> ListNumberDelim
290483 -> GenParser Char st Int
291484orderedListMarker style delim = do
292− let num = case style of
293− DefaultStyle -> decimal <|> defaultNum
294− Decimal -> decimal
295− UpperRoman -> upperRoman
296− LowerRoman -> lowerRoman
297− UpperAlpha -> upperAlpha
298− LowerAlpha -> lowerAlpha
299− let context = case delim of
300− DefaultDelim -> inPeriod
301− Period -> inPeriod
302− OneParen -> inOneParen
303− TwoParens -> inTwoParens
304− (start, style, delim) <- context num
305− return start
485+ let num = case style of
486+ DefaultStyle -> decimal <|> defaultNum
487+ Decimal -> decimal
488+ UpperRoman -> upperRoman
489+ LowerRoman -> lowerRoman
490+ UpperAlpha -> upperAlpha
491+ LowerAlpha -> lowerAlpha
492+ let context = case delim of
493+ DefaultDelim -> inPeriod
494+ Period -> inPeriod
495+ OneParen -> inOneParen
496+ TwoParens -> inTwoParens
497+ (start, style, delim) <- context num
498+ return start
499+
500+-- | Parses a character reference and returns a Str element.
501+charRef :: GenParser Char st Inline
502+charRef = do
503+ c <- characterReference
504+ return $ Str [c]
505+
506+-- | Parse a string with a given parser and state.
507+readWith :: GenParser Char ParserState a -- ^ parser
508+ -> ParserState -- ^ initial state
509+ -> String -- ^ input string
510+ -> a
511+readWith parser state input =
512+ case runParser parser state "source" input of
513+ Left err -> error $ "\nError:\n" ++ show err
514+ Right result -> result
515+
516+-- | Parse a string with @parser@ (for testing).
517+testStringWith :: (Show a) => GenParser Char ParserState a
518+ -> String
519+ -> IO ()
520+testStringWith parser str = putStrLn $ show $
521+ readWith parser defaultParserState str
522+
523+-- | Parsing options.
524+data ParserState = ParserState
525+ { stateParseRaw :: Bool, -- ^ Parse raw HTML and LaTeX?
526+ stateParserContext :: ParserContext, -- ^ Inside list?
527+ stateQuoteContext :: QuoteContext, -- ^ Inside quoted environment?
528+ stateKeys :: KeyTable, -- ^ List of reference keys
529+ stateNotes :: NoteTable, -- ^ List of notes
530+ stateTabStop :: Int, -- ^ Tab stop
531+ stateStandalone :: Bool, -- ^ Parse bibliographic info?
532+ stateTitle :: [Inline], -- ^ Title of document
533+ stateAuthors :: [String], -- ^ Authors of document
534+ stateDate :: String, -- ^ Date of document
535+ stateStrict :: Bool, -- ^ Use strict markdown syntax?
536+ stateSmart :: Bool, -- ^ Use smart typography?
537+ stateColumns :: Int, -- ^ Number of columns in terminal
538+ stateHeaderTable :: [HeaderType] -- ^ Ordered list of header types used
539+ }
540+ deriving Show
541+
542+defaultParserState :: ParserState
543+defaultParserState =
544+ ParserState { stateParseRaw = False,
545+ stateParserContext = NullState,
546+ stateQuoteContext = NoQuote,
547+ stateKeys = [],
548+ stateNotes = [],
549+ stateTabStop = 4,
550+ stateStandalone = False,
551+ stateTitle = [],
552+ stateAuthors = [],
553+ stateDate = [],
554+ stateStrict = False,
555+ stateSmart = False,
556+ stateColumns = 80,
557+ stateHeaderTable = [] }
558+
559+-- | References from preliminary parsing.
560+data Reference
561+ = KeyBlock [Inline] Target -- ^ Key for reference-style link (label URL title)
562+ | NoteBlock String [Block] -- ^ Footnote reference and contents
563+ | LineClump String -- ^ Raw clump of lines with blanks at end
564+ deriving (Eq, Read, Show)
565+
566+-- | Auxiliary functions used in preliminary parsing.
567+isNoteBlock :: Reference -> Bool
568+isNoteBlock (NoteBlock _ _) = True
569+isNoteBlock _ = False
570+
571+isKeyBlock :: Reference -> Bool
572+isKeyBlock (KeyBlock _ _) = True
573+isKeyBlock _ = False
574+
575+isLineClump :: Reference -> Bool
576+isLineClump (LineClump _) = True
577+isLineClump _ = False
578+
579+data HeaderType
580+ = SingleHeader Char -- ^ Single line of characters underneath
581+ | DoubleHeader Char -- ^ Lines of characters above and below
582+ deriving (Eq, Show)
583+
584+data ParserContext
585+ = ListItemState -- ^ Used when running parser on list item contents
586+ | NullState -- ^ Default state
587+ deriving (Eq, Show)
588+
589+data QuoteContext
590+ = InSingleQuote -- ^ Used when parsing inside single quotes
591+ | InDoubleQuote -- ^ Used when parsing inside double quotes
592+ | NoQuote -- ^ Used when not parsing inside quotes
593+ deriving (Eq, Show)
594+
595+type NoteTable = [(String, [Block])]
596+
597+type KeyTable = [([Inline], Target)]
598+
599+-- | Look up key in key table and return target object.
600+lookupKeySrc :: KeyTable -- ^ Key table
601+ -> [Inline] -- ^ Key
602+ -> Maybe Target
603+lookupKeySrc table key = case find (refsMatch key . fst) table of
604+ Nothing -> Nothing
605+ Just (_, src) -> Just src
606+
607+-- | Returns @True@ if keys match (case insensitive).
608+refsMatch :: [Inline] -> [Inline] -> Bool
609+refsMatch ((Str x):restx) ((Str y):resty) =
610+ ((map toLower x) == (map toLower y)) && refsMatch restx resty
611+refsMatch ((Emph x):restx) ((Emph y):resty) =
612+ refsMatch x y && refsMatch restx resty
613+refsMatch ((Strong x):restx) ((Strong y):resty) =
614+ refsMatch x y && refsMatch restx resty
615+refsMatch ((Strikeout x):restx) ((Strikeout y):resty) =
616+ refsMatch x y && refsMatch restx resty
617+refsMatch ((Superscript x):restx) ((Superscript y):resty) =
618+ refsMatch x y && refsMatch restx resty
619+refsMatch ((Subscript x):restx) ((Subscript y):resty) =
620+ refsMatch x y && refsMatch restx resty
621+refsMatch ((Quoted t x):restx) ((Quoted u y):resty) =
622+ t == u && refsMatch x y && refsMatch restx resty
623+refsMatch ((Code x):restx) ((Code y):resty) =
624+ ((map toLower x) == (map toLower y)) && refsMatch restx resty
625+refsMatch ((TeX x):restx) ((TeX y):resty) =
626+ ((map toLower x) == (map toLower y)) && refsMatch restx resty
627+refsMatch ((HtmlInline x):restx) ((HtmlInline y):resty) =
628+ ((map toLower x) == (map toLower y)) && refsMatch restx resty
629+refsMatch (x:restx) (y:resty) = (x == y) && refsMatch restx resty
630+refsMatch [] x = null x
631+refsMatch x [] = null x
306632
633+--
634+-- Native format prettyprinting
635+--
636+
307637-- | Indent string as a block.
308638indentBy :: Int -- ^ Number of spaces to indent the block
309639 -> Int -- ^ Number of spaces (rel to block) to indent first line
@@ -311,9 +641,10 @@ indentBy :: Int -- ^ Number of spaces to indent the block
311641 -> String
312642indentBy num first [] = ""
313643indentBy num first str =
314− let (firstLine:restLines) = lines str
315− firstLineIndent = num + first in
316− (replicate firstLineIndent ' ') ++ firstLine ++ "\n" ++ (joinWithSep "\n" $ map (\line -> (replicate num ' ') ++ line) restLines)
644+ let (firstLine:restLines) = lines str
645+ firstLineIndent = num + first
646+ in (replicate firstLineIndent ' ') ++ firstLine ++ "\n" ++
647+ (joinWithSep "\n" $ map ((replicate num ' ') ++ ) restLines)
317648
318649-- | Prettyprint list of Pandoc blocks elements.
319650prettyBlockList :: Int -- ^ Number of spaces to indent list of blocks
@@ -321,142 +652,40 @@ prettyBlockList :: Int -- ^ Number of spaces to indent list of blocks
321652 -> String
322653prettyBlockList indent [] = indentBy indent 0 "[]"
323654prettyBlockList indent blocks = indentBy indent (-2) $ "[ " ++
324− (joinWithSep "\n, " (map prettyBlock blocks)) ++ " ]"
655+ (joinWithSep "\n, " (map prettyBlock blocks)) ++ " ]"
325656
326657-- | Prettyprint Pandoc block element.
327658prettyBlock :: Block -> String
328659prettyBlock (BlockQuote blocks) = "BlockQuote\n " ++
329660 (prettyBlockList 2 blocks)
330661prettyBlock (OrderedList attribs blockLists) =
331− "OrderedList " ++ show attribs ++ "\n" ++ indentBy 2 0 ("[ " ++
332− (joinWithSep ", " $ map (\blocks -> prettyBlockList 2 blocks)
333− blockLists)) ++ " ]"
662+ "OrderedList " ++ show attribs ++ "\n" ++ indentBy 2 0 ("[ " ++
663+ (joinWithSep ", " $ map (\blocks -> prettyBlockList 2 blocks)
664+ blockLists)) ++ " ]"
334665prettyBlock (BulletList blockLists) = "BulletList\n" ++
335− indentBy 2 0 ("[ " ++ (joinWithSep ", "
336− (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"
666+ indentBy 2 0 ("[ " ++ (joinWithSep ", "
667+ (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"
337668prettyBlock (DefinitionList blockLists) = "DefinitionList\n" ++
338− indentBy 2 0 ("[" ++ (joinWithSep ",\n"
339− (map (\(term, blocks) -> " (" ++ show term ++ ",\n" ++
340− indentBy 1 2 (prettyBlockList 2 blocks) ++ " )") blockLists))) ++ " ]"
669+ indentBy 2 0 ("[" ++ (joinWithSep ",\n"
670+ (map (\(term, blocks) -> " (" ++ show term ++ ",\n" ++
671+ indentBy 1 2 (prettyBlockList 2 blocks) ++ " )") blockLists))) ++ " ]"
341672prettyBlock (Table caption aligns widths header rows) =
342− "Table " ++ show caption ++ " " ++ show aligns ++ " " ++
343− show widths ++ "\n" ++ prettyRow header ++ " [\n" ++
344− (joinWithSep ",\n" (map prettyRow rows)) ++ " ]"
345− where prettyRow cols = indentBy 2 0 ("[ " ++ (joinWithSep ", "
346− (map (\blocks -> prettyBlockList 2 blocks)
347− cols))) ++ " ]"
673+ "Table " ++ show caption ++ " " ++ show aligns ++ " " ++
674+ show widths ++ "\n" ++ prettyRow header ++ " [\n" ++
675+ (joinWithSep ",\n" (map prettyRow rows)) ++ " ]"
676+ where prettyRow cols = indentBy 2 0 ("[ " ++ (joinWithSep ", "
677+ (map (\blocks -> prettyBlockList 2 blocks)
678+ cols))) ++ " ]"
348679prettyBlock block = show block
349680
350681-- | Prettyprint Pandoc document.
351682prettyPandoc :: Pandoc -> String
352−prettyPandoc (Pandoc meta blocks) = "Pandoc " ++ "(" ++ (show meta) ++
353− ")\n" ++ (prettyBlockList 0 blocks) ++ "\n"
354−
355−-- | Convert tabs to spaces (with adjustable tab stop).
356−tabsToSpaces :: Int -- ^ Tabstop
357− -> String -- ^ String to convert
358− -> String
359−tabsToSpaces tabstop str =
360− unlines (map (tabsInLine tabstop tabstop) (lines str))
683+prettyPandoc (Pandoc meta blocks) = "Pandoc " ++ "(" ++ show meta ++
684+ ")\n" ++ (prettyBlockList 0 blocks) ++ "\n"
361685
362−-- | Convert tabs to spaces in one line.
363−tabsInLine :: Int -- ^ Number of spaces to next tab stop
364− -> Int -- ^ Tabstop
365− -> String -- ^ Line to convert
366− -> String
367−tabsInLine num tabstop "" = ""
368−tabsInLine num tabstop (c:cs) =
369− let replacement = (if (c == '\t') then (replicate num ' ') else [c]) in
370− let nextnumraw = (num - (length replacement)) in
371− let nextnum = if (nextnumraw < 1)
372− then (nextnumraw + tabstop)
373− else nextnumraw in
374− replacement ++ (tabsInLine nextnum tabstop cs)
375−
376−-- | Returns an association list of backslash escapes for the
377−-- designated characters.
378−backslashEscapes :: [Char] -- ^ list of special characters to escape
379− -> [(Char, String)]
380−backslashEscapes = map (\ch -> (ch, ['\\',ch]))
381−
382−-- | Escape a string of characters, using an association list of
383−-- characters and strings.
384−escapeStringUsing :: [(Char, String)] -> String -> String
385−escapeStringUsing escapeTable "" = ""
386−escapeStringUsing escapeTable (x:xs) =
387− case (lookup x escapeTable) of
388− Just str -> str ++ rest
389− Nothing -> x:rest
390− where rest = escapeStringUsing escapeTable xs
391−
392−-- | Returns @True@ if string ends with given character.
393−endsWith :: Char -> [Char] -> Bool
394−endsWith char [] = False
395−endsWith char str = (char == last str)
396−
397−-- | Joins a list of lists, separated by another list.
398−joinWithSep :: [a] -- ^ List to use as separator
399− -> [[a]] -- ^ Lists to join
400− -> [a]
401−joinWithSep sep [] = []
402−joinWithSep sep lst = foldr1 (\a b -> a ++ sep ++ b) lst
403−
404−-- | Strip trailing newlines from string.
405−stripTrailingNewlines :: String -> String
406−stripTrailingNewlines "" = ""
407−stripTrailingNewlines str =
408− if (last str) == '\n'
409− then stripTrailingNewlines (init str)
410− else str
411−
412−-- | Remove leading and trailing space (including newlines) from string.
413−removeLeadingTrailingSpace :: String -> String
414−removeLeadingTrailingSpace = removeLeadingSpace . removeTrailingSpace
415−
416−-- | Remove leading space (including newlines) from string.
417−removeLeadingSpace :: String -> String
418−removeLeadingSpace = dropWhile (\x -> (x == ' ') || (x == '\n') ||
419− (x == '\t'))
420−
421−-- | Remove trailing space (including newlines) from string.
422−removeTrailingSpace :: String -> String
423−removeTrailingSpace = reverse . removeLeadingSpace . reverse
424−
425−-- | Strip leading and trailing characters from string
426−stripFirstAndLast :: String -> String
427−stripFirstAndLast str =
428− drop 1 $ take ((length str) - 1) str
429−
430−-- | Change CamelCase word to hyphenated lowercase (e.g., camel-case).
431−camelCaseToHyphenated :: String -> String
432−camelCaseToHyphenated "" = ""
433−camelCaseToHyphenated (a:b:rest) | isLower a && isUpper b =
434− a:'-':(toLower b):(camelCaseToHyphenated rest)
435−camelCaseToHyphenated (a:rest) = (toLower a):(camelCaseToHyphenated rest)
436−
437−-- | Replace each occurrence of one sublist in a list with another.
438−substitute :: (Eq a) => [a] -> [a] -> [a] -> [a]
439−substitute _ _ [] = []
440−substitute [] _ lst = lst
441−substitute target replacement lst =
442− if isPrefixOf target lst
443− then replacement ++ (substitute target replacement $ drop (length target) lst)
444− else (head lst):(substitute target replacement $ tail lst)
445−
446−-- | Split list into groups separated by sep.
447−splitBy :: (Eq a) => a -> [a] -> [[a]]
448−splitBy _ [] = []
449−splitBy sep lst =
450− let (first, rest) = break (== sep) lst
451− rest' = dropWhile (== sep) rest in
452− first:(splitBy sep rest')
453−
454−-- | Split list into chunks divided at specified indices.
455−splitByIndices :: [Int] -> [a] -> [[a]]
456−splitByIndices [] lst = [lst]
457−splitByIndices (x:xs) lst =
458− let (first, rest) = splitAt x lst in
459− first:(splitByIndices (map (\y -> y - x) xs) rest)
686+--
687+-- Pandoc block and inline list processing
688+--
460689
461690-- | Generate infinite lazy list of markers for an ordered list,
462691-- depending on list attributes.
@@ -466,8 +695,10 @@ orderedListMarkers (start, numstyle, numdelim) =
466695 seq = case numstyle of
467696 DefaultStyle -> map show [start..]
468697 Decimal -> map show [start..]
469− UpperAlpha -> drop (start - 1) $ cycle $ map singleton ['A'..'Z']
470− LowerAlpha -> drop (start - 1) $ cycle $ map singleton ['a'..'z']
698+ UpperAlpha -> drop (start - 1) $ cycle $
699+ map singleton ['A'..'Z']
700+ LowerAlpha -> drop (start - 1) $ cycle $
701+ map singleton ['a'..'z']
471702 UpperRoman -> map toRomanNumeral [start..]
472703 LowerRoman -> map (map toLower . toRomanNumeral) [start..]
473704 inDelim str = case numdelim of
@@ -477,27 +708,6 @@ orderedListMarkers (start, numstyle, numdelim) =
477708 TwoParens -> "(" ++ str ++ ")"
478709 in map inDelim seq
479710
480−-- | Convert number < 4000 to uppercase roman numeral.
481−toRomanNumeral :: Int -> String
482−toRomanNumeral x =
483− if x >= 4000 || x < 0
484− then "?"
485− else case x of
486− x | x >= 1000 -> "M" ++ toRomanNumeral (x - 1000)
487− x | x >= 900 -> "CM" ++ toRomanNumeral (x - 900)
488− x | x >= 500 -> "D" ++ toRomanNumeral (x - 500)
489− x | x >= 400 -> "CD" ++ toRomanNumeral (x - 400)
490− x | x >= 100 -> "C" ++ toRomanNumeral (x - 100)
491− x | x >= 90 -> "XC" ++ toRomanNumeral (x - 90)
492− x | x >= 50 -> "L" ++ toRomanNumeral (x - 50)
493− x | x >= 40 -> "XL" ++ toRomanNumeral (x - 40)
494− x | x >= 10 -> "X" ++ toRomanNumeral (x - 10)
495− x | x >= 9 -> "IX" ++ toRomanNumeral (x - 5)
496− x | x >= 5 -> "V" ++ toRomanNumeral (x - 5)
497− x | x >= 4 -> "IV" ++ toRomanNumeral (x - 4)
498− x | x >= 1 -> "I" ++ toRomanNumeral (x - 1)
499− 0 -> ""
500−
501711-- | Normalize a list of inline elements: remove leading and trailing
502712-- @Space@ elements, collapse double @Space@s into singles, and
503713-- remove empty Str elements.
@@ -507,16 +717,14 @@ normalizeSpaces list =
507717 let removeDoubles [] = []
508718 removeDoubles (Space:Space:rest) = removeDoubles (Space:rest)
509719 removeDoubles ((Str ""):rest) = removeDoubles rest
510− removeDoubles (x:rest) = x:(removeDoubles rest) in
511− let removeLeading [] = []
512− removeLeading lst = if ((head lst) == Space)
513− then tail lst
514− else lst in
515− let removeTrailing [] = []
516− removeTrailing lst = if ((last lst) == Space)
517− then init lst
518− else lst in
519− removeLeading $ removeTrailing $ removeDoubles list
720+ removeDoubles (x:rest) = x:(removeDoubles rest)
721+ removeLeading (Space:xs) = removeLeading xs
722+ removeLeading x = x
723+ removeTrailing [] = []
724+ removeTrailing lst = if (last lst == Space)
725+ then init lst
726+ else lst
727+ in removeLeading $ removeTrailing $ removeDoubles list
520728
521729-- | Change final list item from @Para@ to @Plain@ if the list should
522730-- be compact.
@@ -524,122 +732,86 @@ compactify :: [[Block]] -- ^ List of list items (each a list of blocks)
524732 -> [[Block]]
525733compactify [] = []
526734compactify items =
527− let final = last items
528− others = init items in
529− case final of
530− [Para a] -> if any containsPara others
531− then items
532− else others ++ [[Plain a]]
533− otherwise -> items
735+ let final = last items
736+ others = init items
737+ in case final of
738+ [Para a] -> if any containsPara others
739+ then items
740+ else others ++ [[Plain a]]
741+ otherwise -> items
534742
535743containsPara :: [Block] -> Bool
536744containsPara [] = False
537745containsPara ((Para a):rest) = True
538−containsPara ((BulletList items):rest) = (any containsPara items) ||
539− (containsPara rest)
540−containsPara ((OrderedList _ items):rest) = (any containsPara items) ||
541− (containsPara rest)
746+containsPara ((BulletList items):rest) = any containsPara items ||
747+ containsPara rest
748+containsPara ((OrderedList _ items):rest) = any containsPara items ||
749+ containsPara rest
750+containsPara ((DefinitionList items):rest) = any containsPara (map snd items) ||
751+ containsPara rest
542752containsPara (x:rest) = containsPara rest
543753
544754-- | Data structure for defining hierarchical Pandoc documents
545755data Element = Blk Block
546756 | Sec [Inline] [Element] deriving (Eq, Read, Show)
547757
548−-- | Returns true on Header block with level at least 'level'
758+-- | Returns @True@ on Header block with at least the specified level
549759headerAtLeast :: Int -> Block -> Bool
550760headerAtLeast level (Header x _) = x <= level
551761headerAtLeast level _ = False
552762
553−-- | Convert list of Pandoc blocks into list of Elements (hierarchical)
763+-- | Convert list of Pandoc blocks into (hierarchical) list of Elements
554764hierarchicalize :: [Block] -> [Element]
555765hierarchicalize [] = []
556766hierarchicalize (block:rest) =
557767 case block of
558− (Header level title) -> let (thisSection, rest') = break (headerAtLeast
559− level) rest in
560− (Sec title (hierarchicalize thisSection)):
561− (hierarchicalize rest')
562− x -> (Blk x):(hierarchicalize rest)
768+ (Header level title) ->
769+ let (thisSection, rest') = break (headerAtLeast level) rest
770+ in (Sec title (hierarchicalize thisSection)):(hierarchicalize rest')
771+ x -> (Blk x):(hierarchicalize rest)
563772
564773-- | True if block is a Header block.
565774isHeaderBlock :: Block -> Bool
566775isHeaderBlock (Header _ _) = True
567776isHeaderBlock _ = False
568777
778+--
779+-- Writer options
780+--
781+
569782-- | Options for writers
570783data WriterOptions = WriterOptions
571− { writerStandalone :: Bool -- ^ Include header and footer
572− , writerTitlePrefix :: String -- ^ Prefix for HTML titles
573− , writerHeader :: String -- ^ Header for the document
574− , writerIncludeBefore :: String -- ^ String to include before the body
575− , writerIncludeAfter :: String -- ^ String to include after the body
576− , writerTableOfContents :: Bool -- ^ Include table of contents
577− , writerS5 :: Bool -- ^ We're writing S5
578− , writerUseASCIIMathML :: Bool -- ^ Use ASCIIMathML
579− , writerASCIIMathMLURL :: Maybe String -- ^ URL to asciiMathML.js
580− , writerIgnoreNotes :: Bool -- ^ Ignore footnotes (used in making toc)
581− , writerIncremental :: Bool -- ^ Incremental S5 lists
582− , writerNumberSections :: Bool -- ^ Number sections in LaTeX
583− , writerStrictMarkdown :: Bool -- ^ Use strict markdown syntax
584− , writerReferenceLinks :: Bool -- ^ Use reference links in writing markdown, rst
585− , writerTabStop :: Int -- ^ Tabstop for conversion between
586− -- spaces and tabs
587− } deriving Show
784+ { writerStandalone :: Bool -- ^ Include header and footer
785+ , writerHeader :: String -- ^ Header for the document
786+ , writerTitlePrefix :: String -- ^ Prefix for HTML titles
787+ , writerTabStop :: Int -- ^ Tabstop for conversion btw spaces and tabs
788+ , writerTableOfContents :: Bool -- ^ Include table of contents
789+ , writerS5 :: Bool -- ^ We're writing S5
790+ , writerUseASCIIMathML :: Bool -- ^ Use ASCIIMathML
791+ , writerASCIIMathMLURL :: Maybe String -- ^ URL to asciiMathML.js
792+ , writerIgnoreNotes :: Bool -- ^ Ignore footnotes (used in making toc)
793+ , writerIncremental :: Bool -- ^ Incremental S5 lists
794+ , writerNumberSections :: Bool -- ^ Number sections in LaTeX
795+ , writerIncludeBefore :: String -- ^ String to include before the body
796+ , writerIncludeAfter :: String -- ^ String to include after the body
797+ , writerStrictMarkdown :: Bool -- ^ Use strict markdown syntax
798+ , writerReferenceLinks :: Bool -- ^ Use reference links in writing markdown, rst
799+ } deriving Show
588800
589801-- | Default writer options.
590802defaultWriterOptions =
591− WriterOptions { writerStandalone = False,
592− writerHeader = "",
593− writerTitlePrefix = "",
594− writerTabStop = 4,
595− writerTableOfContents = False,
596− writerS5 = False,
597− writerUseASCIIMathML = False,
598− writerASCIIMathMLURL = Nothing,
599− writerIgnoreNotes = False,
600− writerIncremental = False,
601− writerNumberSections = False,
602− writerIncludeBefore = "",
603− writerIncludeAfter = "",
604− writerStrictMarkdown = False,
605− writerReferenceLinks = False }
606−
607−--
608−-- code to lookup reference keys in key table
609−--
610−
611−-- | Look up key in key table and return target object.
612−lookupKeySrc :: KeyTable -- ^ Key table
613− -> [Inline] -- ^ Key
614− -> Maybe Target
615−lookupKeySrc table key = case table of
616− [] -> Nothing
617− (k, src):rest -> if (refsMatch k key)
618− then Just src
619− else lookupKeySrc rest key
620−
621−-- | Returns @True@ if keys match (case insensitive).
622−refsMatch :: [Inline] -> [Inline] -> Bool
623−refsMatch ((Str x):restx) ((Str y):resty) =
624− ((map toLower x) == (map toLower y)) && refsMatch restx resty
625−refsMatch ((Emph x):restx) ((Emph y):resty) =
626− refsMatch x y && refsMatch restx resty
627−refsMatch ((Strong x):restx) ((Strong y):resty) =
628− refsMatch x y && refsMatch restx resty
629−refsMatch ((Strikeout x):restx) ((Strikeout y):resty) =
630− refsMatch x y && refsMatch restx resty
631−refsMatch ((Superscript x):restx) ((Superscript y):resty) =
632− refsMatch x y && refsMatch restx resty
633−refsMatch ((Subscript x):restx) ((Subscript y):resty) =
634− refsMatch x y && refsMatch restx resty
635−refsMatch ((Quoted t x):restx) ((Quoted u y):resty) =
636− t == u && refsMatch x y && refsMatch restx resty
637−refsMatch ((Code x):restx) ((Code y):resty) =
638− ((map toLower x) == (map toLower y)) && refsMatch restx resty
639−refsMatch ((TeX x):restx) ((TeX y):resty) =
640− ((map toLower x) == (map toLower y)) && refsMatch restx resty
641−refsMatch ((HtmlInline x):restx) ((HtmlInline y):resty) =
642− ((map toLower x) == (map toLower y)) && refsMatch restx resty
643−refsMatch (x:restx) (y:resty) = (x == y) && refsMatch restx resty
644−refsMatch [] x = null x
645−refsMatch x [] = null x
803+ WriterOptions { writerStandalone = False,
804+ writerHeader = "",
805+ writerTitlePrefix = "",
806+ writerTabStop = 4,
807+ writerTableOfContents = False,
808+ writerS5 = False,
809+ writerUseASCIIMathML = False,
810+ writerASCIIMathMLURL = Nothing,
811+ writerIgnoreNotes = False,
812+ writerIncremental = False,
813+ writerNumberSections = False,
814+ writerIncludeBefore = "",
815+ writerIncludeAfter = "",
816+ writerStrictMarkdown = False,
817+ writerReferenceLinks = False }