summaryrefslogtreecommitdiff
path: root/src/Text/Pandoc/Readers/Textile.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc/Readers/Textile.hs')
-rw-r--r--src/Text/Pandoc/Readers/Textile.hs279
1 files changed, 138 insertions, 141 deletions
diff --git a/src/Text/Pandoc/Readers/Textile.hs b/src/Text/Pandoc/Readers/Textile.hs
index 8dbbf7be2..30bb6a715 100644
--- a/src/Text/Pandoc/Readers/Textile.hs
+++ b/src/Text/Pandoc/Readers/Textile.hs
@@ -1,6 +1,6 @@
{-
-Copyright (C) 2010-2015 Paul Rivier <paul*rivier#demotera*com> | tr '*#' '.@'
- and John MacFarlane
+Copyright (C) 2010-2012 Paul Rivier <paul*rivier#demotera*com> | tr '*#' '.@'
+ 2010-2018 John MacFarlane
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
@@ -19,7 +19,8 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
{- |
Module : Text.Pandoc.Readers.Textile
- Copyright : Copyright (C) 2010-2015 Paul Rivier and John MacFarlane
+ Copyright : Copyright (C) 2010-2012 Paul Rivier
+ 2010-2018 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : Paul Rivier <paul*rivier#demotera*com>
@@ -51,44 +52,42 @@ TODO : refactor common patterns across readers :
module Text.Pandoc.Readers.Textile ( readTextile) where
+import Control.Monad (guard, liftM)
+import Control.Monad.Except (throwError)
+import Data.Char (digitToInt, isUpper)
+import Data.List (intercalate, intersperse, transpose)
+import Data.Monoid ((<>))
+import Data.Text (Text)
+import qualified Data.Text as T
+import Text.HTML.TagSoup (Tag (..), fromAttrib)
+import Text.HTML.TagSoup.Match
+import Text.Pandoc.Builder (Blocks, Inlines, trimInlines)
+import qualified Text.Pandoc.Builder as B
+import Text.Pandoc.Class (PandocMonad (..))
import Text.Pandoc.CSS
import Text.Pandoc.Definition
-import Text.Pandoc.Builder (Inlines, Blocks, trimInlines)
-import qualified Text.Pandoc.Builder as B
import Text.Pandoc.Options
import Text.Pandoc.Parsing
-import Text.Pandoc.Readers.HTML ( htmlTag, isBlockTag, isInlineTag )
-import Text.Pandoc.Shared (trim)
-import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock )
-import Text.HTML.TagSoup (fromAttrib, Tag(..))
-import Text.HTML.TagSoup.Match
-import Data.List ( intercalate, transpose, intersperse )
-import Data.Char ( digitToInt, isUpper )
-import Control.Monad ( guard, liftM, when )
-import Data.Monoid ((<>))
-import Text.Printf
-import Debug.Trace (trace)
-import Text.Pandoc.Error
+import Text.Pandoc.Readers.HTML (htmlTag, isBlockTag, isInlineTag)
+import Text.Pandoc.Readers.LaTeX (rawLaTeXBlock, rawLaTeXInline)
+import Text.Pandoc.Shared (crFilter, trim, underlineSpan)
-- | Parse a Textile text and return a Pandoc document.
-readTextile :: ReaderOptions -- ^ Reader options
- -> String -- ^ String to parse (assuming @'\n'@ line endings)
- -> Either PandocError Pandoc
-readTextile opts s =
- (readWith parseTextile) def{ stateOptions = opts } (s ++ "\n\n")
+readTextile :: PandocMonad m
+ => ReaderOptions -- ^ Reader options
+ -> Text -- ^ String to parse (assuming @'\n'@ line endings)
+ -> m Pandoc
+readTextile opts s = do
+ parsed <- readWithM parseTextile def{ stateOptions = opts }
+ (T.unpack (crFilter s) ++ "\n\n")
+ case parsed of
+ Right result -> return result
+ Left e -> throwError e
-- | Generate a Pandoc ADT from a textile document
-parseTextile :: Parser [Char] ParserState Pandoc
+parseTextile :: PandocMonad m => ParserT [Char] ParserState m Pandoc
parseTextile = do
- -- textile allows raw HTML and does smart punctuation by default,
- -- but we do not enable smart punctuation unless it is explicitly
- -- asked for, for better conversion to other light markup formats
- oldOpts <- stateOptions `fmap` getState
- updateState $ \state -> state{ stateOptions =
- oldOpts{ readerParseRaw = True
- , readerOldDashes = True
- } }
many blankline
startPos <- getPosition
-- go through once just to get list of reference keys and notes
@@ -103,15 +102,15 @@ parseTextile = do
blocks <- parseBlocks
return $ Pandoc nullMeta (B.toList blocks) -- FIXME
-noteMarker :: Parser [Char] ParserState [Char]
+noteMarker :: PandocMonad m => ParserT [Char] ParserState m [Char]
noteMarker = skipMany spaceChar >> string "fn" >> manyTill digit (char '.')
-noteBlock :: Parser [Char] ParserState [Char]
+noteBlock :: PandocMonad m => ParserT [Char] ParserState m [Char]
noteBlock = try $ do
startPos <- getPosition
ref <- noteMarker
optional blankline
- contents <- liftM unlines $ many1Till anyLine (blanklines <|> noteBlock)
+ contents <- unlines <$> many1Till anyLine (blanklines <|> noteBlock)
endPos <- getPosition
let newnote = (ref, contents ++ "\n")
st <- getState
@@ -121,11 +120,11 @@ noteBlock = try $ do
return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
-- | Parse document blocks
-parseBlocks :: Parser [Char] ParserState Blocks
+parseBlocks :: PandocMonad m => ParserT [Char] ParserState m Blocks
parseBlocks = mconcat <$> manyTill block eof
-- | Block parsers list tried in definition order
-blockParsers :: [Parser [Char] ParserState Blocks]
+blockParsers :: PandocMonad m => [ParserT [Char] ParserState m Blocks]
blockParsers = [ codeBlock
, header
, blockQuote
@@ -140,26 +139,22 @@ blockParsers = [ codeBlock
]
-- | Any block in the order of definition of blockParsers
-block :: Parser [Char] ParserState Blocks
+block :: PandocMonad m => ParserT [Char] ParserState m Blocks
block = do
res <- choice blockParsers <?> "block"
- pos <- getPosition
- tr <- getOption readerTrace
- when tr $
- trace (printf "line %d: %s" (sourceLine pos)
- (take 60 $ show $ B.toList res)) (return ())
+ trace (take 60 $ show $ B.toList res)
return res
-commentBlock :: Parser [Char] ParserState Blocks
+commentBlock :: PandocMonad m => ParserT [Char] ParserState m Blocks
commentBlock = try $ do
string "###."
manyTill anyLine blanklines
return mempty
-codeBlock :: Parser [Char] ParserState Blocks
+codeBlock :: PandocMonad m => ParserT [Char] ParserState m Blocks
codeBlock = codeBlockBc <|> codeBlockPre
-codeBlockBc :: Parser [Char] ParserState Blocks
+codeBlockBc :: PandocMonad m => ParserT [Char] ParserState m Blocks
codeBlockBc = try $ do
string "bc."
extended <- option False (True <$ char '.')
@@ -179,11 +174,10 @@ trimTrailingNewlines :: String -> String
trimTrailingNewlines = reverse . dropWhile (=='\n') . reverse
-- | Code Blocks in Textile are between <pre> and </pre>
-codeBlockPre :: Parser [Char] ParserState Blocks
+codeBlockPre :: PandocMonad m => ParserT [Char] ParserState m Blocks
codeBlockPre = try $ do
(t@(TagOpen _ attrs),_) <- htmlTag (tagOpen (=="pre") (const True))
result' <- manyTill anyChar (htmlTag (tagClose (=="pre")))
- optional blanklines
-- drop leading newline if any
let result'' = case result' of
'\n':xs -> xs
@@ -198,7 +192,7 @@ codeBlockPre = try $ do
return $ B.codeBlockWith (ident,classes,kvs) result'''
-- | Header of the form "hN. content" with N in 1..6
-header :: Parser [Char] ParserState Blocks
+header :: PandocMonad m => ParserT [Char] ParserState m Blocks
header = try $ do
char 'h'
level <- digitToInt <$> oneOf "123456"
@@ -210,14 +204,14 @@ header = try $ do
return $ B.headerWith attr' level name
-- | Blockquote of the form "bq. content"
-blockQuote :: Parser [Char] ParserState Blocks
+blockQuote :: PandocMonad m => ParserT [Char] ParserState m Blocks
blockQuote = try $ do
string "bq" >> attributes >> char '.' >> whitespace
B.blockQuote <$> para
-- Horizontal rule
-hrule :: Parser [Char] st Blocks
+hrule :: PandocMonad m => ParserT [Char] st m Blocks
hrule = try $ do
skipSpaces
start <- oneOf "-*"
@@ -232,66 +226,67 @@ hrule = try $ do
-- | Can be a bullet list or an ordered list. This implementation is
-- strict in the nesting, sublist must start at exactly "parent depth
-- plus one"
-anyList :: Parser [Char] ParserState Blocks
+anyList :: PandocMonad m => ParserT [Char] ParserState m Blocks
anyList = try $ anyListAtDepth 1 <* blanklines
-- | This allow one type of list to be nested into an other type,
-- provided correct nesting
-anyListAtDepth :: Int -> Parser [Char] ParserState Blocks
+anyListAtDepth :: PandocMonad m => Int -> ParserT [Char] ParserState m Blocks
anyListAtDepth depth = choice [ bulletListAtDepth depth,
orderedListAtDepth depth,
definitionList ]
-- | Bullet List of given depth, depth being the number of leading '*'
-bulletListAtDepth :: Int -> Parser [Char] ParserState Blocks
+bulletListAtDepth :: PandocMonad m => Int -> ParserT [Char] ParserState m Blocks
bulletListAtDepth depth = try $ B.bulletList <$> many1 (bulletListItemAtDepth depth)
-- | Bullet List Item of given depth, depth being the number of
-- leading '*'
-bulletListItemAtDepth :: Int -> Parser [Char] ParserState Blocks
+bulletListItemAtDepth :: PandocMonad m => Int -> ParserT [Char] ParserState m Blocks
bulletListItemAtDepth = genericListItemAtDepth '*'
-- | Ordered List of given depth, depth being the number of
-- leading '#'
-orderedListAtDepth :: Int -> Parser [Char] ParserState Blocks
+orderedListAtDepth :: PandocMonad m => Int -> ParserT [Char] ParserState m Blocks
orderedListAtDepth depth = try $ do
items <- many1 (orderedListItemAtDepth depth)
return $ B.orderedList items
-- | Ordered List Item of given depth, depth being the number of
-- leading '#'
-orderedListItemAtDepth :: Int -> Parser [Char] ParserState Blocks
+orderedListItemAtDepth :: PandocMonad m => Int -> ParserT [Char] ParserState m Blocks
orderedListItemAtDepth = genericListItemAtDepth '#'
-- | Common implementation of list items
-genericListItemAtDepth :: Char -> Int -> Parser [Char] ParserState Blocks
+genericListItemAtDepth :: PandocMonad m => Char -> Int -> ParserT [Char] ParserState m Blocks
genericListItemAtDepth c depth = try $ do
count depth (char c) >> attributes >> whitespace
- p <- mconcat <$> many listInline
+ contents <- mconcat <$> many ((B.plain . mconcat <$> many1 inline) <|>
+ try (newline >> codeBlockPre))
newline
sublist <- option mempty (anyListAtDepth (depth + 1))
- return $ (B.plain p) <> sublist
+ return $ contents <> sublist
-- | A definition list is a set of consecutive definition items
-definitionList :: Parser [Char] ParserState Blocks
+definitionList :: PandocMonad m => ParserT [Char] ParserState m Blocks
definitionList = try $ B.definitionList <$> many1 definitionListItem
-- | List start character.
-listStart :: Parser [Char] ParserState ()
+listStart :: PandocMonad m => ParserT [Char] ParserState m ()
listStart = genericListStart '*'
<|> () <$ genericListStart '#'
<|> () <$ definitionListStart
-genericListStart :: Char -> Parser [Char] st ()
+genericListStart :: PandocMonad m => Char -> ParserT [Char] st m ()
genericListStart c = () <$ try (many1 (char c) >> whitespace)
-basicDLStart :: Parser [Char] ParserState ()
+basicDLStart :: PandocMonad m => ParserT [Char] ParserState m ()
basicDLStart = do
char '-'
whitespace
notFollowedBy newline
-definitionListStart :: Parser [Char] ParserState Inlines
+definitionListStart :: PandocMonad m => ParserT [Char] ParserState m Inlines
definitionListStart = try $ do
basicDLStart
trimInlines . mconcat <$>
@@ -300,34 +295,30 @@ definitionListStart = try $ do
<|> try (lookAhead (() <$ string ":="))
)
-listInline :: Parser [Char] ParserState Inlines
-listInline = try (notFollowedBy newline >> inline)
- <|> try (endline <* notFollowedBy listStart)
-
-- | A definition list item in textile begins with '- ', followed by
-- the term defined, then spaces and ":=". The definition follows, on
-- the same single line, or spaned on multiple line, after a line
-- break.
-definitionListItem :: Parser [Char] ParserState (Inlines, [Blocks])
+definitionListItem :: PandocMonad m => ParserT [Char] ParserState m (Inlines, [Blocks])
definitionListItem = try $ do
term <- (mconcat . intersperse B.linebreak) <$> many1 definitionListStart
def' <- string ":=" *> optional whitespace *> (multilineDef <|> inlineDef)
return (term, def')
- where inlineDef :: Parser [Char] ParserState [Blocks]
+ where inlineDef :: PandocMonad m => ParserT [Char] ParserState m [Blocks]
inlineDef = liftM (\d -> [B.plain d])
- $ optional whitespace >> (trimInlines . mconcat <$> many listInline) <* newline
- multilineDef :: Parser [Char] ParserState [Blocks]
+ $ optional whitespace >> (trimInlines . mconcat <$> many inline) <* newline
+ multilineDef :: PandocMonad m => ParserT [Char] ParserState m [Blocks]
multilineDef = try $ do
optional whitespace >> newline
s <- many1Till anyChar (try (string "=:" >> newline))
-- this ++ "\n\n" does not look very good
- ds <- parseFromString parseBlocks (s ++ "\n\n")
+ ds <- parseFromString' parseBlocks (s ++ "\n\n")
return [ds]
-- raw content
-- | A raw Html Block, optionally followed by blanklines
-rawHtmlBlock :: Parser [Char] ParserState Blocks
+rawHtmlBlock :: PandocMonad m => ParserT [Char] ParserState m Blocks
rawHtmlBlock = try $ do
skipMany spaceChar
(_,b) <- htmlTag isBlockTag
@@ -335,14 +326,14 @@ rawHtmlBlock = try $ do
return $ B.rawBlock "html" b
-- | Raw block of LaTeX content
-rawLaTeXBlock' :: Parser [Char] ParserState Blocks
+rawLaTeXBlock' :: PandocMonad m => ParserT [Char] ParserState m Blocks
rawLaTeXBlock' = do
guardEnabled Ext_raw_tex
B.rawBlock "latex" <$> (rawLaTeXBlock <* spaces)
-- | In textile, paragraphs are separated by blank lines.
-para :: Parser [Char] ParserState Blocks
+para :: PandocMonad m => ParserT [Char] ParserState m Blocks
para = B.para . trimInlines . mconcat <$> many1 inline
-- Tables
@@ -353,7 +344,7 @@ toAlignment '>' = AlignRight
toAlignment '=' = AlignCenter
toAlignment _ = AlignDefault
-cellAttributes :: Parser [Char] ParserState (Bool, Alignment)
+cellAttributes :: PandocMonad m => ParserT [Char] ParserState m (Bool, Alignment)
cellAttributes = try $ do
isHeader <- option False (True <$ char '_')
-- we just ignore colspan and rowspan markers:
@@ -366,18 +357,18 @@ cellAttributes = try $ do
return (isHeader, alignment)
-- | A table cell spans until a pipe |
-tableCell :: Parser [Char] ParserState ((Bool, Alignment), Blocks)
+tableCell :: PandocMonad m => ParserT [Char] ParserState m ((Bool, Alignment), Blocks)
tableCell = try $ do
char '|'
- (isHeader, alignment) <- option (False, AlignDefault) $ cellAttributes
+ (isHeader, alignment) <- option (False, AlignDefault) cellAttributes
notFollowedBy blankline
raw <- trim <$>
many (noneOf "|\n" <|> try (char '\n' <* notFollowedBy blankline))
- content <- mconcat <$> parseFromString (many inline) raw
+ content <- mconcat <$> parseFromString' (many inline) raw
return ((isHeader, alignment), B.plain content)
-- | A table row is made of many table cells
-tableRow :: Parser [Char] ParserState [((Bool, Alignment), Blocks)]
+tableRow :: PandocMonad m => ParserT [Char] ParserState m [((Bool, Alignment), Blocks)]
tableRow = try $ do
-- skip optional row attributes
optional $ try $ do
@@ -387,7 +378,7 @@ tableRow = try $ do
many1 tableCell <* char '|' <* blankline
-- | A table with an optional header.
-table :: Parser [Char] ParserState Blocks
+table :: PandocMonad m => ParserT [Char] ParserState m Blocks
table = try $ do
-- ignore table attributes
caption <- option mempty $ try $ do
@@ -395,8 +386,8 @@ table = try $ do
_ <- attributes
char '.'
rawcapt <- trim <$> anyLine
- parseFromString (mconcat <$> many inline) rawcapt
- rawrows <- many1 $ (skipMany ignorableRow) >> tableRow
+ parseFromString' (mconcat <$> many inline) rawcapt
+ rawrows <- many1 $ skipMany ignorableRow >> tableRow
skipMany ignorableRow
blanklines
let (headers, rows) = case rawrows of
@@ -411,7 +402,7 @@ table = try $ do
(map (map snd) rows)
-- | Ignore markers for cols, thead, tfoot.
-ignorableRow :: Parser [Char] ParserState ()
+ignorableRow :: PandocMonad m => ParserT [Char] ParserState m ()
ignorableRow = try $ do
char '|'
oneOf ":^-~"
@@ -420,7 +411,7 @@ ignorableRow = try $ do
_ <- anyLine
return ()
-explicitBlockStart :: String -> Parser [Char] ParserState ()
+explicitBlockStart :: PandocMonad m => String -> ParserT [Char] ParserState m ()
explicitBlockStart name = try $ do
string name
attributes
@@ -430,9 +421,10 @@ explicitBlockStart name = try $ do
-- | Blocks like 'p' and 'table' do not need explicit block tag.
-- However, they can be used to set HTML/CSS attributes when needed.
-maybeExplicitBlock :: String -- ^ block tag name
- -> Parser [Char] ParserState Blocks -- ^ implicit block
- -> Parser [Char] ParserState Blocks
+maybeExplicitBlock :: PandocMonad m
+ => String -- ^ block tag name
+ -> ParserT [Char] ParserState m Blocks -- ^ implicit block
+ -> ParserT [Char] ParserState m Blocks
maybeExplicitBlock name blk = try $ do
optional $ explicitBlockStart name
blk
@@ -445,12 +437,11 @@ maybeExplicitBlock name blk = try $ do
-- | Any inline element
-inline :: Parser [Char] ParserState Inlines
-inline = do
- choice inlineParsers <?> "inline"
+inline :: PandocMonad m => ParserT [Char] ParserState m Inlines
+inline = choice inlineParsers <?> "inline"
-- | Inline parsers tried in order
-inlineParsers :: [Parser [Char] ParserState Inlines]
+inlineParsers :: PandocMonad m => [ParserT [Char] ParserState m Inlines]
inlineParsers = [ str
, whitespace
, endline
@@ -470,13 +461,13 @@ inlineParsers = [ str
]
-- | Inline markups
-inlineMarkup :: Parser [Char] ParserState Inlines
+inlineMarkup :: PandocMonad m => ParserT [Char] ParserState m Inlines
inlineMarkup = choice [ simpleInline (string "??") (B.cite [])
, simpleInline (string "**") B.strong
, simpleInline (string "__") B.emph
, simpleInline (char '*') B.strong
, simpleInline (char '_') B.emph
- , simpleInline (char '+') B.emph -- approximates underline
+ , simpleInline (char '+') underlineSpan
, simpleInline (char '-' <* notFollowedBy (char '-')) B.strikeout
, simpleInline (char '^') B.superscript
, simpleInline (char '~') B.subscript
@@ -484,35 +475,35 @@ inlineMarkup = choice [ simpleInline (string "??") (B.cite [])
]
-- | Trademark, registered, copyright
-mark :: Parser [Char] st Inlines
+mark :: PandocMonad m => ParserT [Char] st m Inlines
mark = try $ char '(' >> (try tm <|> try reg <|> copy)
-reg :: Parser [Char] st Inlines
+reg :: PandocMonad m => ParserT [Char] st m Inlines
reg = do
oneOf "Rr"
char ')'
return $ B.str "\174"
-tm :: Parser [Char] st Inlines
+tm :: PandocMonad m => ParserT [Char] st m Inlines
tm = do
oneOf "Tt"
oneOf "Mm"
char ')'
return $ B.str "\8482"
-copy :: Parser [Char] st Inlines
+copy :: PandocMonad m => ParserT [Char] st m Inlines
copy = do
oneOf "Cc"
char ')'
return $ B.str "\169"
-note :: Parser [Char] ParserState Inlines
+note :: PandocMonad m => ParserT [Char] ParserState m Inlines
note = try $ do
- ref <- (char '[' *> many1 digit <* char ']')
+ ref <- char '[' *> many1 digit <* char ']'
notes <- stateNotes <$> getState
case lookup ref notes of
- Nothing -> fail "note not found"
- Just raw -> B.note <$> parseFromString parseBlocks raw
+ Nothing -> fail "note not found"
+ Just raw -> B.note <$> parseFromString' parseBlocks raw
-- | Special chars
markupChars :: [Char]
@@ -530,22 +521,22 @@ wordBoundaries :: [Char]
wordBoundaries = markupChars ++ stringBreakers
-- | Parse a hyphened sequence of words
-hyphenedWords :: Parser [Char] ParserState String
+hyphenedWords :: PandocMonad m => ParserT [Char] ParserState m String
hyphenedWords = do
x <- wordChunk
xs <- many (try $ char '-' >> wordChunk)
return $ intercalate "-" (x:xs)
-wordChunk :: Parser [Char] ParserState String
+wordChunk :: PandocMonad m => ParserT [Char] ParserState m String
wordChunk = try $ do
hd <- noneOf wordBoundaries
- tl <- many ( (noneOf wordBoundaries) <|>
+ tl <- many ( noneOf wordBoundaries <|>
try (notFollowedBy' note *> oneOf markupChars
<* lookAhead (noneOf wordBoundaries) ) )
return $ hd:tl
-- | Any string
-str :: Parser [Char] ParserState Inlines
+str :: PandocMonad m => ParserT [Char] ParserState m Inlines
str = do
baseStr <- hyphenedWords
-- RedCloth compliance : if parsed word is uppercase and immediatly
@@ -558,11 +549,11 @@ str = do
return $ B.str fullStr
-- | Some number of space chars
-whitespace :: Parser [Char] st Inlines
+whitespace :: PandocMonad m => ParserT [Char] st m Inlines
whitespace = many1 spaceChar >> return B.space <?> "whitespace"
-- | In Textile, an isolated endline character is a line break
-endline :: Parser [Char] ParserState Inlines
+endline :: PandocMonad m => ParserT [Char] ParserState m Inlines
endline = try $ do
newline
notFollowedBy blankline
@@ -570,18 +561,18 @@ endline = try $ do
notFollowedBy rawHtmlBlock
return B.linebreak
-rawHtmlInline :: Parser [Char] ParserState Inlines
+rawHtmlInline :: PandocMonad m => ParserT [Char] ParserState m Inlines
rawHtmlInline = B.rawInline "html" . snd <$> htmlTag isInlineTag
-- | Raw LaTeX Inline
-rawLaTeXInline' :: Parser [Char] ParserState Inlines
+rawLaTeXInline' :: PandocMonad m => ParserT [Char] ParserState m Inlines
rawLaTeXInline' = try $ do
guardEnabled Ext_raw_tex
- B.singleton <$> rawLaTeXInline
+ B.rawInline "latex" <$> rawLaTeXInline
-- | Textile standard link syntax is "label":target. But we
-- can also have ["label":target].
-link :: Parser [Char] ParserState Inlines
+link :: PandocMonad m => ParserT [Char] ParserState m Inlines
link = try $ do
bracketed <- (True <$ char '[') <|> return False
char '"' *> notFollowedBy (oneOf " \t\n\r")
@@ -591,8 +582,9 @@ link = try $ do
char ':'
let stop = if bracketed
then char ']'
- else lookAhead $ space <|>
- try (oneOf "!.,;:" *> (space <|> newline))
+ else lookAhead $ space <|> eof' <|>
+ try (oneOf "!.,;:" *>
+ (space <|> newline <|> eof'))
url <- many1Till nonspaceChar stop
let name' = if B.toList name == [Str "$"] then B.str url else name
return $ if attr == nullAttr
@@ -600,7 +592,7 @@ link = try $ do
else B.spanWith attr $ B.link url "" name'
-- | image embedding
-image :: Parser [Char] ParserState Inlines
+image :: PandocMonad m => ParserT [Char] ParserState m Inlines
image = try $ do
char '!' >> notFollowedBy space
(ident, cls, kvs) <- attributes
@@ -612,50 +604,51 @@ image = try $ do
char '!'
return $ B.imageWith attr src alt (B.str alt)
-escapedInline :: Parser [Char] ParserState Inlines
+escapedInline :: PandocMonad m => ParserT [Char] ParserState m Inlines
escapedInline = escapedEqs <|> escapedTag
-escapedEqs :: Parser [Char] ParserState Inlines
+escapedEqs :: PandocMonad m => ParserT [Char] ParserState m Inlines
escapedEqs = B.str <$>
- (try $ string "==" *> manyTill anyChar' (try $ string "=="))
+ try (string "==" *> manyTill anyChar' (try $ string "=="))
-- | literal text escaped btw <notextile> tags
-escapedTag :: Parser [Char] ParserState Inlines
+escapedTag :: PandocMonad m => ParserT [Char] ParserState m Inlines
escapedTag = B.str <$>
- (try $ string "<notextile>" *>
+ try (string "<notextile>" *>
manyTill anyChar' (try $ string "</notextile>"))
-- | Any special symbol defined in wordBoundaries
-symbol :: Parser [Char] ParserState Inlines
+symbol :: PandocMonad m => ParserT [Char] ParserState m Inlines
symbol = B.str . singleton <$> (notFollowedBy newline *>
notFollowedBy rawHtmlBlock *>
oneOf wordBoundaries)
-- | Inline code
-code :: Parser [Char] ParserState Inlines
+code :: PandocMonad m => ParserT [Char] ParserState m Inlines
code = code1 <|> code2
-- any character except a newline before a blank line
-anyChar' :: Parser [Char] ParserState Char
+anyChar' :: PandocMonad m => ParserT [Char] ParserState m Char
anyChar' =
- satisfy (/='\n') <|> (try $ char '\n' <* notFollowedBy blankline)
+ satisfy (/='\n') <|>
+ try (char '\n' <* notFollowedBy blankline)
-code1 :: Parser [Char] ParserState Inlines
+code1 :: PandocMonad m => ParserT [Char] ParserState m Inlines
code1 = B.code <$> surrounded (char '@') anyChar'
-code2 :: Parser [Char] ParserState Inlines
+code2 :: PandocMonad m => ParserT [Char] ParserState m Inlines
code2 = do
htmlTag (tagOpen (=="tt") null)
B.code <$> manyTill anyChar' (try $ htmlTag $ tagClose (=="tt"))
-- | Html / CSS attributes
-attributes :: Parser [Char] ParserState Attr
-attributes = (foldl (flip ($)) ("",[],[])) <$>
+attributes :: PandocMonad m => ParserT [Char] ParserState m Attr
+attributes = foldl (flip ($)) ("",[],[]) <$>
try (do special <- option id specialAttribute
attrs <- many attribute
return (special : attrs))
-specialAttribute :: Parser [Char] ParserState (Attr -> Attr)
+specialAttribute :: PandocMonad m => ParserT [Char] ParserState m (Attr -> Attr)
specialAttribute = do
alignStr <- ("center" <$ char '=') <|>
("justify" <$ try (string "<>")) <|>
@@ -664,11 +657,11 @@ specialAttribute = do
notFollowedBy spaceChar
return $ addStyle ("text-align:" ++ alignStr)
-attribute :: Parser [Char] ParserState (Attr -> Attr)
+attribute :: PandocMonad m => ParserT [Char] ParserState m (Attr -> Attr)
attribute = try $
(classIdAttr <|> styleAttr <|> langAttr) <* notFollowedBy spaceChar
-classIdAttr :: Parser [Char] ParserState (Attr -> Attr)
+classIdAttr :: PandocMonad m => ParserT [Char] ParserState m (Attr -> Attr)
classIdAttr = try $ do -- (class class #id)
char '('
ws <- words `fmap` manyTill anyChar' (char ')')
@@ -679,7 +672,7 @@ classIdAttr = try $ do -- (class class #id)
classes' -> return $ \(_,_,keyvals) ->
("",classes',keyvals)
-styleAttr :: Parser [Char] ParserState (Attr -> Attr)
+styleAttr :: PandocMonad m => ParserT [Char] ParserState m (Attr -> Attr)
styleAttr = do
style <- try $ enclosed (char '{') (char '}') anyChar'
return $ addStyle style
@@ -690,21 +683,23 @@ addStyle style (id',classes,keyvals) =
where keyvals' = ("style", style') : [(k,v) | (k,v) <- keyvals, k /= "style"]
style' = style ++ ";" ++ concat [v | ("style",v) <- keyvals]
-langAttr :: Parser [Char] ParserState (Attr -> Attr)
+langAttr :: PandocMonad m => ParserT [Char] ParserState m (Attr -> Attr)
langAttr = do
lang <- try $ enclosed (char '[') (char ']') alphaNum
return $ \(id',classes,keyvals) -> (id',classes,("lang",lang):keyvals)
-- | Parses material surrounded by a parser.
-surrounded :: Parser [Char] st t -- ^ surrounding parser
- -> Parser [Char] st a -- ^ content parser (to be used repeatedly)
- -> Parser [Char] st [a]
+surrounded :: (PandocMonad m, Show t)
+ => ParserT [Char] st m t -- ^ surrounding parser
+ -> ParserT [Char] st m a -- ^ content parser (to be used repeatedly)
+ -> ParserT [Char] st m [a]
surrounded border =
enclosed (border *> notFollowedBy (oneOf " \t\n\r")) (try border)
-simpleInline :: Parser [Char] ParserState t -- ^ surrounding parser
- -> (Inlines -> Inlines) -- ^ Inline constructor
- -> Parser [Char] ParserState Inlines -- ^ content parser (to be used repeatedly)
+simpleInline :: PandocMonad m
+ => ParserT [Char] ParserState m t -- ^ surrounding parser
+ -> (Inlines -> Inlines) -- ^ Inline constructor
+ -> ParserT [Char] ParserState m Inlines -- ^ content parser (to be used repeatedly)
simpleInline border construct = try $ do
notAfterString
border *> notFollowedBy (oneOf " \t\n\r")
@@ -718,7 +713,7 @@ simpleInline border construct = try $ do
then body
else B.spanWith attr body
-groupedInlineMarkup :: Parser [Char] ParserState Inlines
+groupedInlineMarkup :: PandocMonad m => ParserT [Char] ParserState m Inlines
groupedInlineMarkup = try $ do
char '['
sp1 <- option mempty $ B.space <$ whitespace
@@ -731,3 +726,5 @@ groupedInlineMarkup = try $ do
singleton :: a -> [a]
singleton x = [x]
+eof' :: Monad m => ParserT [Char] s m Char
+eof' = '\n' <$ eof