@@ -32,12 +32,11 @@ module Text.Pandoc.Shared (
33 splitByIndices,
33 splitByIndices,
34 substitute,
34 substitute,
36 joinWithSep,
35 joinWithSep,
37 tabsToSpaces,
37 tabsToSpaces,
38 backslashEscapes,
38 backslashEscapes,
39 escapeStringUsing,
39 escapeStringUsing,
41 stripTrailingNewlines,
40 stripTrailingNewlines,
42 removeLeadingTrailingSpace,
41 removeLeadingTrailingSpace,
43 removeLeadingSpace,
42 removeLeadingSpace,
@@ -46,8 +45,33 @@ module Text.Pandoc.Shared (
46 camelCaseToHyphenated,
45 camelCaseToHyphenated,
47 toRomanNumeral,
46 toRomanNumeral,
48 -- * Parsing
47 -- * Parsing
64+ withHorizDisplacement,
68+ anyOrderedListMarker,
50 testStringWith,
72 testStringWith,
51 Reference (..),
75 Reference (..),
52 isNoteBlock,
76 isNoteBlock,
53 isKeyBlock,
77 isKeyBlock,
@@ -55,14 +79,10 @@ module Text.Pandoc.Shared (
55 HeaderType (..),
79 HeaderType (..),
56 ParserContext (..),
80 ParserContext (..),
57 QuoteContext (..),
81 QuoteContext (..),
59 NoteTable,
82 NoteTable,
60− defaultParserState,
83+ KeyTable,
61− nullBlock,
84+ lookupKeySrc,
62− failIfStrict,
85+ refsMatch,
64− anyOrderedListMarker,
66 -- * Native format prettyprinting
86 -- * Native format prettyprinting
67 prettyPandoc,
87 prettyPandoc,
68 -- * Pandoc block and inline list processing
88 -- * Pandoc block and inline list processing
@@ -74,214 +94,387 @@ module Text.Pandoc.Shared (
74 isHeaderBlock,
94 isHeaderBlock,
75 -- * Writer options
95 -- * Writer options
76 WriterOptions (..),
96 WriterOptions (..),
77− defaultWriterOptions,
97+ defaultWriterOptions
78− -- * Reference key lookup functions
83import Text.Pandoc.Definition
100import Text.Pandoc.Definition
84import Text.ParserCombinators.Parsec
101import Text.ParserCombinators.Parsec
85−import Text.Pandoc.ParserCombinators
102+import Text.Pandoc.CharacterReferences ( characterReference )
86−import Text.Pandoc.Entities ( decodeEntities, escapeStringForXML )
87import Data.Char ( toLower, toUpper, ord, chr, isLower, isUpper )
103import Data.Char ( toLower, toUpper, ord, chr, isLower, isUpper )
88−import Data.List ( find, groupBy, isPrefixOf )
104+import Data.List ( find, groupBy, isPrefixOf, isSuffixOf )
90−-- | Parse a string with a given parser and state.
106+--
91−readWith :: GenParser Char ParserState a -- ^ parser
107+-- List processing
92− -> ParserState -- ^ initial state
108+--
93− -> String -- ^ input string
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
100−-- | Parse a string with @parser@ (for testing).
110+-- | Split list by groups of one or more sep.
101−testStringWith :: (Show a) =>
111+splitBy :: (Eq a) => a -> [a] -> [[a]]
102− GenParser Char ParserState a
112+splitBy _ [] = []
103− -> String
113+splitBy sep lst =
104− -> IO ()
114+ let (first, rest) = break (== sep) lst
105−testStringWith parser str = putStrLn $ show $
115+ rest' = dropWhile (== sep) rest
106− readWith parser defaultParserState str
116+ in first:(splitBy sep rest')
108−data HeaderType
118+-- | Split list into chunks divided at specified indices.
109− = SingleHeader Char -- ^ Single line of characters underneath
119+splitByIndices :: [Int] -> [a] -> [[a]]
110− | DoubleHeader Char -- ^ Lines of characters above and below
120+splitByIndices [] lst = [lst]
111− deriving (Eq, Show)
121+splitByIndices (x:xs) lst =
122+ let (first, rest) = splitAt x lst in
123+ first:(splitByIndices (map (\y -> y - x) xs) rest)
113−data ParserContext
125+-- | Replace each occurrence of one sublist in a list with another.
114− = ListItemState -- ^ Used when running parser on list item contents
126+substitute :: (Eq a) => [a] -> [a] -> [a] -> [a]
115− | NullState -- ^ Default state
127+substitute _ _ [] = []
116− deriving (Eq, Show)
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)
118−data QuoteContext
134+-- | Joins a list of lists, separated by another list.
119− = InSingleQuote -- ^ Used when we're parsing inside single quotes
135+joinWithSep :: [a] -- ^ List to use as separator
120− | InDoubleQuote -- ^ Used when we're parsing inside double quotes
136+ -> [[a]] -- ^ Lists to join
121− | NoQuote -- ^ Used when we're not parsing inside quotes
137+ -> [a]
122− deriving (Eq, Show)
138+joinWithSep sep [] = []
139+joinWithSep sep lst = foldr1 (\a b -> a ++ sep ++ b) lst
124−type KeyTable = [([Inline], Target)]
141+--
126−type NoteTable = [(String, [Block])]
145+-- | Convert tabs to spaces (with adjustable tab stop).
146+tabsToSpaces :: Int -- ^ Tabstop
147+ -> String -- ^ String to convert
149+tabsToSpaces tabstop str =
150+ unlines $ map (tabsInLine tabstop tabstop) (lines str)
128−-- | References from preliminary parsing
152+-- | Convert tabs to spaces in one line.
129−data Reference
153+tabsInLine :: Int -- ^ Number of spaces to next tab stop
130− = KeyBlock [Inline] Target -- ^ Key for reference-style link (label URL title)
154+ -> Int -- ^ Tabstop
131− | NoteBlock String [Block] -- ^ Footnote reference and contents
155+ -> String -- ^ Line to convert
132− | LineClump String -- ^ Raw clump of lines with blanks at end
156+ -> String
133− deriving (Eq, Read, Show)
157+tabsInLine num tabstop [] = ""
158+tabsInLine num tabstop (c:cs) =
159+ let (replacement, nextnum) = if c == '\t'
160+ then (replicate num ' ', tabstop)
164+ in replacement ++ tabsInLine nextnum tabstop cs
135−-- | Auxiliary functions used in preliminary parsing
166+-- | Returns an association list of backslash escapes for the
136−isNoteBlock :: Reference -> Bool
167+-- designated characters.
137−isNoteBlock (NoteBlock _ _) = True
168+backslashEscapes :: [Char] -- ^ list of special characters to escape
138−isNoteBlock _ = False
169+ -> [(Char, String)]
170+backslashEscapes = map (\ch -> (ch, ['\\',ch]))
140−isKeyBlock :: Reference -> Bool
172+-- | Escape a string of characters, using an association list of
141−isKeyBlock (KeyBlock _ _) = True
173+-- characters and strings.
142−isKeyBlock _ = False
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
180+ where rest = escapeStringUsing escapeTable xs
144−isLineClump :: Reference -> Bool
182+-- | Strip trailing newlines from string.
145−isLineClump (LineClump _) = True
183+stripTrailingNewlines :: String -> String
146−isLineClump _ = False
184+stripTrailingNewlines = reverse . dropWhile (== '\n') . reverse
148−data ParserState = ParserState
186+-- | Remove leading and trailing space (including newlines) from string.
149− { stateParseRaw :: Bool, -- ^ Parse untranslatable HTML
187+removeLeadingTrailingSpace :: String -> String
150− -- and LaTeX?
188+removeLeadingTrailingSpace = removeLeadingSpace . removeTrailingSpace
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)
170−defaultParserState :: ParserState
190+-- | Remove leading space (including newlines) from string.
171−defaultParserState =
191+removeLeadingSpace :: String -> String
172− ParserState { stateParseRaw = False,
192+removeLeadingSpace = dropWhile (`elem` " \n\t")
173− stateParserContext = NullState,
193+
174− stateQuoteContext = NoQuote,
194+-- | Remove trailing space (including newlines) from string.
175− stateKeys = [],
195+removeTrailingSpace :: String -> String
176− stateNotes = [],
196+removeTrailingSpace = reverse . removeLeadingSpace . reverse
177− stateTabStop = 4,
197+
178− stateStandalone = False,
198+-- | Strip leading and trailing characters from string
179− stateTitle = [],
199+stripFirstAndLast :: String -> String
180− stateAuthors = [],
200+stripFirstAndLast str =
181− stateDate = [],
201+ drop 1 $ take ((length str) - 1) str
182− stateStrict = False,
202+
183− stateSmart = False,
203+-- | Change CamelCase word to hyphenated lowercase (e.g., camel-case).
184− stateColumns = 80,
204+camelCaseToHyphenated :: String -> String
185− stateHeaderTable = [] }
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)
210+-- | Convert number < 4000 to uppercase roman numeral.
211+toRomanNumeral :: Int -> String
213+ if x >= 4000 || x < 0
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)
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
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
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]
251+ rest <- manyTill p end
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))
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
266+-- | Parses a space or tab.
267+spaceChar :: CharParser st Char
268+spaceChar = oneOf " \t"
270+-- | Skips zero or more spaces or tabs.
271+skipSpaces :: GenParser Char st ()
272+skipSpaces = skipMany spaceChar
274+-- | Skips zero or more spaces or tabs, then reads a newline.
275+blankline :: GenParser Char st Char
276+blankline = try $ skipSpaces >> newline
278+-- | Parses one or more blank lines and returns a string of newlines.
279+blanklines :: GenParser Char st [Char]
280+blanklines = many1 blankline
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)
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)
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
307+-- | Parse raw line block up to and including blank lines.
308+lineClump :: GenParser Char st String
310+ lines <- many1 (notFollowedBy blankline >> anyLine)
311+ blanks <- blanklines <|> (eof >> return "\n")
312+ return $ (unlines lines) ++ blanks
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
320+charsInBalanced :: Char -> Char -> GenParser Char st String
321+charsInBalanced open close = try $ do
323+ raw <- manyTill ( (do res <- charsInBalanced open close
324+ return $ [open] ++ res ++ [close])
325+ <|> (do notFollowedBy' (blankline >> blanklines)
330+-- | Like @charsInBalanced@, but allow blank lines in the content.
331+charsInBalanced' :: Char -> Char -> GenParser Char st String
332+charsInBalanced' open close = try $ do
334+ raw <- manyTill ( (do res <- charsInBalanced open close
335+ return $ [open] ++ res ++ [close])
336+ <|> count 1 anyChar)
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
369+ then fail "not a roman numeral"
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
382+ return (result, sourceColumn pos2 - sourceColumn pos1)
187-- | Parses a character and returns 'Null' (so that the parser can move on
384-- | Parses a character and returns 'Null' (so that the parser can move on
188-- if it gets stuck).
385-- if it gets stuck).
189nullBlock :: GenParser Char st Block
386nullBlock :: GenParser Char st Block
192− return Null
387+nullBlock = anyChar >> return Null
194-- | Fail if reader is in strict markdown syntax mode.
389-- | Fail if reader is in strict markdown syntax mode.
195failIfStrict :: GenParser Char ParserState ()
390failIfStrict :: GenParser Char ParserState ()
196failIfStrict = do
391failIfStrict = do
197 state <- getState
392 state <- getState
198− if stateStrict state then fail "Strict mode" else return ()
393+ if stateStrict state then fail "strict mode" else return ()
200-- | Parses backslash, then applies character parser.
395-- | Parses backslash, then applies character parser.
201escaped :: GenParser Char st Char -- ^ Parser for character to escape
396escaped :: GenParser Char st Char -- ^ Parser for character to escape
202 -> GenParser Char st Inline
397 -> GenParser Char st Inline
203−escaped parser = try (do
398+escaped parser = try $ do
204− char '\\'
399+ char '\\'
205− result <- parser
400+ result <- parser
206− return (Str [result]))
401+ return (Str [result])
208-- | Parses an uppercase roman numeral and returns (UpperRoman, number).
403-- | Parses an uppercase roman numeral and returns (UpperRoman, number).
209upperRoman :: GenParser Char st (ListNumberStyle, Int)
404upperRoman :: GenParser Char st (ListNumberStyle, Int)
210upperRoman = do
405upperRoman = do
211− num <- romanNumeral True
406+ num <- romanNumeral True
212− return (UpperRoman, num)
407+ return (UpperRoman, num)
214-- | Parses a lowercase roman numeral and returns (LowerRoman, number).
409-- | Parses a lowercase roman numeral and returns (LowerRoman, number).
215lowerRoman :: GenParser Char st (ListNumberStyle, Int)
410lowerRoman :: GenParser Char st (ListNumberStyle, Int)
216lowerRoman = do
411lowerRoman = do
217− num <- romanNumeral False
412+ num <- romanNumeral False
218− return (LowerRoman, num)
413+ return (LowerRoman, num)
220-- | Parses a decimal numeral and returns (Decimal, number).
415-- | Parses a decimal numeral and returns (Decimal, number).
221decimal :: GenParser Char st (ListNumberStyle, Int)
416decimal :: GenParser Char st (ListNumberStyle, Int)
222decimal = do
417decimal = do
223− num <- many1 digit
418+ num <- many1 digit
224− return (Decimal, read num)
419+ return (Decimal, read num)
226-- | Parses a '#' returns (DefaultStyle, 1).
421-- | Parses a '#' returns (DefaultStyle, 1).
227defaultNum :: GenParser Char st (ListNumberStyle, Int)
422defaultNum :: GenParser Char st (ListNumberStyle, Int)
228defaultNum = do
423defaultNum = do
229− char '#'
424+ char '#'
230− return (DefaultStyle, 1)
425+ return (DefaultStyle, 1)
232-- | Parses a lowercase letter and returns (LowerAlpha, number).
427-- | Parses a lowercase letter and returns (LowerAlpha, number).
233lowerAlpha :: GenParser Char st (ListNumberStyle, Int)
428lowerAlpha :: GenParser Char st (ListNumberStyle, Int)
234lowerAlpha = do
429lowerAlpha = do
235− ch <- oneOf ['a'..'z']
430+ ch <- oneOf ['a'..'z']
236− return (LowerAlpha, ord ch - ord 'a' + 1)
431+ return (LowerAlpha, ord ch - ord 'a' + 1)
238-- | Parses an uppercase letter and returns (UpperAlpha, number).
433-- | Parses an uppercase letter and returns (UpperAlpha, number).
239upperAlpha :: GenParser Char st (ListNumberStyle, Int)
434upperAlpha :: GenParser Char st (ListNumberStyle, Int)
240upperAlpha = do
435upperAlpha = do
241− ch <- oneOf ['A'..'Z']
436+ ch <- oneOf ['A'..'Z']
242− return (UpperAlpha, ord ch - ord 'A' + 1)
437+ return (UpperAlpha, ord ch - ord 'A' + 1)
244-- | Parses a roman numeral i or I
439-- | Parses a roman numeral i or I
245romanOne :: GenParser Char st (ListNumberStyle, Int)
440romanOne :: GenParser Char st (ListNumberStyle, Int)
246−romanOne = (do char 'i'
247− return (LowerRoman, 1)) <|>
441+romanOne = (char 'i' >> return (LowerRoman, 1)) <|>
249− return (UpperRoman, 1))
442+ (char 'I' >> return (UpperRoman, 1))
251-- | Parses an ordered list marker and returns list attributes.
444-- | Parses an ordered list marker and returns list attributes.
252anyOrderedListMarker :: GenParser Char st ListAttributes
445anyOrderedListMarker :: GenParser Char st ListAttributes
253−anyOrderedListMarker = choice $ [delimParser numParser | delimParser <-
446+anyOrderedListMarker = choice $
254− [inPeriod, inOneParen, inTwoParens],
447+ [delimParser numParser | delimParser <- [inPeriod, inOneParen, inTwoParens],
255− numParser <- [decimal, defaultNum, romanOne,
448+ numParser <- [decimal, defaultNum, romanOne,
256− lowerAlpha, lowerRoman, upperAlpha, upperRoman]]
449+ lowerAlpha, lowerRoman, upperAlpha, upperRoman]]
258-- | Parses a list number (num) followed by a period, returns list attributes.
451-- | Parses a list number (num) followed by a period, returns list attributes.
259inPeriod :: GenParser Char st (ListNumberStyle, Int)
452inPeriod :: GenParser Char st (ListNumberStyle, Int)
260 -> GenParser Char st ListAttributes
453 -> GenParser Char st ListAttributes
261inPeriod num = try $ do
454inPeriod num = try $ do
262− (style, start) <- num
455+ (style, start) <- num
263− char '.'
456+ char '.'
264− let delim = if style == DefaultStyle
457+ let delim = if style == DefaultStyle
265− then DefaultDelim
458+ then DefaultDelim
266− else Period
459+ else Period
267− return (start, style, delim)
460+ return (start, style, delim)
269-- | Parses a list number (num) followed by a paren, returns list attributes.
462-- | Parses a list number (num) followed by a paren, returns list attributes.
270inOneParen :: GenParser Char st (ListNumberStyle, Int)
463inOneParen :: GenParser Char st (ListNumberStyle, Int)
271 -> GenParser Char st ListAttributes
464 -> GenParser Char st ListAttributes
272inOneParen num = try $ do
465inOneParen num = try $ do
273− (style, start) <- num
466+ (style, start) <- num
274− char ')'
467+ char ')'
275− return (start, style, OneParen)
468+ return (start, style, OneParen)
277-- | Parses a list number (num) enclosed in parens, returns list attributes.
470-- | Parses a list number (num) enclosed in parens, returns list attributes.
278inTwoParens :: GenParser Char st (ListNumberStyle, Int)
471inTwoParens :: GenParser Char st (ListNumberStyle, Int)
279 -> GenParser Char st ListAttributes
472 -> GenParser Char st ListAttributes
280inTwoParens num = try $ do
473inTwoParens num = try $ do
281− char '('
474+ char '('
282− (style, start) <- num
475+ (style, start) <- num
283− char ')'
476+ char ')'
284− return (start, style, TwoParens)
477+ return (start, style, TwoParens)
286-- | Parses an ordered list marker with a given style and delimiter,
479-- | Parses an ordered list marker with a given style and delimiter,
287-- returns number.
480-- returns number.
@@ -289,21 +482,158 @@ orderedListMarker :: ListNumberStyle
289 -> ListNumberDelim
482 -> ListNumberDelim
290 -> GenParser Char st Int
483 -> GenParser Char st Int
291orderedListMarker style delim = do
484orderedListMarker style delim = do
292− let num = case style of
485+ let num = case style of
293− DefaultStyle -> decimal <|> defaultNum
486+ DefaultStyle -> decimal <|> defaultNum
294− Decimal -> decimal
487+ Decimal -> decimal
295− UpperRoman -> upperRoman
488+ UpperRoman -> upperRoman
296− LowerRoman -> lowerRoman
489+ LowerRoman -> lowerRoman
297− UpperAlpha -> upperAlpha
490+ UpperAlpha -> upperAlpha
298− LowerAlpha -> lowerAlpha
491+ LowerAlpha -> lowerAlpha
299− let context = case delim of
492+ let context = case delim of
300− DefaultDelim -> inPeriod
493+ DefaultDelim -> inPeriod
301− Period -> inPeriod
494+ Period -> inPeriod
302− OneParen -> inOneParen
495+ OneParen -> inOneParen
303− TwoParens -> inTwoParens
496+ TwoParens -> inTwoParens
304− (start, style, delim) <- context num
497+ (start, style, delim) <- context num
305− return start
498+ return start
500+-- | Parses a character reference and returns a Str element.
501+charRef :: GenParser Char st Inline
503+ c <- characterReference
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
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
516+-- | Parse a string with @parser@ (for testing).
517+testStringWith :: (Show a) => GenParser Char ParserState a
520+testStringWith parser str = putStrLn $ show $
521+ readWith parser defaultParserState str
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
542+defaultParserState :: ParserState
544+ ParserState { stateParseRaw = False,
545+ stateParserContext = NullState,
546+ stateQuoteContext = NoQuote,
550+ stateStandalone = False,
554+ stateStrict = False,
557+ stateHeaderTable = [] }
559+-- | References from preliminary parsing.
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)
566+-- | Auxiliary functions used in preliminary parsing.
567+isNoteBlock :: Reference -> Bool
568+isNoteBlock (NoteBlock _ _) = True
569+isNoteBlock _ = False
571+isKeyBlock :: Reference -> Bool
572+isKeyBlock (KeyBlock _ _) = True
575+isLineClump :: Reference -> Bool
576+isLineClump (LineClump _) = True
577+isLineClump _ = False
580+ = SingleHeader Char -- ^ Single line of characters underneath
581+ | DoubleHeader Char -- ^ Lines of characters above and below
585+ = ListItemState -- ^ Used when running parser on list item contents
586+ | NullState -- ^ Default state
590+ = InSingleQuote -- ^ Used when parsing inside single quotes
591+ | InDoubleQuote -- ^ Used when parsing inside double quotes
592+ | NoQuote -- ^ Used when not parsing inside quotes
595+type NoteTable = [(String, [Block])]
597+type KeyTable = [([Inline], Target)]
599+-- | Look up key in key table and return target object.
600+lookupKeySrc :: KeyTable -- ^ Key table
601+ -> [Inline] -- ^ Key
603+lookupKeySrc table key = case find (refsMatch key . fst) table of
605+ Just (_, src) -> Just src
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
634+-- Native format prettyprinting
307-- | Indent string as a block.
637-- | Indent string as a block.
308indentBy :: Int -- ^ Number of spaces to indent the block
638indentBy :: Int -- ^ Number of spaces to indent the block
309 -> Int -- ^ Number of spaces (rel to block) to indent first line
639 -> Int -- ^ Number of spaces (rel to block) to indent first line
@@ -311,9 +641,10 @@ indentBy :: Int -- ^ Number of spaces to indent the block
311 -> String
641 -> String
312indentBy num first [] = ""
642indentBy num first [] = ""
313indentBy num first str =
643indentBy num first str =
314− let (firstLine:restLines) = lines str
644+ let (firstLine:restLines) = lines str
315− firstLineIndent = num + first in
645+ firstLineIndent = num + first
316− (replicate firstLineIndent ' ') ++ firstLine ++ "\n" ++ (joinWithSep "\n" $ map (\line -> (replicate num ' ') ++ line) restLines)
646+ in (replicate firstLineIndent ' ') ++ firstLine ++ "\n" ++
647+ (joinWithSep "\n" $ map ((replicate num ' ') ++ ) restLines)
318-- | Prettyprint list of Pandoc blocks elements.
649-- | Prettyprint list of Pandoc blocks elements.
319prettyBlockList :: Int -- ^ Number of spaces to indent list of blocks
650prettyBlockList :: Int -- ^ Number of spaces to indent list of blocks
@@ -321,142 +652,40 @@ prettyBlockList :: Int -- ^ Number of spaces to indent list of blocks
321 -> String
652 -> String
322prettyBlockList indent [] = indentBy indent 0 "[]"
653prettyBlockList indent [] = indentBy indent 0 "[]"
323prettyBlockList indent blocks = indentBy indent (-2) $ "[ " ++
654prettyBlockList indent blocks = indentBy indent (-2) $ "[ " ++
324− (joinWithSep "\n, " (map prettyBlock blocks)) ++ " ]"
655+ (joinWithSep "\n, " (map prettyBlock blocks)) ++ " ]"
326-- | Prettyprint Pandoc block element.
657-- | Prettyprint Pandoc block element.
327prettyBlock :: Block -> String
658prettyBlock :: Block -> String
328prettyBlock (BlockQuote blocks) = "BlockQuote\n " ++
659prettyBlock (BlockQuote blocks) = "BlockQuote\n " ++
329 (prettyBlockList 2 blocks)
660 (prettyBlockList 2 blocks)
330prettyBlock (OrderedList attribs blockLists) =
661prettyBlock (OrderedList attribs blockLists) =
331− "OrderedList " ++ show attribs ++ "\n" ++ indentBy 2 0 ("[ " ++
662+ "OrderedList " ++ show attribs ++ "\n" ++ indentBy 2 0 ("[ " ++
332− (joinWithSep ", " $ map (\blocks -> prettyBlockList 2 blocks)
663+ (joinWithSep ", " $ map (\blocks -> prettyBlockList 2 blocks)
333− blockLists)) ++ " ]"
664+ blockLists)) ++ " ]"
334prettyBlock (BulletList blockLists) = "BulletList\n" ++
665prettyBlock (BulletList blockLists) = "BulletList\n" ++
335− indentBy 2 0 ("[ " ++ (joinWithSep ", "
666+ indentBy 2 0 ("[ " ++ (joinWithSep ", "
336− (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"
667+ (map (\blocks -> prettyBlockList 2 blocks) blockLists))) ++ " ]"
337prettyBlock (DefinitionList blockLists) = "DefinitionList\n" ++
668prettyBlock (DefinitionList blockLists) = "DefinitionList\n" ++
338− indentBy 2 0 ("[" ++ (joinWithSep ",\n"
669+ indentBy 2 0 ("[" ++ (joinWithSep ",\n"
339− (map (\(term, blocks) -> " (" ++ show term ++ ",\n" ++
670+ (map (\(term, blocks) -> " (" ++ show term ++ ",\n" ++
340− indentBy 1 2 (prettyBlockList 2 blocks) ++ " )") blockLists))) ++ " ]"
671+ indentBy 1 2 (prettyBlockList 2 blocks) ++ " )") blockLists))) ++ " ]"
341prettyBlock (Table caption aligns widths header rows) =
672prettyBlock (Table caption aligns widths header rows) =
342− "Table " ++ show caption ++ " " ++ show aligns ++ " " ++
673+ "Table " ++ show caption ++ " " ++ show aligns ++ " " ++
343− show widths ++ "\n" ++ prettyRow header ++ " [\n" ++
674+ show widths ++ "\n" ++ prettyRow header ++ " [\n" ++
344− (joinWithSep ",\n" (map prettyRow rows)) ++ " ]"
675+ (joinWithSep ",\n" (map prettyRow rows)) ++ " ]"
345− where prettyRow cols = indentBy 2 0 ("[ " ++ (joinWithSep ", "
676+ where prettyRow cols = indentBy 2 0 ("[ " ++ (joinWithSep ", "
346− (map (\blocks -> prettyBlockList 2 blocks)
677+ (map (\blocks -> prettyBlockList 2 blocks)
347− cols))) ++ " ]"
678+ cols))) ++ " ]"
348prettyBlock block = show block
679prettyBlock block = show block
350-- | Prettyprint Pandoc document.
681-- | Prettyprint Pandoc document.
351prettyPandoc :: Pandoc -> String
682prettyPandoc :: Pandoc -> String
352−prettyPandoc (Pandoc meta blocks) = "Pandoc " ++ "(" ++ (show meta) ++
683+prettyPandoc (Pandoc meta blocks) = "Pandoc " ++ "(" ++ show meta ++
353− ")\n" ++ (prettyBlockList 0 blocks) ++ "\n"
684+ ")\n" ++ (prettyBlockList 0 blocks) ++ "\n"
355−-- | Convert tabs to spaces (with adjustable tab stop).
356−tabsToSpaces :: Int -- ^ Tabstop
357− -> String -- ^ String to convert
359−tabsToSpaces tabstop str =
360− unlines (map (tabsInLine tabstop tabstop) (lines str))
362−-- | Convert tabs to spaces in one line.
686+--
363−tabsInLine :: Int -- ^ Number of spaces to next tab stop
687+-- Pandoc block and inline list processing
364− -> Int -- ^ Tabstop
688+--
365− -> String -- ^ Line to convert
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)
374− replacement ++ (tabsInLine nextnum tabstop cs)
376−-- | Returns an association list of backslash escapes for the
377−-- designated characters.
378−backslashEscapes :: [Char] -- ^ list of special characters to escape
380−backslashEscapes = map (\ch -> (ch, ['\\',ch]))
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
390− where rest = escapeStringUsing escapeTable xs
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)
397−-- | Joins a list of lists, separated by another list.
398−joinWithSep :: [a] -- ^ List to use as separator
399− -> [[a]] -- ^ Lists to join
401−joinWithSep sep [] = []
402−joinWithSep sep lst = foldr1 (\a b -> a ++ sep ++ b) lst
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)
412−-- | Remove leading and trailing space (including newlines) from string.
413−removeLeadingTrailingSpace :: String -> String
414−removeLeadingTrailingSpace = removeLeadingSpace . removeTrailingSpace
416−-- | Remove leading space (including newlines) from string.
417−removeLeadingSpace :: String -> String
418−removeLeadingSpace = dropWhile (\x -> (x == ' ') || (x == '\n') ||
421−-- | Remove trailing space (including newlines) from string.
422−removeTrailingSpace :: String -> String
423−removeTrailingSpace = reverse . removeLeadingSpace . reverse
425−-- | Strip leading and trailing characters from string
426−stripFirstAndLast :: String -> String
427−stripFirstAndLast str =
428− drop 1 $ take ((length str) - 1) str
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)
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)
446−-- | Split list into groups separated by sep.
447−splitBy :: (Eq a) => a -> [a] -> [[a]]
450− let (first, rest) = break (== sep) lst
451− rest' = dropWhile (== sep) rest in
452− first:(splitBy sep rest')
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)
461-- | Generate infinite lazy list of markers for an ordered list,
690-- | Generate infinite lazy list of markers for an ordered list,
462-- depending on list attributes.
691-- depending on list attributes.
@@ -466,8 +695,10 @@ orderedListMarkers (start, numstyle, numdelim) =
466 seq = case numstyle of
695 seq = case numstyle of
467 DefaultStyle -> map show [start..]
696 DefaultStyle -> map show [start..]
468 Decimal -> map show [start..]
697 Decimal -> map show [start..]
469− UpperAlpha -> drop (start - 1) $ cycle $ map singleton ['A'..'Z']
698+ UpperAlpha -> drop (start - 1) $ cycle $
470− LowerAlpha -> drop (start - 1) $ cycle $ map singleton ['a'..'z']
699+ map singleton ['A'..'Z']
700+ LowerAlpha -> drop (start - 1) $ cycle $
701+ map singleton ['a'..'z']
471 UpperRoman -> map toRomanNumeral [start..]
702 UpperRoman -> map toRomanNumeral [start..]
472 LowerRoman -> map (map toLower . toRomanNumeral) [start..]
703 LowerRoman -> map (map toLower . toRomanNumeral) [start..]
473 inDelim str = case numdelim of
704 inDelim str = case numdelim of
@@ -477,27 +708,6 @@ orderedListMarkers (start, numstyle, numdelim) =
477 TwoParens -> "(" ++ str ++ ")"
708 TwoParens -> "(" ++ str ++ ")"
478 in map inDelim seq
709 in map inDelim seq
480−-- | Convert number < 4000 to uppercase roman numeral.
481−toRomanNumeral :: Int -> String
483− if x >= 4000 || x < 0
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)
501-- | Normalize a list of inline elements: remove leading and trailing
711-- | Normalize a list of inline elements: remove leading and trailing
502-- @Space@ elements, collapse double @Space@s into singles, and
712-- @Space@ elements, collapse double @Space@s into singles, and
503-- remove empty Str elements.
713-- remove empty Str elements.
@@ -507,16 +717,14 @@ normalizeSpaces list =
507 let removeDoubles [] = []
717 let removeDoubles [] = []
508 removeDoubles (Space:Space:rest) = removeDoubles (Space:rest)
718 removeDoubles (Space:Space:rest) = removeDoubles (Space:rest)
509 removeDoubles ((Str ""):rest) = removeDoubles rest
719 removeDoubles ((Str ""):rest) = removeDoubles rest
510− removeDoubles (x:rest) = x:(removeDoubles rest) in
720+ removeDoubles (x:rest) = x:(removeDoubles rest)
511− let removeLeading [] = []
721+ removeLeading (Space:xs) = removeLeading xs
512− removeLeading lst = if ((head lst) == Space)
722+ removeLeading x = x
513− then tail lst
723+ removeTrailing [] = []
514− else lst in
724+ removeTrailing lst = if (last lst == Space)
515− let removeTrailing [] = []
725+ then init lst
516− removeTrailing lst = if ((last lst) == Space)
726+ else lst
517− then init lst
727+ in removeLeading $ removeTrailing $ removeDoubles list
519− removeLeading $ removeTrailing $ removeDoubles list
521-- | Change final list item from @Para@ to @Plain@ if the list should
729-- | Change final list item from @Para@ to @Plain@ if the list should
522-- be compact.
730-- be compact.
@@ -524,122 +732,86 @@ compactify :: [[Block]] -- ^ List of list items (each a list of blocks)
524 -> [[Block]]
732 -> [[Block]]
525compactify [] = []
733compactify [] = []
526compactify items =
734compactify items =
527− let final = last items
735+ let final = last items
528− others = init items in
736+ others = init items
529− case final of
737+ in case final of
530− [Para a] -> if any containsPara others
738+ [Para a] -> if any containsPara others
531− then items
739+ then items
532− else others ++ [[Plain a]]
740+ else others ++ [[Plain a]]
533− otherwise -> items
741+ otherwise -> items
535containsPara :: [Block] -> Bool
743containsPara :: [Block] -> Bool
536containsPara [] = False
744containsPara [] = False
537containsPara ((Para a):rest) = True
745containsPara ((Para a):rest) = True
538−containsPara ((BulletList items):rest) = (any containsPara items) ||
746+containsPara ((BulletList items):rest) = any containsPara items ||
539− (containsPara rest)
747+ containsPara rest
540−containsPara ((OrderedList _ items):rest) = (any containsPara items) ||
748+containsPara ((OrderedList _ items):rest) = any containsPara items ||
541− (containsPara rest)
749+ containsPara rest
750+containsPara ((DefinitionList items):rest) = any containsPara (map snd items) ||
542containsPara (x:rest) = containsPara rest
752containsPara (x:rest) = containsPara rest
544-- | Data structure for defining hierarchical Pandoc documents
754-- | Data structure for defining hierarchical Pandoc documents
545data Element = Blk Block
755data Element = Blk Block
546 | Sec [Inline] [Element] deriving (Eq, Read, Show)
756 | Sec [Inline] [Element] deriving (Eq, Read, Show)
548−-- | Returns true on Header block with level at least 'level'
758+-- | Returns @True@ on Header block with at least the specified level
549headerAtLeast :: Int -> Block -> Bool
759headerAtLeast :: Int -> Block -> Bool
550headerAtLeast level (Header x _) = x <= level
760headerAtLeast level (Header x _) = x <= level
551headerAtLeast level _ = False
761headerAtLeast level _ = False
553−-- | Convert list of Pandoc blocks into list of Elements (hierarchical)
763+-- | Convert list of Pandoc blocks into (hierarchical) list of Elements
554hierarchicalize :: [Block] -> [Element]
764hierarchicalize :: [Block] -> [Element]
555hierarchicalize [] = []
765hierarchicalize [] = []
556hierarchicalize (block:rest) =
766hierarchicalize (block:rest) =
557 case block of
767 case block of
558− (Header level title) -> let (thisSection, rest') = break (headerAtLeast
768+ (Header level title) ->
559− level) rest in
769+ let (thisSection, rest') = break (headerAtLeast level) rest
560− (Sec title (hierarchicalize thisSection)):
770+ in (Sec title (hierarchicalize thisSection)):(hierarchicalize rest')
561− (hierarchicalize rest')
771+ x -> (Blk x):(hierarchicalize rest)
562− x -> (Blk x):(hierarchicalize rest)
564-- | True if block is a Header block.
773-- | True if block is a Header block.
565isHeaderBlock :: Block -> Bool
774isHeaderBlock :: Block -> Bool
566isHeaderBlock (Header _ _) = True
775isHeaderBlock (Header _ _) = True
567isHeaderBlock _ = False
776isHeaderBlock _ = False
569-- | Options for writers
782-- | Options for writers
570data WriterOptions = WriterOptions
783data WriterOptions = WriterOptions
571− { writerStandalone :: Bool -- ^ Include header and footer
784+ { writerStandalone :: Bool -- ^ Include header and footer
572− , writerTitlePrefix :: String -- ^ Prefix for HTML titles
785+ , writerHeader :: String -- ^ Header for the document
573− , writerHeader :: String -- ^ Header for the document
786+ , writerTitlePrefix :: String -- ^ Prefix for HTML titles
574− , writerIncludeBefore :: String -- ^ String to include before the body
787+ , writerTabStop :: Int -- ^ Tabstop for conversion btw spaces and tabs
575− , writerIncludeAfter :: String -- ^ String to include after the body
788+ , writerTableOfContents :: Bool -- ^ Include table of contents
576− , writerTableOfContents :: Bool -- ^ Include table of contents
789+ , writerS5 :: Bool -- ^ We're writing S5
577− , writerS5 :: Bool -- ^ We're writing S5
790+ , writerUseASCIIMathML :: Bool -- ^ Use ASCIIMathML
578− , writerUseASCIIMathML :: Bool -- ^ Use ASCIIMathML
791+ , writerASCIIMathMLURL :: Maybe String -- ^ URL to asciiMathML.js
579− , writerASCIIMathMLURL :: Maybe String -- ^ URL to asciiMathML.js
792+ , writerIgnoreNotes :: Bool -- ^ Ignore footnotes (used in making toc)
580− , writerIgnoreNotes :: Bool -- ^ Ignore footnotes (used in making toc)
793+ , writerIncremental :: Bool -- ^ Incremental S5 lists
581− , writerIncremental :: Bool -- ^ Incremental S5 lists
794+ , writerNumberSections :: Bool -- ^ Number sections in LaTeX
582− , writerNumberSections :: Bool -- ^ Number sections in LaTeX
795+ , writerIncludeBefore :: String -- ^ String to include before the body
583− , writerStrictMarkdown :: Bool -- ^ Use strict markdown syntax
796+ , writerIncludeAfter :: String -- ^ String to include after the body
584− , writerReferenceLinks :: Bool -- ^ Use reference links in writing markdown, rst
797+ , writerStrictMarkdown :: Bool -- ^ Use strict markdown syntax
585− , writerTabStop :: Int -- ^ Tabstop for conversion between
798+ , writerReferenceLinks :: Bool -- ^ Use reference links in writing markdown, rst
586− -- spaces and tabs
799+ } deriving Show
589-- | Default writer options.
801-- | Default writer options.
590defaultWriterOptions =
802defaultWriterOptions =
591− WriterOptions { writerStandalone = False,
803+ WriterOptions { writerStandalone = False,
592− writerHeader = "",
804+ writerHeader = "",
593− writerTitlePrefix = "",
805+ writerTitlePrefix = "",
594− writerTabStop = 4,
806+ writerTabStop = 4,
595− writerTableOfContents = False,
807+ writerTableOfContents = False,
596− writerS5 = False,
808+ writerS5 = False,
597− writerUseASCIIMathML = False,
809+ writerUseASCIIMathML = False,
598− writerASCIIMathMLURL = Nothing,
810+ writerASCIIMathMLURL = Nothing,
599− writerIgnoreNotes = False,
811+ writerIgnoreNotes = False,
600− writerIncremental = False,
812+ writerIncremental = False,
601− writerNumberSections = False,
813+ writerNumberSections = False,
602− writerIncludeBefore = "",
814+ writerIncludeBefore = "",
603− writerIncludeAfter = "",
815+ writerIncludeAfter = "",
604− writerStrictMarkdown = False,
816+ writerStrictMarkdown = False,
605− writerReferenceLinks = False }
817+ writerReferenceLinks = False }
608−-- code to lookup reference keys in key table
611−-- | Look up key in key table and return target object.
612−lookupKeySrc :: KeyTable -- ^ Key table
613− -> [Inline] -- ^ Key
615−lookupKeySrc table key = case table of
617− (k, src):rest -> if (refsMatch k key)
619− else lookupKeySrc rest key
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