c302bdc · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Merge pull request #1947 from mpickering/Fmonad

c302bdcJohn MacFarlane12 years ago

src/Text/Pandoc/Parsing.hs+21−33

compare with master

unifiedsplit

@@ -65,7 +65,8 @@ module Text.Pandoc.Parsing ( anyLine,

65 widthsFromIndices,

66 gridTableWith,

67 readWith,

68− readWithWarnings,

68+ returnWarnings,

69+ returnState,

69 readWithM,

70 readWithM,

70 testStringWith,

71 testStringWith,

71 guardEnabled,

72 guardEnabled,

@@ -104,11 +105,8 @@ module Text.Pandoc.Parsing ( anyLine,

104 applyMacros',

105 applyMacros',

105 Parser,

106 Parser,

106 ParserT,

107 ParserT,

107− F(..),

108− runF,

109− askF,

110− asksF,

111 token,

108 token,

109+ generalize,

112 -- * Re-exports from Text.Pandoc.Parsec

110 -- * Re-exports from Text.Pandoc.Parsec

113 Stream,

111 Stream,

114 runParser,

112 runParser,

@@ -188,7 +186,7 @@ import Data.Default

188import qualified Data.Set as Set

186import qualified Data.Set as Set

189import Control.Monad.Reader

187import Control.Monad.Reader

190import Control.Monad.Identity

188import Control.Monad.Identity

191−import Control.Applicative ((<$>), (<*>), (*>), (<*), (<$), Applicative)

189+import Control.Applicative ((<$>), (<*>), (*>), (<*), (<$))

192import Data.Monoid

190import Data.Monoid

193import Data.Maybe (catMaybes)

191import Data.Maybe (catMaybes)

194

192

@@ -196,22 +194,6 @@ type Parser t s = Parsec t s

196

194

197type ParserT = ParsecT

195type ParserT = ParsecT

198

196

199−newtype F a = F { unF :: Reader ParserState a } deriving (Monad, Applicative, Functor)

200−

201−runF :: F a -> ParserState -> a

202−runF = runReader . unF

203−

204−askF :: F ParserState

205−askF = F ask

206−

207−asksF :: (ParserState -> a) -> F a

208−asksF f = F $ asks f

209−

210−instance Monoid a => Monoid (F a) where

211− mempty = return mempty

212− mappend = liftM2 mappend

213− mconcat = liftM mconcat . sequence

214−

215-- | Parse any line of text

197-- | Parse any line of text

216anyLine :: Stream [Char] m Char => ParserT [Char] st m [Char]

198anyLine :: Stream [Char] m Char => ParserT [Char] st m [Char]

217anyLine = do

199anyLine = do

@@ -884,15 +866,18 @@ readWith :: Parser [Char] st a

884 -> a

866 -> a

885readWith p t inp = runIdentity $ readWithM p t inp

867readWith p t inp = runIdentity $ readWithM p t inp

886

868

887−readWithWarnings :: Parser [Char] ParserState a

869+returnWarnings :: (Stream s m c)

888− -> ParserState

870+ => ParserT s ParserState m a

889− -> String

890− -> (a, [String])

871+ -> ParserT s ParserState m (a, [String])

891−readWithWarnings p = readWith $ do

872+returnWarnings p = do

892 doc <- p

873 doc <- p

893 warnings <- stateWarnings <$> getState

874 warnings <- stateWarnings <$> getState

894 return (doc, warnings)

875 return (doc, warnings)

895

876

877+-- | Return the final internal state with the result of a parser

878+returnState :: (Stream s m c) => ParsecT s st m a -> ParsecT s st m (a, st)

879+returnState p = (,) <$> p <*> getState

880+

896-- | Parse a string with @parser@ (for testing).

881-- | Parse a string with @parser@ (for testing).

897testStringWith :: (Show a, Stream [Char] Identity Char)

882testStringWith :: (Show a, Stream [Char] Identity Char)

898 => ParserT [Char] ParserState Identity a

883 => ParserT [Char] ParserState Identity a

@@ -914,7 +899,6 @@ data ParserState = ParserState

914 stateNotes :: NoteTable, -- ^ List of notes (raw bodies)

899 stateNotes :: NoteTable, -- ^ List of notes (raw bodies)

915 stateNotes' :: NoteTable', -- ^ List of notes (parsed bodies)

900 stateNotes' :: NoteTable', -- ^ List of notes (parsed bodies)

916 stateMeta :: Meta, -- ^ Document metadata

901 stateMeta :: Meta, -- ^ Document metadata

917− stateMeta' :: F Meta, -- ^ Document metadata

918 stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used

902 stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used

919 stateHeaders :: M.Map Inlines String, -- ^ List of headers and ids (used for implicit ref links)

903 stateHeaders :: M.Map Inlines String, -- ^ List of headers and ids (used for implicit ref links)

920 stateIdentifiers :: [String], -- ^ List of header identifiers used

904 stateIdentifiers :: [String], -- ^ List of header identifiers used

@@ -929,7 +913,8 @@ data ParserState = ParserState

929 stateCaption :: Maybe Inlines, -- ^ Caption in current environment

913 stateCaption :: Maybe Inlines, -- ^ Caption in current environment

930 stateInHtmlBlock :: Maybe String, -- ^ Tag type of HTML block being parsed

914 stateInHtmlBlock :: Maybe String, -- ^ Tag type of HTML block being parsed

931 stateMarkdownAttribute :: Bool, -- ^ True if in markdown=1 context

915 stateMarkdownAttribute :: Bool, -- ^ True if in markdown=1 context

932− stateWarnings :: [String] -- ^ Warnings generated by the parser

916+ stateWarnings :: [String], -- ^ Warnings generated by the parser

917+ stateInFootnote :: Bool -- ^ True if in a footnote block.

933 }

918 }

934

919

935instance Default ParserState where

920instance Default ParserState where

@@ -1011,7 +996,6 @@ defaultParserState =

1011 stateNotes = [],

996 stateNotes = [],

1012 stateNotes' = [],

997 stateNotes' = [],

1013 stateMeta = nullMeta,

998 stateMeta = nullMeta,

1014− stateMeta' = return nullMeta,

1015 stateHeaderTable = [],

999 stateHeaderTable = [],

1016 stateHeaders = M.empty,

1000 stateHeaders = M.empty,

1017 stateIdentifiers = [],

1001 stateIdentifiers = [],

@@ -1024,7 +1008,8 @@ defaultParserState =

1024 stateCaption = Nothing,

1008 stateCaption = Nothing,

1025 stateInHtmlBlock = Nothing,

1009 stateInHtmlBlock = Nothing,

1026 stateMarkdownAttribute = False,

1010 stateMarkdownAttribute = False,

1027− stateWarnings = []}

1011+ stateWarnings = [],

1012+ stateInFootnote = False }

1028

1013

1029-- | Succeed only if the extension is enabled.

1014-- | Succeed only if the extension is enabled.

1030guardEnabled :: (Stream s m a, HasReaderOptions st) => Extension -> ParserT s st m ()

1015guardEnabled :: (Stream s m a, HasReaderOptions st) => Extension -> ParserT s st m ()

@@ -1063,7 +1048,7 @@ data QuoteContext

1063

1048

1064type NoteTable = [(String, String)]

1049type NoteTable = [(String, String)]

1065

1050

1066−type NoteTable' = [(String, F Blocks)] -- used in markdown reader

1051+type NoteTable' = [(String, Blocks)] -- used in markdown reader

1067

1052

1068newtype Key = Key String deriving (Show, Read, Eq, Ord)

1053newtype Key = Key String deriving (Show, Read, Eq, Ord)

1069

1054

@@ -1259,8 +1244,11 @@ applyMacros' target = do

1259 else return target

1244 else return target

1260

1245

1261-- | Append a warning to the log.

1246-- | Append a warning to the log.

1262−addWarning :: Maybe SourcePos -> String -> Parser [Char] ParserState ()

1247+addWarning :: (Stream s m c) => Maybe SourcePos -> String -> ParserT s ParserState m ()

1263addWarning mbpos msg =

1248addWarning mbpos msg =

1264 updateState $ \st -> st{

1249 updateState $ \st -> st{

1265 stateWarnings = (msg ++ maybe "" (\pos -> " " ++ show pos) mbpos) :

1250 stateWarnings = (msg ++ maybe "" (\pos -> " " ++ show pos) mbpos) :

1266 stateWarnings st }

1251 stateWarnings st }

1252+

1253+generalize :: (Monad m) => Parser s st a -> ParserT s st m a

1254+generalize m = mkPT (\ s -> (return $ (return . runIdentity) <$> runIdentity (runParsecT m s)))

src/Text/Pandoc/Readers/Markdown.hs+326−346

@@ -31,7 +31,7 @@ Conversion of markdown-formatted plain text to 'Pandoc' document.

31module Text.Pandoc.Readers.Markdown ( readMarkdown,

32 readMarkdownWithWarnings ) where

34−import Data.List ( transpose, sortBy, findIndex, intersperse, intercalate )

34+import Data.List ( transpose, sortBy, intersperse, intercalate, elemIndex)

35import qualified Data.Map as M

36import Data.Scientific (coefficient, base10Exponent)

37import Data.Ord ( comparing )

@@ -55,8 +55,9 @@ import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock )

55import Text.Pandoc.Readers.HTML ( htmlTag, htmlInBalanced, isInlineTag, isBlockTag,

56 isTextTag, isCommentTag )

57import Data.Monoid (mconcat, mempty)

58−import Control.Applicative ((<$>), (<*), (*>), (<$))

58+import Control.Applicative ((<$>), (<*), (*>), (<$), (<*>))

59import Control.Monad

60+import Control.Monad.Reader

60import System.FilePath (takeExtension, addExtension)

61import System.FilePath (takeExtension, addExtension)

61import Text.HTML.TagSoup

62import Text.HTML.TagSoup

62import Text.HTML.TagSoup.Match (tagOpen)

63import Text.HTML.TagSoup.Match (tagOpen)

@@ -64,25 +65,29 @@ import qualified Data.Set as Set

64import Text.Printf (printf)

65import Text.Printf (printf)

65import Debug.Trace (trace)

66import Debug.Trace (trace)

67−type MarkdownParser = Parser [Char] ParserState

68+type MarkdownParser a = ParserT [Char] ParserState (Reader ParserState) a

69-- | Read markdown from an input string and return a Pandoc document.

70-- | Read markdown from an input string and return a Pandoc document.

70readMarkdown :: ReaderOptions -- ^ Reader options

71readMarkdown :: ReaderOptions -- ^ Reader options

71 -> String -- ^ String to parse (assuming @'\n'@ line endings)

72 -> String -- ^ String to parse (assuming @'\n'@ line endings)

72 -> Pandoc

73 -> Pandoc

73readMarkdown opts s =

74readMarkdown opts s =

74− (readWith parseMarkdown) def{ stateOptions = opts } (s ++ "\n\n")

75+ runMarkdown opts s parseMarkdown

76-- | Read markdown from an input string and return a pair of a Pandoc document

77-- | Read markdown from an input string and return a pair of a Pandoc document

77-- and a list of warnings.

78-- and a list of warnings.

78readMarkdownWithWarnings :: ReaderOptions -- ^ Reader options

79readMarkdownWithWarnings :: ReaderOptions -- ^ Reader options

79 -> String -- ^ String to parse (assuming @'\n'@ line endings)

80 -> String -- ^ String to parse (assuming @'\n'@ line endings)

80 -> (Pandoc, [String])

81 -> (Pandoc, [String])

81−readMarkdownWithWarnings opts s =

82+readMarkdownWithWarnings opts s = runMarkdown opts s (returnWarnings parseMarkdown)

82− (readWithWarnings parseMarkdown) def{ stateOptions = opts } (s ++ "\n\n")

84−trimInlinesF :: F Inlines -> F Inlines

84+runMarkdown :: ReaderOptions -> String -> MarkdownParser a -> a

85−trimInlinesF = liftM trimInlines

85+runMarkdown opts inp p = fst res

86+ where

87+ imd = readWithM (returnState p) def{ stateOptions = opts } (inp ++ "\n\n")

88+ res = runReader imd s

89+ s :: ParserState

90+ s = snd $ runReader imd s

87--

92--

88-- Constants and data structure definitions

93-- Constants and data structure definitions

@@ -119,10 +124,10 @@ inList = do

119 ctx <- stateParserContext <$> getState

124 ctx <- stateParserContext <$> getState

120 guard (ctx == ListItemState)

125 guard (ctx == ListItemState)

121

126

122−isNull :: F Inlines -> Bool

127+isNull :: Inlines -> Bool

123−isNull ils = B.isNull $ runF ils def

128+isNull = B.isNull

124

129

125−spnl :: Parser [Char] st ()

130+spnl :: Monad m => ParserT [Char] st m ()

126spnl = try $ do

131spnl = try $ do

127 skipSpaces

132 skipSpaces

128 optional newline

133 optional newline

@@ -162,9 +167,9 @@ litChar = escapedChar'

162

167

163-- | Parse a sequence of inline elements between square brackets,

168-- | Parse a sequence of inline elements between square brackets,

164-- including inlines between balanced pairs of square brackets.

169-- including inlines between balanced pairs of square brackets.

165−inlinesInBalancedBrackets :: MarkdownParser (F Inlines)

170+inlinesInBalancedBrackets :: MarkdownParser Inlines

166inlinesInBalancedBrackets = charsInBalancedBrackets >>=

171inlinesInBalancedBrackets = charsInBalancedBrackets >>=

167− parseFromString (trimInlinesF . mconcat <$> many inline)

172+ parseFromString (trimInlines . mconcat <$> many inline)

168

173

169charsInBalancedBrackets :: MarkdownParser [Char]

174charsInBalancedBrackets :: MarkdownParser [Char]

170charsInBalancedBrackets = do

175charsInBalancedBrackets = do

@@ -181,16 +186,16 @@ charsInBalancedBrackets = do

181-- document structure

186-- document structure

182--

187--

183

188

184−titleLine :: MarkdownParser (F Inlines)

189+titleLine :: MarkdownParser Inlines

185titleLine = try $ do

190titleLine = try $ do

186 char '%'

191 char '%'

187 skipSpaces

192 skipSpaces

188 res <- many $ (notFollowedBy newline >> inline)

193 res <- many $ (notFollowedBy newline >> inline)

189 <|> try (endline >> whitespace)

194 <|> try (endline >> whitespace)

190 newline

195 newline

191− return $ trimInlinesF $ mconcat res

196+ return $ trimInlines $ mconcat res

192

197

193−authorsLine :: MarkdownParser (F [Inlines])

198+authorsLine :: MarkdownParser [Inlines]

194authorsLine = try $ do

199authorsLine = try $ do

195 char '%'

200 char '%'

196 skipSpaces

201 skipSpaces

@@ -199,13 +204,13 @@ authorsLine = try $ do

199 (char ';' <|>

204 (char ';' <|>

200 try (newline >> notFollowedBy blankline >> spaceChar))

205 try (newline >> notFollowedBy blankline >> spaceChar))

201 newline

206 newline

202− return $ sequence $ filter (not . isNull) $ map (trimInlinesF . mconcat) authors

207+ return $ filter (not . isNull) $ map (trimInlines . mconcat) authors

203

208

204−dateLine :: MarkdownParser (F Inlines)

209+dateLine :: MarkdownParser Inlines

205dateLine = try $ do

210dateLine = try $ do

206 char '%'

211 char '%'

207 skipSpaces

212 skipSpaces

208− trimInlinesF . mconcat <$> manyTill inline newline

213+ trimInlines . mconcat <$> manyTill inline newline

209

214

210titleBlock :: MarkdownParser ()

215titleBlock :: MarkdownParser ()

211titleBlock = pandocTitleBlock <|> mmdTitleBlock

216titleBlock = pandocTitleBlock <|> mmdTitleBlock

@@ -215,20 +220,16 @@ pandocTitleBlock = try $ do

215 guardEnabled Ext_pandoc_title_block

220 guardEnabled Ext_pandoc_title_block

216 lookAhead (char '%')

221 lookAhead (char '%')

217 title <- option mempty titleLine

222 title <- option mempty titleLine

218− author <- option (return []) authorsLine

223+ author <- option [] authorsLine

219 date <- option mempty dateLine

224 date <- option mempty dateLine

220 optional blanklines

225 optional blanklines

221− let meta' = do title' <- title

222− author' <- author

223− date' <- date

224− return $

225− (if B.isNull title' then id else B.setMeta "title" title')

226+ let meta' = (if B.isNull title then id else B.setMeta "title" title)

226− . (if null author' then id else B.setMeta "author" author')

227+ . (if null author then id else B.setMeta "author" author)

227− . (if B.isNull date' then id else B.setMeta "date" date')

228+ . (if B.isNull date then id else B.setMeta "date" date)

228− $ nullMeta

229+ $ nullMeta

229− updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }

230+ updateState $ \st -> st{ stateMeta = stateMeta st <> meta' }

230−

231+

231−yamlMetaBlock :: MarkdownParser (F Blocks)

232+yamlMetaBlock :: MarkdownParser Blocks

232yamlMetaBlock = try $ do

233yamlMetaBlock = try $ do

233 guardEnabled Ext_yaml_metadata_block

234 guardEnabled Ext_yaml_metadata_block

234 pos <- getPosition

235 pos <- getPosition

@@ -241,17 +242,17 @@ yamlMetaBlock = try $ do

241 optional blanklines

242 optional blanklines

242 opts <- stateOptions <$> getState

243 opts <- stateOptions <$> getState

243 meta' <- case Yaml.decodeEither' $ UTF8.fromString rawYaml of

244 meta' <- case Yaml.decodeEither' $ UTF8.fromString rawYaml of

244− Right (Yaml.Object hashmap) -> return $ return $

245+ Right (Yaml.Object hashmap) -> return $

245 H.foldrWithKey (\k v m ->

246 H.foldrWithKey (\k v m ->

246 if ignorable k

247 if ignorable k

247 then m

248 then m

248 else B.setMeta (T.unpack k)

249 else B.setMeta (T.unpack k)

249 (yamlToMeta opts v) m)

250 (yamlToMeta opts v) m)

250 nullMeta hashmap

251 nullMeta hashmap

251− Right Yaml.Null -> return $ return nullMeta

252+ Right Yaml.Null -> return nullMeta

252 Right _ -> do

253 Right _ -> do

253 addWarning (Just pos) "YAML header is not an object"

254 addWarning (Just pos) "YAML header is not an object"

254− return $ return nullMeta

255+ return nullMeta

255 Left err' -> do

256 Left err' -> do

256 case err' of

257 case err' of

257 InvalidYaml (Just YamlParseException{

258 InvalidYaml (Just YamlParseException{

@@ -270,13 +271,13 @@ yamlMetaBlock = try $ do

270 _ -> addWarning (Just pos)

271 _ -> addWarning (Just pos)

271 $ "Could not parse YAML header: " ++

272 $ "Could not parse YAML header: " ++

272 show err'

273 show err'

273− return $ return nullMeta

274+ return nullMeta

274− updateState $ \st -> st{ stateMeta' = stateMeta' st <> meta' }

275+ updateState $ \st -> st{ stateMeta = stateMeta st <> meta' }

275 return mempty

276 return mempty

276

277

277-- ignore fields ending with _

278-- ignore fields ending with _

278ignorable :: Text -> Bool

279ignorable :: Text -> Bool

279−ignorable t = (T.pack "_") `T.isSuffixOf` t

280+ignorable t = T.pack "_" `T.isSuffixOf` t

280

281

281toMetaValue :: ReaderOptions -> Text -> MetaValue

282toMetaValue :: ReaderOptions -> Text -> MetaValue

282toMetaValue opts x =

283toMetaValue opts x =

@@ -286,7 +287,7 @@ toMetaValue opts x =

286 | endsWithNewline x -> MetaBlocks [Para xs]

287 | endsWithNewline x -> MetaBlocks [Para xs]

287 | otherwise -> MetaInlines xs

288 | otherwise -> MetaInlines xs

288 Pandoc _ bs -> MetaBlocks bs

289 Pandoc _ bs -> MetaBlocks bs

289− where endsWithNewline t = (T.pack "\n") `T.isSuffixOf` t

290+ where endsWithNewline t = T.pack "\n" `T.isSuffixOf` t

290

291

291yamlToMeta :: ReaderOptions -> Yaml.Value -> MetaValue

292yamlToMeta :: ReaderOptions -> Yaml.Value -> MetaValue

292yamlToMeta opts (Yaml.String t) = toMetaValue opts t

293yamlToMeta opts (Yaml.String t) = toMetaValue opts t

@@ -314,8 +315,8 @@ mmdTitleBlock = try $ do

314 guardEnabled Ext_mmd_title_block

315 guardEnabled Ext_mmd_title_block

315 kvPairs <- many1 kvPair

316 kvPairs <- many1 kvPair

316 blanklines

317 blanklines

317− updateState $ \st -> st{ stateMeta' = stateMeta' st <>

318+ updateState $ \st -> st{ stateMeta = stateMeta st <>

318− return (Meta $ M.fromList kvPairs) }

319+ (Meta $ M.fromList kvPairs) }

319

320

320kvPair :: MarkdownParser (String, MetaValue)

321kvPair :: MarkdownParser (String, MetaValue)

321kvPair = try $ do

322kvPair = try $ do

@@ -335,11 +336,11 @@ parseMarkdown = do

335 optional titleBlock

336 optional titleBlock

336 blocks <- parseBlocks

337 blocks <- parseBlocks

337 st <- getState

338 st <- getState

338− let meta = runF (stateMeta' st) st

339+ let meta = stateMeta st

339− let Pandoc _ bs = B.doc $ runF blocks st

340+ let Pandoc _ bs = B.doc blocks

340 return $ Pandoc meta bs

341 return $ Pandoc meta bs

341

342

342−referenceKey :: MarkdownParser (F Blocks)

343+referenceKey :: MarkdownParser Blocks

343referenceKey = try $ do

344referenceKey = try $ do

344 pos <- getPosition

345 pos <- getPosition

345 skipNonindentSpaces

346 skipNonindentSpaces

@@ -366,7 +367,7 @@ referenceKey = try $ do

366 Just _ -> addWarning (Just pos) $ "Duplicate link reference `" ++ raw ++ "'"

367 Just _ -> addWarning (Just pos) $ "Duplicate link reference `" ++ raw ++ "'"

367 Nothing -> return ()

368 Nothing -> return ()

368 updateState $ \s -> s { stateKeys = M.insert key target oldkeys }

369 updateState $ \s -> s { stateKeys = M.insert key target oldkeys }

369− return $ return mempty

370+ return mempty

370

371

371referenceTitle :: MarkdownParser String

372referenceTitle :: MarkdownParser String

372referenceTitle = try $ do

373referenceTitle = try $ do

@@ -386,7 +387,7 @@ quotedTitle c = try $ do

386-- | PHP Markdown Extra style abbreviation key. Currently

387-- | PHP Markdown Extra style abbreviation key. Currently

387-- we just skip them, since Pandoc doesn't have an element for

388-- we just skip them, since Pandoc doesn't have an element for

388-- an abbreviation.

389-- an abbreviation.

389−abbrevKey :: MarkdownParser (F Blocks)

390+abbrevKey :: MarkdownParser Blocks

390abbrevKey = do

391abbrevKey = do

391 guardEnabled Ext_abbreviations

392 guardEnabled Ext_abbreviations

392 try $ do

393 try $ do

@@ -395,7 +396,7 @@ abbrevKey = do

395 char ':'

396 char ':'

396 skipMany (satisfy (/= '\n'))

397 skipMany (satisfy (/= '\n'))

397 blanklines

398 blanklines

398− return $ return mempty

399+ return mempty

399

400

400noteMarker :: MarkdownParser String

401noteMarker :: MarkdownParser String

401noteMarker = string "[^" >> many1Till (satisfy $ not . isBlank) (char ']')

402noteMarker = string "[^" >> many1Till (satisfy $ not . isBlank) (char ']')

@@ -413,7 +414,7 @@ rawLines = do

413 rest <- many rawLine

414 rest <- many rawLine

414 return $ unlines (first:rest)

415 return $ unlines (first:rest)

415

416

416−noteBlock :: MarkdownParser (F Blocks)

417+noteBlock :: MarkdownParser Blocks

417noteBlock = try $ do

418noteBlock = try $ do

418 pos <- getPosition

419 pos <- getPosition

419 skipNonindentSpaces

420 skipNonindentSpaces

@@ -425,7 +426,7 @@ noteBlock = try $ do

425 rest <- many $ try $ blanklines >> indentSpaces >> rawLines

426 rest <- many $ try $ blanklines >> indentSpaces >> rawLines

426 let raw = unlines (first:rest) ++ "\n"

427 let raw = unlines (first:rest) ++ "\n"

427 optional blanklines

428 optional blanklines

428− parsed <- parseFromString parseBlocks raw

429+ parsed <- parseFromString (inFootnote parseBlocks) raw

429 let newnote = (ref, parsed)

430 let newnote = (ref, parsed)

430 oldnotes <- stateNotes' <$> getState

431 oldnotes <- stateNotes' <$> getState

431 case lookup ref oldnotes of

432 case lookup ref oldnotes of

@@ -434,14 +435,22 @@ noteBlock = try $ do

434 updateState $ \s -> s { stateNotes' = newnote : oldnotes }

435 updateState $ \s -> s { stateNotes' = newnote : oldnotes }

435 return mempty

436 return mempty

436

437

438+inFootnote :: MarkdownParser a -> MarkdownParser a

439+inFootnote p = do

440+ st <- stateInFootnote <$> getState

441+ updateState (\s -> s { stateInFootnote = True } )

442+ r <- p

443+ updateState (\s -> s { stateInFootnote = st } )

444+ return r

445+

437--

446--

438-- parsing blocks

447-- parsing blocks

439--

448--

440

449

441−parseBlocks :: MarkdownParser (F Blocks)

450+parseBlocks :: MarkdownParser Blocks

442parseBlocks = mconcat <$> manyTill block eof

451parseBlocks = mconcat <$> manyTill block eof

443

452

444−block :: MarkdownParser (F Blocks)

453+block :: MarkdownParser Blocks

445block = do

454block = do

446 tr <- getOption readerTrace

455 tr <- getOption readerTrace

447 pos <- getPosition

456 pos <- getPosition

@@ -457,7 +466,7 @@ block = do

457 , htmlBlock

466 , htmlBlock

458 , table

467 , table

459 , codeBlockIndented

468 , codeBlockIndented

460− , guardEnabled Ext_latex_macros *> (macro >>= return . return)

469+ , guardEnabled Ext_latex_macros *> macro

461 , rawTeXBlock

470 , rawTeXBlock

462 , lineBlock

471 , lineBlock

463 , blockQuote

472 , blockQuote

@@ -470,29 +479,28 @@ block = do

470 , para

479 , para

471 , plain

480 , plain

472 ] <?> "block"

481 ] <?> "block"

473− when tr $ do

482+ when tr $

474− st <- getState

475 trace (printf "line %d: %s" (sourceLine pos)

483 trace (printf "line %d: %s" (sourceLine pos)

476− (take 60 $ show $ B.toList $ runF res st)) (return ())

484+ (take 60 . show . B.toList $ res)) (return ())

477 return res

485 return res

478

486

479--

487--

480-- header blocks

488-- header blocks

481--

489--

482

490

483−header :: MarkdownParser (F Blocks)

491+header :: MarkdownParser Blocks

484header = setextHeader <|> atxHeader <?> "header"

492header = setextHeader <|> atxHeader <?> "header"

485

493

486−atxHeader :: MarkdownParser (F Blocks)

494+atxHeader :: MarkdownParser Blocks

487atxHeader = try $ do

495atxHeader = try $ do

488− level <- many1 (char '#') >>= return . length

496+ level <- length <$> many1 (char '#')

489 notFollowedBy $ guardEnabled Ext_fancy_lists >>

497 notFollowedBy $ guardEnabled Ext_fancy_lists >>

490 (char '.' <|> char ')') -- this would be a list

498 (char '.' <|> char ')') -- this would be a list

491 skipSpaces

499 skipSpaces

492− text <- trimInlinesF . mconcat <$> many (notFollowedBy atxClosing >> inline)

500+ text <- trimInlines . mconcat <$> many (notFollowedBy atxClosing >> inline)

493 attr <- atxClosing

501 attr <- atxClosing

494− attr' <- registerHeader attr (runF text defaultParserState)

502+ attr' <- registerHeader attr text

495− return $ B.headerWith attr' level <$> text

503+ return $ B.headerWith attr' level text

496

504

497atxClosing :: MarkdownParser Attr

505atxClosing :: MarkdownParser Attr

498atxClosing = try $ do

506atxClosing = try $ do

@@ -519,25 +527,25 @@ mmdHeaderIdentifier = do

519 skipSpaces

527 skipSpaces

520 return (ident,[],[])

528 return (ident,[],[])

521

529

522−setextHeader :: MarkdownParser (F Blocks)

530+setextHeader :: MarkdownParser Blocks

523setextHeader = try $ do

531setextHeader = try $ do

524 -- This lookahead prevents us from wasting time parsing Inlines

532 -- This lookahead prevents us from wasting time parsing Inlines

525 -- unless necessary -- it gives a significant performance boost.

533 -- unless necessary -- it gives a significant performance boost.

526 lookAhead $ anyLine >> many1 (oneOf setextHChars) >> blankline

534 lookAhead $ anyLine >> many1 (oneOf setextHChars) >> blankline

527− text <- trimInlinesF . mconcat <$> many1 (notFollowedBy setextHeaderEnd >> inline)

535+ text <- trimInlines . mconcat <$> many1 (notFollowedBy setextHeaderEnd >> inline)

528 attr <- setextHeaderEnd

536 attr <- setextHeaderEnd

529 underlineChar <- oneOf setextHChars

537 underlineChar <- oneOf setextHChars

530 many (char underlineChar)

538 many (char underlineChar)

531 blanklines

539 blanklines

532− let level = (fromMaybe 0 $ findIndex (== underlineChar) setextHChars) + 1

540+ let level = (fromMaybe 0 $ elemIndex underlineChar setextHChars) + 1

533− attr' <- registerHeader attr (runF text defaultParserState)

541+ attr' <- registerHeader attr text

534− return $ B.headerWith attr' level <$> text

542+ return $ B.headerWith attr' level text

535

543

536--

544--

537-- hrule block

545-- hrule block

538--

546--

539

547

540−hrule :: Parser [Char] st (F Blocks)

548+hrule :: Monad m => ParserT [Char] st m Blocks

541hrule = try $ do

549hrule = try $ do

542 skipSpaces

550 skipSpaces

543 start <- satisfy isHruleChar

551 start <- satisfy isHruleChar

@@ -545,24 +553,24 @@ hrule = try $ do

545 skipMany (spaceChar <|> char start)

553 skipMany (spaceChar <|> char start)

546 newline

554 newline

547 optional blanklines

555 optional blanklines

548− return $ return B.horizontalRule

556+ return B.horizontalRule

549

557

550--

558--

551-- code blocks

559-- code blocks

552--

560--

553

561

554indentedLine :: MarkdownParser String

562indentedLine :: MarkdownParser String

555−indentedLine = indentSpaces >> anyLine >>= return . (++ "\n")

563+indentedLine = indentSpaces >> ((++ "\n") <$> anyLine)

556

564

557−blockDelimiter :: (Char -> Bool)

565+blockDelimiter :: Monad m

566+ => (Char -> Bool)

558 -> Maybe Int

567 -> Maybe Int

559− -> Parser [Char] st Int

568+ -> ParserT [Char] st m Int

560blockDelimiter f len = try $ do

569blockDelimiter f len = try $ do

561 c <- lookAhead (satisfy f)

570 c <- lookAhead (satisfy f)

562 case len of

571 case len of

563 Just l -> count l (char c) >> many (char c) >> return l

572 Just l -> count l (char c) >> many (char c) >> return l

564− Nothing -> count 3 (char c) >> many (char c) >>=

573+ Nothing -> count 3 (char c) >> ((+ 3) . length <$> many (char c))

565− return . (+ 3) . length

566

574

567attributes :: MarkdownParser Attr

575attributes :: MarkdownParser Attr

568attributes = try $ do

576attributes = try $ do

@@ -607,7 +615,7 @@ specialAttr = do

607 char '-'

615 char '-'

608 return $ \(id',cs,kvs) -> (id',cs ++ ["unnumbered"],kvs)

616 return $ \(id',cs,kvs) -> (id',cs ++ ["unnumbered"],kvs)

609

617

610−codeBlockFenced :: MarkdownParser (F Blocks)

618+codeBlockFenced :: MarkdownParser Blocks

611codeBlockFenced = try $ do

619codeBlockFenced = try $ do

612 c <- try (guardEnabled Ext_fenced_code_blocks >> lookAhead (char '~'))

620 c <- try (guardEnabled Ext_fenced_code_blocks >> lookAhead (char '~'))

613 <|> (guardEnabled Ext_backtick_code_blocks >> lookAhead (char '`'))

621 <|> (guardEnabled Ext_backtick_code_blocks >> lookAhead (char '`'))

@@ -619,7 +627,7 @@ codeBlockFenced = try $ do

619 blankline

627 blankline

620 contents <- manyTill anyLine (blockDelimiter (== c) (Just size))

628 contents <- manyTill anyLine (blockDelimiter (== c) (Just size))

621 blanklines

629 blanklines

622− return $ return $ B.codeBlockWith attr $ intercalate "\n" contents

630+ return $ B.codeBlockWith attr $ intercalate "\n" contents

623

631

624-- correctly handle github language identifiers

632-- correctly handle github language identifiers

625toLanguageId :: String -> String

633toLanguageId :: String -> String

@@ -628,7 +636,7 @@ toLanguageId = map toLower . go

628 go "objective-c" = "objectivec"

636 go "objective-c" = "objectivec"

629 go x = x

637 go x = x

630

638

631−codeBlockIndented :: MarkdownParser (F Blocks)

639+codeBlockIndented :: MarkdownParser Blocks

632codeBlockIndented = do

640codeBlockIndented = do

633 contents <- many1 (indentedLine <|>

641 contents <- many1 (indentedLine <|>

634 try (do b <- blanklines

642 try (do b <- blanklines

@@ -636,15 +644,15 @@ codeBlockIndented = do

636 return $ b ++ l))

644 return $ b ++ l))

637 optional blanklines

645 optional blanklines

638 classes <- getOption readerIndentedCodeClasses

646 classes <- getOption readerIndentedCodeClasses

639− return $ return $ B.codeBlockWith ("", classes, []) $

647+ return $ B.codeBlockWith ("", classes, []) $

640 stripTrailingNewlines $ concat contents

648 stripTrailingNewlines $ concat contents

641

649

642−lhsCodeBlock :: MarkdownParser (F Blocks)

650+lhsCodeBlock :: MarkdownParser Blocks

643lhsCodeBlock = do

651lhsCodeBlock = do

644 guardEnabled Ext_literate_haskell

652 guardEnabled Ext_literate_haskell

645− (return . B.codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>

653+ (B.codeBlockWith ("",["sourceCode","literate","haskell"],[]) <$>

646 (lhsCodeBlockBird <|> lhsCodeBlockLaTeX))

654 (lhsCodeBlockBird <|> lhsCodeBlockLaTeX))

647− <|> (return . B.codeBlockWith ("",["sourceCode","haskell"],[]) <$>

655+ <|> (B.codeBlockWith ("",["sourceCode","haskell"],[]) <$>

648 lhsCodeBlockInverseBird)

656 lhsCodeBlockInverseBird)

649

657

650lhsCodeBlockLaTeX :: MarkdownParser String

658lhsCodeBlockLaTeX :: MarkdownParser String

@@ -673,7 +681,7 @@ lhsCodeBlockBirdWith c = try $ do

673 blanklines

681 blanklines

674 return $ intercalate "\n" lns'

682 return $ intercalate "\n" lns'

675

683

676−birdTrackLine :: Char -> Parser [Char] st String

684+birdTrackLine :: Monad m => Char -> ParserT [Char] st m String

677birdTrackLine c = try $ do

685birdTrackLine c = try $ do

678 char c

686 char c

679 -- allow html tags on left margin:

687 -- allow html tags on left margin:

@@ -701,12 +709,12 @@ emailBlockQuote = try $ do

701 optional blanklines

709 optional blanklines

702 return raw

710 return raw

703

711

704−blockQuote :: MarkdownParser (F Blocks)

712+blockQuote :: MarkdownParser Blocks

705blockQuote = do

713blockQuote = do

706 raw <- emailBlockQuote

714 raw <- emailBlockQuote

707 -- parse the extracted block, which may contain various block elements:

715 -- parse the extracted block, which may contain various block elements:

708− contents <- parseFromString parseBlocks $ (intercalate "\n" raw) ++ "\n\n"

716+ contents <- parseFromString parseBlocks $ intercalate "\n" raw ++ "\n\n"

709− return $ B.blockQuote <$> contents

717+ return $ B.blockQuote contents

710

718

711--

719--

712-- list blocks

720-- list blocks

@@ -749,7 +757,7 @@ anyOrderedListStart = try $ do

749 return res

757 return res

750

758

751listStart :: MarkdownParser ()

759listStart :: MarkdownParser ()

752−listStart = bulletListStart <|> (anyOrderedListStart >> return ())

760+listStart = bulletListStart <|> void anyOrderedListStart

753

761

754listLine :: MarkdownParser String

762listLine :: MarkdownParser String

755listLine = try $ do

763listLine = try $ do

@@ -804,7 +812,7 @@ listContinuationLine = try $ do

804 return $ result ++ "\n"

812 return $ result ++ "\n"

805

813

806listItem :: MarkdownParser a

814listItem :: MarkdownParser a

807− -> MarkdownParser (F Blocks)

815+ -> MarkdownParser Blocks

808listItem start = try $ do

816listItem start = try $ do

809 first <- rawListItem start

817 first <- rawListItem start

810 continuations <- many listContinuation

818 continuations <- many listContinuation

@@ -820,14 +828,14 @@ listItem start = try $ do

820 updateState (\st -> st {stateParserContext = oldContext})

828 updateState (\st -> st {stateParserContext = oldContext})

821 return contents

829 return contents

822

830

823−orderedList :: MarkdownParser (F Blocks)

831+orderedList :: MarkdownParser Blocks

824orderedList = try $ do

832orderedList = try $ do

825 (start, style, delim) <- lookAhead anyOrderedListStart

833 (start, style, delim) <- lookAhead anyOrderedListStart

826 unless (style `elem` [DefaultStyle, Decimal, Example] &&

834 unless (style `elem` [DefaultStyle, Decimal, Example] &&

827 delim `elem` [DefaultDelim, Period]) $

835 delim `elem` [DefaultDelim, Period]) $

828 guardEnabled Ext_fancy_lists

836 guardEnabled Ext_fancy_lists

829 when (style == Example) $ guardEnabled Ext_example_lists

837 when (style == Example) $ guardEnabled Ext_example_lists

830− items <- fmap sequence $ many1 $ listItem

838+ items <- many1 $ listItem

831 ( try $ do

839 ( try $ do

832 optional newline -- if preceded by Plain block in a list

840 optional newline -- if preceded by Plain block in a list

833 startpos <- sourceColumn <$> getPosition

841 startpos <- sourceColumn <$> getPosition

@@ -839,12 +847,12 @@ orderedList = try $ do

839 atMostSpaces (tabStop - (endpos - startpos))

847 atMostSpaces (tabStop - (endpos - startpos))

840 return res )

848 return res )

841 start' <- option 1 $ guardEnabled Ext_startnum >> return start

849 start' <- option 1 $ guardEnabled Ext_startnum >> return start

842− return $ B.orderedListWith (start', style, delim) <$> fmap compactify' items

850+ return $ B.orderedListWith (start', style, delim) (compactify' items)

843

851

844−bulletList :: MarkdownParser (F Blocks)

852+bulletList :: MarkdownParser Blocks

845bulletList = do

853bulletList = do

846− items <- fmap sequence $ many1 $ listItem bulletListStart

854+ items <- many1 $ listItem bulletListStart

847− return $ B.bulletList <$> fmap compactify' items

855+ return $ B.bulletList (compactify' items)

848

856

849-- definition lists

857-- definition lists

850

858

@@ -859,14 +867,14 @@ defListMarker = do

859 else mzero

867 else mzero

860 return ()

868 return ()

861

869

862−definitionListItem :: Bool -> MarkdownParser (F (Inlines, [Blocks]))

870+definitionListItem :: Bool -> MarkdownParser (Inlines, [Blocks])

863definitionListItem compact = try $ do

871definitionListItem compact = try $ do

864 rawLine' <- anyLine

872 rawLine' <- anyLine

865 raw <- many1 $ defRawBlock compact

873 raw <- many1 $ defRawBlock compact

866− term <- parseFromString (trimInlinesF . mconcat <$> many inline) rawLine'

874+ term <- parseFromString (trimInlines . mconcat <$> many inline) rawLine'

867 contents <- mapM (parseFromString parseBlocks) raw

875 contents <- mapM (parseFromString parseBlocks) raw

868 optional blanklines

876 optional blanklines

869− return $ liftM2 (,) term (sequence contents)

877+ return (term, contents)

870

878

871defRawBlock :: Bool -> MarkdownParser String

879defRawBlock :: Bool -> MarkdownParser String

872defRawBlock compact = try $ do

880defRawBlock compact = try $ do

@@ -889,32 +897,32 @@ defRawBlock compact = try $ do

889 return $ trimr (firstline ++ "\n" ++ unlines rawlines ++ cont) ++

897 return $ trimr (firstline ++ "\n" ++ unlines rawlines ++ cont) ++

890 if hasBlank || not (null cont) then "\n\n" else ""

898 if hasBlank || not (null cont) then "\n\n" else ""

891

899

892−definitionList :: MarkdownParser (F Blocks)

900+definitionList :: MarkdownParser Blocks

893definitionList = try $ do

901definitionList = try $ do

894 lookAhead (anyLine >> optional blankline >> defListMarker)

902 lookAhead (anyLine >> optional blankline >> defListMarker)

895 compactDefinitionList <|> normalDefinitionList

903 compactDefinitionList <|> normalDefinitionList

896

904

897−compactDefinitionList :: MarkdownParser (F Blocks)

905+compactDefinitionList :: MarkdownParser Blocks

898compactDefinitionList = do

906compactDefinitionList = do

899 guardEnabled Ext_compact_definition_lists

907 guardEnabled Ext_compact_definition_lists

900− items <- fmap sequence $ many1 $ definitionListItem True

908+ items <- many1 $ definitionListItem True

901− return $ B.definitionList <$> fmap compactify'DL items

909+ return $ B.definitionList (compactify'DL items)

902

910

903−normalDefinitionList :: MarkdownParser (F Blocks)

911+normalDefinitionList :: MarkdownParser Blocks

904normalDefinitionList = do

912normalDefinitionList = do

905 guardEnabled Ext_definition_lists

913 guardEnabled Ext_definition_lists

906− items <- fmap sequence $ many1 $ definitionListItem False

914+ items <- many1 $ definitionListItem False

907− return $ B.definitionList <$> items

915+ return $ B.definitionList items

908

916

909--

917--

910-- paragraph block

918-- paragraph block

911--

919--

912

920

913−para :: MarkdownParser (F Blocks)

921+para :: MarkdownParser Blocks

914para = try $ do

922para = try $ do

915 exts <- getOption readerExtensions

923 exts <- getOption readerExtensions

916− result <- trimInlinesF . mconcat <$> many1 inline

924+ result <- trimInlines . mconcat <$> many1 inline

917− option (B.plain <$> result)

925+ option (B.plain result)

918 $ try $ do

926 $ try $ do

919 newline

927 newline

920 (blanklines >> return mempty)

928 (blanklines >> return mempty)

@@ -931,18 +939,17 @@ para = try $ do

931 Just "div" -> () <$

939 Just "div" -> () <$

932 lookAhead (htmlTag (~== TagClose "div"))

940 lookAhead (htmlTag (~== TagClose "div"))

933 _ -> mzero

941 _ -> mzero

934− return $ do

942+ return $

935− result' <- result

936− case B.toList result' of

943+ case B.toList result of

937 [Image alt (src,tit)]

944 [Image alt (src,tit)]

938 | Ext_implicit_figures `Set.member` exts ->

945 | Ext_implicit_figures `Set.member` exts ->

939 -- the fig: at beginning of title indicates a figure

946 -- the fig: at beginning of title indicates a figure

940− return $ B.para $ B.singleton

947+ B.para $ B.singleton

941 $ Image alt (src,'f':'i':'g':':':tit)

948 $ Image alt (src,'f':'i':'g':':':tit)

942− _ -> return $ B.para result'

949+ _ -> B.para result

943

950

944−plain :: MarkdownParser (F Blocks)

951+plain :: MarkdownParser Blocks

945−plain = fmap B.plain . trimInlinesF . mconcat <$> many1 inline

952+plain = B.plain . trimInlines . mconcat <$> many1 inline

946

953

947--

954--

948-- raw html

955-- raw html

@@ -953,13 +960,13 @@ htmlElement = rawVerbatimBlock

953 <|> strictHtmlBlock

960 <|> strictHtmlBlock

954 <|> liftM snd (htmlTag isBlockTag)

961 <|> liftM snd (htmlTag isBlockTag)

955

962

956−htmlBlock :: MarkdownParser (F Blocks)

963+htmlBlock :: MarkdownParser Blocks

957htmlBlock = do

964htmlBlock = do

958 guardEnabled Ext_raw_html

965 guardEnabled Ext_raw_html

959 try (do

966 try (do

960 (TagOpen t attrs) <- lookAhead $ fst <$> htmlTag isBlockTag

967 (TagOpen t attrs) <- lookAhead $ fst <$> htmlTag isBlockTag

961 (guard (t `elem` ["pre","style","script"]) >>

968 (guard (t `elem` ["pre","style","script"]) >>

962− (return . B.rawBlock "html") <$> rawVerbatimBlock)

969+ B.rawBlock "html" <$> rawVerbatimBlock)

963 <|> (do guardEnabled Ext_markdown_attribute

970 <|> (do guardEnabled Ext_markdown_attribute

964 oldMarkdownAttribute <- stateMarkdownAttribute <$> getState

971 oldMarkdownAttribute <- stateMarkdownAttribute <$> getState

965 markdownAttribute <-

972 markdownAttribute <-

@@ -978,35 +985,35 @@ htmlBlock = do

978 <|> (guardEnabled Ext_markdown_in_html_blocks >> rawHtmlBlocks))

985 <|> (guardEnabled Ext_markdown_in_html_blocks >> rawHtmlBlocks))

979 <|> htmlBlock'

986 <|> htmlBlock'

980

987

981−htmlBlock' :: MarkdownParser (F Blocks)

988+htmlBlock' :: MarkdownParser Blocks

982htmlBlock' = try $ do

989htmlBlock' = try $ do

983 first <- htmlElement

990 first <- htmlElement

984 skipMany spaceChar

991 skipMany spaceChar

985 optional blanklines

992 optional blanklines

986− return $ return $ B.rawBlock "html" first

993+ return $ B.rawBlock "html" first

987

994

988strictHtmlBlock :: MarkdownParser String

995strictHtmlBlock :: MarkdownParser String

989strictHtmlBlock = htmlInBalanced (not . isInlineTag)

996strictHtmlBlock = htmlInBalanced (not . isInlineTag)

990

997

991rawVerbatimBlock :: MarkdownParser String

998rawVerbatimBlock :: MarkdownParser String

992rawVerbatimBlock = try $ do

999rawVerbatimBlock = try $ do

993− (TagOpen tag _, open) <- htmlTag (tagOpen (flip elem

1000+ (TagOpen tag _, open) <-

994− ["pre", "style", "script"])

1001+ htmlTag (tagOpen (`elem` ["pre", "style", "script"])

995− (const True))

1002+ (const True))

996 contents <- manyTill anyChar (htmlTag (~== TagClose tag))

1003 contents <- manyTill anyChar (htmlTag (~== TagClose tag))

997 return $ open ++ contents ++ renderTags' [TagClose tag]

1004 return $ open ++ contents ++ renderTags' [TagClose tag]

998

1005

999−rawTeXBlock :: MarkdownParser (F Blocks)

1006+rawTeXBlock :: MarkdownParser Blocks

1000rawTeXBlock = do

1007rawTeXBlock = do

1001 guardEnabled Ext_raw_tex

1008 guardEnabled Ext_raw_tex

1002 result <- (B.rawBlock "latex" . concat <$>

1009 result <- (B.rawBlock "latex" . concat <$>

1003− rawLaTeXBlock `sepEndBy1` blankline)

1010+ generalize rawLaTeXBlock `sepEndBy1` blankline)

1004 <|> (B.rawBlock "context" . concat <$>

1011 <|> (B.rawBlock "context" . concat <$>

1005 rawConTeXtEnvironment `sepEndBy1` blankline)

1012 rawConTeXtEnvironment `sepEndBy1` blankline)

1006 spaces

1013 spaces

1007− return $ return result

1014+ return result

1008

1015

1009−rawHtmlBlocks :: MarkdownParser (F Blocks)

1016+rawHtmlBlocks :: MarkdownParser Blocks

1010rawHtmlBlocks = do

1017rawHtmlBlocks = do

1011 (TagOpen tagtype _, raw) <- htmlTag isBlockTag

1018 (TagOpen tagtype _, raw) <- htmlTag isBlockTag

1012 -- try to find closing tag

1019 -- try to find closing tag

@@ -1018,10 +1025,10 @@ rawHtmlBlocks = do

1018 contents <- mconcat <$> many (notFollowedBy' closer >> block)

1025 contents <- mconcat <$> many (notFollowedBy' closer >> block)

1019 result <-

1026 result <-

1020 (closer >>= \(_, rawcloser) -> return (

1027 (closer >>= \(_, rawcloser) -> return (

1021− return (B.rawBlock "html" $ stripMarkdownAttribute raw) <>

1028+ (B.rawBlock "html" $ stripMarkdownAttribute raw) <>

1022 contents <>

1029 contents <>

1023− return (B.rawBlock "html" rawcloser)))

1030+ (B.rawBlock "html" rawcloser)))

1024− <|> return (return (B.rawBlock "html" raw) <> contents)

1031+ <|> return (B.rawBlock "html" raw <> contents)

1025 updateState $ \st -> st{ stateInHtmlBlock = oldInHtmlBlock }

1032 updateState $ \st -> st{ stateInHtmlBlock = oldInHtmlBlock }

1026 return result

1033 return result

1027

1034

@@ -1036,12 +1043,12 @@ stripMarkdownAttribute s = renderTags' $ map filterAttrib $ parseTags s

1036-- line block

1043-- line block

1037--

1044--

1038

1045

1039−lineBlock :: MarkdownParser (F Blocks)

1046+lineBlock :: MarkdownParser Blocks

1040lineBlock = try $ do

1047lineBlock = try $ do

1041 guardEnabled Ext_line_blocks

1048 guardEnabled Ext_line_blocks

1042 lines' <- lineBlockLines >>=

1049 lines' <- lineBlockLines >>=

1043− mapM (parseFromString (trimInlinesF . mconcat <$> many inline))

1050+ mapM (parseFromString (trimInlines . mconcat <$> many inline))

1044− return $ B.para <$> (mconcat $ intersperse (return B.linebreak) lines')

1051+ return $ B.para (mconcat $ intersperse B.linebreak lines')

1045

1052

1046--

1053--

1047-- Tables

1054-- Tables

@@ -1049,17 +1056,17 @@ lineBlock = try $ do

1049

1056

1050-- Parse a dashed line with optional trailing spaces; return its length

1057-- Parse a dashed line with optional trailing spaces; return its length

1051-- and the length including trailing space.

1058-- and the length including trailing space.

1052−dashedLine :: Char

1059+dashedLine :: Monad m => Char

1053− -> Parser [Char] st (Int, Int)

1060+ -> ParserT [Char] st m (Int, Int)

1054dashedLine ch = do

1061dashedLine ch = do

1055 dashes <- many1 (char ch)

1062 dashes <- many1 (char ch)

1056 sp <- many spaceChar

1063 sp <- many spaceChar

1057− return $ (length dashes, length $ dashes ++ sp)

1064+ return (length dashes, length $ dashes ++ sp)

1058

1065

1059-- Parse a table header with dashed lines of '-' preceded by

1066-- Parse a table header with dashed lines of '-' preceded by

1060-- one (or zero) line of text.

1067-- one (or zero) line of text.

1061simpleTableHeader :: Bool -- ^ Headerless table

1068simpleTableHeader :: Bool -- ^ Headerless table

1062− -> MarkdownParser (F [Blocks], [Alignment], [Int])

1069+ -> MarkdownParser ([Blocks], [Alignment], [Int])

1063simpleTableHeader headless = try $ do

1070simpleTableHeader headless = try $ do

1064 rawContent <- if headless

1071 rawContent <- if headless

1065 then return ""

1072 then return ""

@@ -1078,9 +1085,8 @@ simpleTableHeader headless = try $ do

1078 let rawHeads' = if headless

1085 let rawHeads' = if headless

1079 then replicate (length dashes) ""

1086 then replicate (length dashes) ""

1080 else rawHeads

1087 else rawHeads

1081− heads <- fmap sequence

1088+ heads <-

1082− $ mapM (parseFromString (mconcat <$> many plain))

1089+ mapM (parseFromString (mconcat <$> many plain) . trim) rawHeads'

1083− $ map trim rawHeads'

1084 return (heads, aligns, indices)

1090 return (heads, aligns, indices)

1085

1091

1086-- Returns an alignment type for a table, based on a list of strings

1092-- Returns an alignment type for a table, based on a list of strings

@@ -1121,30 +1127,30 @@ rawTableLine indices = do

1121

1127

1122-- Parse a table line and return a list of lists of blocks (columns).

1128-- Parse a table line and return a list of lists of blocks (columns).

1123tableLine :: [Int]

1129tableLine :: [Int]

1124− -> MarkdownParser (F [Blocks])

1130+ -> MarkdownParser [Blocks]

1125tableLine indices = rawTableLine indices >>=

1131tableLine indices = rawTableLine indices >>=

1126− fmap sequence . mapM (parseFromString (mconcat <$> many plain))

1132+ mapM (parseFromString (mconcat <$> many plain))

1127

1133

1128-- Parse a multiline table row and return a list of blocks (columns).

1134-- Parse a multiline table row and return a list of blocks (columns).

1129multilineRow :: [Int]

1135multilineRow :: [Int]

1130− -> MarkdownParser (F [Blocks])

1136+ -> MarkdownParser [Blocks]

1131multilineRow indices = do

1137multilineRow indices = do

1132 colLines <- many1 (rawTableLine indices)

1138 colLines <- many1 (rawTableLine indices)

1133 let cols = map unlines $ transpose colLines

1139 let cols = map unlines $ transpose colLines

1134− fmap sequence $ mapM (parseFromString (mconcat <$> many plain)) cols

1140+ mapM (parseFromString (mconcat <$> many plain)) cols

1135

1141

1136-- Parses a table caption: inlines beginning with 'Table:'

1142-- Parses a table caption: inlines beginning with 'Table:'

1137-- and followed by blank lines.

1143-- and followed by blank lines.

1138−tableCaption :: MarkdownParser (F Inlines)

1144+tableCaption :: MarkdownParser Inlines

1139tableCaption = try $ do

1145tableCaption = try $ do

1140 guardEnabled Ext_table_captions

1146 guardEnabled Ext_table_captions

1141 skipNonindentSpaces

1147 skipNonindentSpaces

1142 string ":" <|> string "Table:"

1148 string ":" <|> string "Table:"

1143− trimInlinesF . mconcat <$> many1 inline <* blanklines

1149+ trimInlines . mconcat <$> many1 inline <* blanklines

1144

1150

1145-- Parse a simple table with '---' header and one line per row.

1151-- Parse a simple table with '---' header and one line per row.

1146simpleTable :: Bool -- ^ Headerless table

1152simpleTable :: Bool -- ^ Headerless table

1147− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])

1153+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])

1148simpleTable headless = do

1154simpleTable headless = do

1149 (aligns, _widths, heads', lines') <-

1155 (aligns, _widths, heads', lines') <-

1150 tableWith (simpleTableHeader headless) tableLine

1156 tableWith (simpleTableHeader headless) tableLine

@@ -1158,12 +1164,12 @@ simpleTable headless = do

1158-- which may be multiline, separated by blank lines, and

1164-- which may be multiline, separated by blank lines, and

1159-- ending with a footer (dashed line followed by blank line).

1165-- ending with a footer (dashed line followed by blank line).

1160multilineTable :: Bool -- ^ Headerless table

1166multilineTable :: Bool -- ^ Headerless table

1161− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])

1167+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])

1162multilineTable headless =

1168multilineTable headless =

1163 tableWith (multilineTableHeader headless) multilineRow blanklines tableFooter

1169 tableWith (multilineTableHeader headless) multilineRow blanklines tableFooter

1164

1170

1165multilineTableHeader :: Bool -- ^ Headerless table

1171multilineTableHeader :: Bool -- ^ Headerless table

1166− -> MarkdownParser (F [Blocks], [Alignment], [Int])

1172+ -> MarkdownParser ([Blocks], [Alignment], [Int])

1167multilineTableHeader headless = try $ do

1173multilineTableHeader headless = try $ do

1168 unless headless $

1174 unless headless $

1169 tableSep >> notFollowedBy blankline

1175 tableSep >> notFollowedBy blankline

@@ -1185,7 +1191,7 @@ multilineTableHeader headless = try $ do

1185 let rawHeads = if headless

1191 let rawHeads = if headless

1186 then replicate (length dashes) ""

1192 then replicate (length dashes) ""

1187 else map (unlines . map trim) rawHeadsList

1193 else map (unlines . map trim) rawHeadsList

1188− heads <- fmap sequence $

1194+ heads <-

1189 mapM (parseFromString (mconcat <$> many plain)) $

1195 mapM (parseFromString (mconcat <$> many plain)) $

1190 map trim rawHeads

1196 map trim rawHeads

1191 return (heads, aligns, indices)

1197 return (heads, aligns, indices)

@@ -1195,7 +1201,7 @@ multilineTableHeader headless = try $ do

1195-- which may be grid, separated by blank lines, and

1201-- which may be grid, separated by blank lines, and

1196-- ending with a footer (dashed line followed by blank line).

1202-- ending with a footer (dashed line followed by blank line).

1197gridTable :: Bool -- ^ Headerless table

1203gridTable :: Bool -- ^ Headerless table

1198− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])

1204+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])

1199gridTable headless =

1205gridTable headless =

1200 tableWith (gridTableHeader headless) gridTableRow

1206 tableWith (gridTableHeader headless) gridTableRow

1201 (gridTableSep '-') gridTableFooter

1207 (gridTableSep '-') gridTableFooter

@@ -1204,13 +1210,13 @@ gridTableSplitLine :: [Int] -> String -> [String]

1204gridTableSplitLine indices line = map removeFinalBar $ tail $

1210gridTableSplitLine indices line = map removeFinalBar $ tail $

1205 splitStringByIndices (init indices) $ trimr line

1211 splitStringByIndices (init indices) $ trimr line

1206

1212

1207−gridPart :: Char -> Parser [Char] st (Int, Int)

1213+gridPart :: Monad m => Char -> ParserT [Char] st m (Int, Int)

1208gridPart ch = do

1214gridPart ch = do

1209 dashes <- many1 (char ch)

1215 dashes <- many1 (char ch)

1210 char '+'

1216 char '+'

1211 return (length dashes, length dashes + 1)

1217 return (length dashes, length dashes + 1)

1212

1218

1213−gridDashedLines :: Char -> Parser [Char] st [(Int,Int)]

1219+gridDashedLines :: Monad m => Char -> ParserT [Char] st m [(Int,Int)]

1214gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) <* blankline

1220gridDashedLines ch = try $ char '+' >> many1 (gridPart ch) <* blankline

1215

1221

1216removeFinalBar :: String -> String

1222removeFinalBar :: String -> String

@@ -1223,7 +1229,7 @@ gridTableSep ch = try $ gridDashedLines ch >> return '\n'

1223

1229

1224-- | Parse header for a grid table.

1230-- | Parse header for a grid table.

1225gridTableHeader :: Bool -- ^ Headerless table

1231gridTableHeader :: Bool -- ^ Headerless table

1226− -> MarkdownParser (F [Blocks], [Alignment], [Int])

1232+ -> MarkdownParser ([Blocks], [Alignment], [Int])

1227gridTableHeader headless = try $ do

1233gridTableHeader headless = try $ do

1228 optional blanklines

1234 optional blanklines

1229 dashes <- gridDashedLines '-'

1235 dashes <- gridDashedLines '-'

@@ -1232,9 +1238,7 @@ gridTableHeader headless = try $ do

1232 else many1

1238 else many1

1233 (notFollowedBy (gridTableSep '=') >> char '|' >>

1239 (notFollowedBy (gridTableSep '=') >> char '|' >>

1234 many1Till anyChar newline)

1240 many1Till anyChar newline)

1235− if headless

1236− then return ()

1237− else gridTableSep '=' >> return ()

1241+ unless headless (void $ gridTableSep '=')

1238 let lines' = map snd dashes

1242 let lines' = map snd dashes

1239 let indices = scanl (+) 0 lines'

1243 let indices = scanl (+) 0 lines'

1240 let aligns = replicate (length lines') AlignDefault

1244 let aligns = replicate (length lines') AlignDefault

@@ -1243,7 +1247,7 @@ gridTableHeader headless = try $ do

1243 then replicate (length dashes) ""

1247 then replicate (length dashes) ""

1244 else map (unlines . map trim) $ transpose

1248 else map (unlines . map trim) $ transpose

1245 $ map (gridTableSplitLine indices) rawContent

1249 $ map (gridTableSplitLine indices) rawContent

1246− heads <- fmap sequence $ mapM (parseFromString parseBlocks . trim) rawHeads

1250+ heads <- mapM (parseFromString parseBlocks . trim) rawHeads

1247 return (heads, aligns, indices)

1251 return (heads, aligns, indices)

1248

1252

1249gridTableRawLine :: [Int] -> MarkdownParser [String]

1253gridTableRawLine :: [Int] -> MarkdownParser [String]

@@ -1254,12 +1258,12 @@ gridTableRawLine indices = do

1254

1258

1255-- | Parse row of grid table.

1259-- | Parse row of grid table.

1256gridTableRow :: [Int]

1260gridTableRow :: [Int]

1257− -> MarkdownParser (F [Blocks])

1261+ -> MarkdownParser [Blocks]

1258gridTableRow indices = do

1262gridTableRow indices = do

1259 colLines <- many1 (gridTableRawLine indices)

1263 colLines <- many1 (gridTableRawLine indices)

1260 let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $

1264 let cols = map ((++ "\n") . unlines . removeOneLeadingSpace) $

1261 transpose colLines

1265 transpose colLines

1262− fmap compactify' <$> fmap sequence (mapM (parseFromString parseBlocks) cols)

1266+ compactify' <$> mapM (parseFromString parseBlocks) cols

1263

1267

1264removeOneLeadingSpace :: [String] -> [String]

1268removeOneLeadingSpace :: [String] -> [String]

1265removeOneLeadingSpace xs =

1269removeOneLeadingSpace xs =

@@ -1285,14 +1289,12 @@ pipeBreak = try $ do

1285 blankline

1289 blankline

1286 return (first:rest)

1290 return (first:rest)

1287

1291

1288−pipeTable :: MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])

1292+pipeTable :: MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])

1289pipeTable = try $ do

1293pipeTable = try $ do

1290− (heads,aligns) <- pipeTableRow >>= \row ->

1294+ (heads,aligns) <- (,) <$> pipeTableRow <*> pipeBreak

1291− pipeBreak >>= \als ->

1292− return (row, als)

1293− lines' <- sequence <$> many1 pipeTableRow

1295+ lines' <- many1 pipeTableRow

1294 let widths = replicate (length aligns) 0.0

1296 let widths = replicate (length aligns) 0.0

1295− return $ (aligns, widths, heads, lines')

1297+ return (aligns, widths, heads, lines')

1296

1298

1297sepPipe :: MarkdownParser ()

1299sepPipe :: MarkdownParser ()

1298sepPipe = try $ do

1300sepPipe = try $ do

@@ -1300,7 +1302,7 @@ sepPipe = try $ do

1300 notFollowedBy blankline

1302 notFollowedBy blankline

1301

1303

1302-- parse a row, also returning probable alignments for org-table cells

1304-- parse a row, also returning probable alignments for org-table cells

1303−pipeTableRow :: MarkdownParser (F [Blocks])

1305+pipeTableRow :: MarkdownParser [Blocks]

1304pipeTableRow = do

1306pipeTableRow = do

1305 nonindentSpaces

1307 nonindentSpaces

1306 openPipe <- (True <$ char '|') <|> return False

1308 openPipe <- (True <$ char '|') <|> return False

@@ -1312,16 +1314,14 @@ pipeTableRow = do

1312 guard $ not (null rest && not openPipe)

1314 guard $ not (null rest && not openPipe)

1313 optional (char '|')

1315 optional (char '|')

1314 blankline

1316 blankline

1315− let cells = sequence (first:rest)

1317+ let cells = first:rest

1316− return $ do

1318+ return $

1317− cells' <- cells

1318− return $ map

1319− (\ils ->

1319+ map (\ils ->

1320 case trimInlines ils of

1321 ils' | B.isNull ils' -> mempty

1322− | otherwise -> B.plain $ ils') cells'

1322+ | otherwise -> B.plain ils') cells

1323

1324−pipeTableHeaderPart :: Parser [Char] st Alignment

1324+pipeTableHeaderPart :: Monad m => ParserT [Char] st m Alignment

1325pipeTableHeaderPart = try $ do

1326 skipMany spaceChar

1327 left <- optionMaybe (char ':')

@@ -1336,7 +1336,7 @@ pipeTableHeaderPart = try $ do

1336 (Just _,Just _) -> AlignCenter

1337

1338-- Succeed only if current line contains a pipe.

1339−scanForPipe :: Parser [Char] st ()

1339+scanForPipe :: Monad m => ParserT [Char] st m ()

1340scanForPipe = do

1341 inp <- getInput

1342 case break (\c -> c == '\n' || c == '|') inp of

@@ -1346,22 +1346,22 @@ scanForPipe = do

1346-- | Parse a table using 'headerParser', 'rowParser',

1347-- 'lineParser', and 'footerParser'. Variant of the version in

1348-- Text.Pandoc.Parsing.

1349−tableWith :: MarkdownParser (F [Blocks], [Alignment], [Int])

1349+tableWith :: MarkdownParser ([Blocks], [Alignment], [Int])

1350− -> ([Int] -> MarkdownParser (F [Blocks]))

1350+ -> ([Int] -> MarkdownParser [Blocks])

1351 -> MarkdownParser sep

1352 -> MarkdownParser end

1353− -> MarkdownParser ([Alignment], [Double], F [Blocks], F [[Blocks]])

1353+ -> MarkdownParser ([Alignment], [Double], [Blocks], [[Blocks]])

1354tableWith headerParser rowParser lineParser footerParser = try $ do

1355 (heads, aligns, indices) <- headerParser

1356− lines' <- fmap sequence $ rowParser indices `sepEndBy1` lineParser

1356+ lines' <- rowParser indices `sepEndBy1` lineParser

1357 footerParser

1358 numColumns <- getOption readerColumns

1359− let widths = if (indices == [])

1359+ let widths = case indices of

1360− then replicate (length aligns) 0.0

1360+ [] -> replicate (length aligns) 0.0

1361− else widthsFromIndices numColumns indices

1361+ _ -> widthsFromIndices numColumns indices

1362− return $ (aligns, widths, heads, lines')

1362+ return (aligns, widths, heads, lines')

1363

1364−table :: MarkdownParser (F Blocks)

1364+table :: MarkdownParser Blocks

1365table = try $ do

1366 frontCaption <- option Nothing (Just <$> tableCaption)

1367 (aligns, widths, heads, lns) <-

@@ -1376,19 +1376,15 @@ table = try $ do

1376 (gridTable False <|> gridTable True)) <?> "table"

1377 optional blanklines

1378 caption <- case frontCaption of

1379− Nothing -> option (return mempty) tableCaption

1379+ Nothing -> option mempty tableCaption

1380 Just c -> return c

1381− return $ do

1382− caption' <- caption

1383− heads' <- heads

1384− lns' <- lns

1385− return $ B.table caption' (zip aligns widths) heads' lns'

1381+ return $ B.table caption (zip aligns widths) heads lns

1386

1382

1387--

1383--

1388-- inline

1384-- inline

1389--

1385--

1390

1386

1391−inline :: MarkdownParser (F Inlines)

1387+inline :: MarkdownParser Inlines

1392inline = choice [ whitespace

1388inline = choice [ whitespace

1393 , bareURL

1389 , bareURL

1394 , str

1390 , str

@@ -1411,7 +1407,7 @@ inline = choice [ whitespace

1411 , rawLaTeXInline'

1407 , rawLaTeXInline'

1412 , exampleRef

1408 , exampleRef

1413 , smart

1409 , smart

1414− , return . B.singleton <$> charRef

1410+ , B.singleton <$> charRef

1415 , symbol

1411 , symbol

1416 , ltSign

1412 , ltSign

1417 ] <?> "inline"

1413 ] <?> "inline"

@@ -1422,43 +1418,42 @@ escapedChar' = try $ do

1422 (guardEnabled Ext_all_symbols_escapable >> satisfy (not . isAlphaNum))

1418 (guardEnabled Ext_all_symbols_escapable >> satisfy (not . isAlphaNum))

1423 <|> oneOf "\\`*_{}[]()>#+-.!~\""

1419 <|> oneOf "\\`*_{}[]()>#+-.!~\""

1424

1420

1425−escapedChar :: MarkdownParser (F Inlines)

1421+escapedChar :: MarkdownParser Inlines

1426escapedChar = do

1422escapedChar = do

1427 result <- escapedChar'

1423 result <- escapedChar'

1428 case result of

1424 case result of

1429− ' ' -> return $ return $ B.str "\160" -- "\ " is a nonbreaking space

1425+ ' ' -> return $ B.str "\160" -- "\ " is a nonbreaking space

1430 '\n' -> guardEnabled Ext_escaped_line_breaks >>

1426 '\n' -> guardEnabled Ext_escaped_line_breaks >>

1431− return (return B.linebreak) -- "\[newline]" is a linebreak

1427+ return B.linebreak -- "\[newline]" is a linebreak

1432− _ -> return $ return $ B.str [result]

1428+ _ -> return $ B.str [result]

1433

1429

1434−ltSign :: MarkdownParser (F Inlines)

1430+ltSign :: MarkdownParser Inlines

1435ltSign = do

1431ltSign = do

1436 guardDisabled Ext_raw_html

1432 guardDisabled Ext_raw_html

1437 <|> (notFollowedByHtmlCloser >> notFollowedBy' (htmlTag isBlockTag))

1433 <|> (notFollowedByHtmlCloser >> notFollowedBy' (htmlTag isBlockTag))

1438 char '<'

1434 char '<'

1439− return $ return $ B.str "<"

1435+ return $ B.str "<"

1440

1436

1441−exampleRef :: MarkdownParser (F Inlines)

1437+exampleRef :: MarkdownParser Inlines

1442exampleRef = try $ do

1438exampleRef = try $ do

1443 guardEnabled Ext_example_lists

1439 guardEnabled Ext_example_lists

1444 char '@'

1440 char '@'

1445 lab <- many1 (alphaNum <|> oneOf "-_")

1441 lab <- many1 (alphaNum <|> oneOf "-_")

1446− return $ do

1442+ st <- ask

1447− st <- askF

1448− return $ case M.lookup lab (stateExamples st) of

1443+ return $ case M.lookup lab (stateExamples st) of

1449− Just n -> B.str (show n)

1444+ Just n -> B.str (show n)

1450− Nothing -> B.str ('@':lab)

1445+ Nothing -> B.str ('@':lab)

1451

1446

1452−symbol :: MarkdownParser (F Inlines)

1447+symbol :: MarkdownParser Inlines

1453symbol = do

1448symbol = do

1454 result <- noneOf "<\\\n\t "

1449 result <- noneOf "<\\\n\t "

1455 <|> try (do lookAhead $ char '\\'

1450 <|> try (do lookAhead $ char '\\'

1456 notFollowedBy' (() <$ rawTeXBlock)

1451 notFollowedBy' (() <$ rawTeXBlock)

1457 char '\\')

1452 char '\\')

1458− return $ return $ B.str [result]

1453+ return $ B.str [result]

1459

1454

1460-- parses inline code, between n `s and n `s

1455-- parses inline code, between n `s and n `s

1461−code :: MarkdownParser (F Inlines)

1456+code :: MarkdownParser Inlines

1462code = try $ do

1457code = try $ do

1463 starts <- many1 (char '`')

1458 starts <- many1 (char '`')

1464 skipSpaces

1459 skipSpaces

@@ -1468,16 +1463,16 @@ code = try $ do

1468 notFollowedBy (char '`')))

1463 notFollowedBy (char '`')))

1469 attr <- option ([],[],[]) (try $ guardEnabled Ext_inline_code_attributes >>

1464 attr <- option ([],[],[]) (try $ guardEnabled Ext_inline_code_attributes >>

1470 optional whitespace >> attributes)

1465 optional whitespace >> attributes)

1471− return $ return $ B.codeWith attr $ trim $ concat result

1466+ return $ B.codeWith attr $ trim $ concat result

1472

1467

1473−math :: MarkdownParser (F Inlines)

1468+math :: MarkdownParser Inlines

1474−math = (return . B.displayMath <$> (mathDisplay >>= applyMacros'))

1469+math = (B.displayMath <$> (mathDisplay >>= applyMacros'))

1475− <|> (return . B.math <$> (mathInline >>= applyMacros'))

1470+ <|> (B.math <$> (mathInline >>= applyMacros'))

1476

1471

1477-- Parses material enclosed in *s, **s, _s, or __s.

1472-- Parses material enclosed in *s, **s, _s, or __s.

1478-- Designed to avoid backtracking.

1473-- Designed to avoid backtracking.

1479enclosure :: Char

1474enclosure :: Char

1480− -> MarkdownParser (F Inlines)

1475+ -> MarkdownParser Inlines

1481enclosure c = do

1476enclosure c = do

1482 -- we can't start an enclosure with _ if after a string and

1477 -- we can't start an enclosure with _ if after a string and

1483 -- the intraword_underscores extension is enabled:

1478 -- the intraword_underscores extension is enabled:

@@ -1485,13 +1480,13 @@ enclosure c = do

1485 <|> guard (c == '*')

1480 <|> guard (c == '*')

1486 <|> (guard =<< notAfterString)

1481 <|> (guard =<< notAfterString)

1487 cs <- many1 (char c)

1482 cs <- many1 (char c)

1488− (return (B.str cs) <>) <$> whitespace

1483+ (B.str cs <>) <$> whitespace

1489− <|> do

1484+ <|>

1490 case length cs of

1485 case length cs of

1491 3 -> three c

1486 3 -> three c

1492 2 -> two c mempty

1487 2 -> two c mempty

1493 1 -> one c mempty

1488 1 -> one c mempty

1494− _ -> return (return $ B.str cs)

1489+ _ -> return $ B.str cs

1495

1490

1496ender :: Char -> Int -> MarkdownParser ()

1491ender :: Char -> Int -> MarkdownParser ()

1497ender c n = try $ do

1492ender c n = try $ do

@@ -1504,74 +1499,74 @@ ender c n = try $ do

1504-- If one c, emit emph and then parse two.

1499-- If one c, emit emph and then parse two.

1505-- If two cs, emit strong and then parse one.

1500-- If two cs, emit strong and then parse one.

1506-- Otherwise, emit ccc then the results.

1501-- Otherwise, emit ccc then the results.

1507−three :: Char -> MarkdownParser (F Inlines)

1502+three :: Char -> MarkdownParser Inlines

1508three c = do

1503three c = do

1509 contents <- mconcat <$> many (notFollowedBy (ender c 1) >> inline)

1504 contents <- mconcat <$> many (notFollowedBy (ender c 1) >> inline)

1510− (ender c 3 >> return ((B.strong . B.emph) <$> contents))

1505+ (ender c 3 >> return ((B.strong . B.emph) contents))

1511− <|> (ender c 2 >> one c (B.strong <$> contents))

1506+ <|> (ender c 2 >> one c (B.strong contents))

1512− <|> (ender c 1 >> two c (B.emph <$> contents))

1507+ <|> (ender c 1 >> two c (B.emph contents))

1513− <|> return (return (B.str [c,c,c]) <> contents)

1508+ <|> return (B.str [c,c,c] <> contents)

1514

1509

1515-- Parse inlines til you hit two c's, and emit strong.

1510-- Parse inlines til you hit two c's, and emit strong.

1516-- If you never do hit two cs, emit ** plus inlines parsed.

1511-- If you never do hit two cs, emit ** plus inlines parsed.

1517−two :: Char -> F Inlines -> MarkdownParser (F Inlines)

1512+two :: Char -> Inlines -> MarkdownParser Inlines

1518two c prefix' = do

1513two c prefix' = do

1519 contents <- mconcat <$> many (try $ notFollowedBy (ender c 2) >> inline)

1514 contents <- mconcat <$> many (try $ notFollowedBy (ender c 2) >> inline)

1520− (ender c 2 >> return (B.strong <$> (prefix' <> contents)))

1515+ (ender c 2 >> return (B.strong (prefix' <> contents)))

1521− <|> return (return (B.str [c,c]) <> (prefix' <> contents))

1516+ <|> return (B.str [c,c] <> (prefix' <> contents))

1522

1517

1523-- Parse inlines til you hit a c, and emit emph.

1518-- Parse inlines til you hit a c, and emit emph.

1524-- If you never hit a c, emit * plus inlines parsed.

1519-- If you never hit a c, emit * plus inlines parsed.

1525−one :: Char -> F Inlines -> MarkdownParser (F Inlines)

1520+one :: Char -> Inlines -> MarkdownParser Inlines

1526one c prefix' = do

1521one c prefix' = do

1527 contents <- mconcat <$> many ( (notFollowedBy (ender c 1) >> inline)

1522 contents <- mconcat <$> many ( (notFollowedBy (ender c 1) >> inline)

1528 <|> try (string [c,c] >>

1523 <|> try (string [c,c] >>

1529 notFollowedBy (ender c 1) >>

1524 notFollowedBy (ender c 1) >>

1530 two c mempty) )

1525 two c mempty) )

1531− (ender c 1 >> return (B.emph <$> (prefix' <> contents)))

1526+ (ender c 1 >> return (B.emph (prefix' <> contents)))

1532− <|> return (return (B.str [c]) <> (prefix' <> contents))

1527+ <|> return (B.str [c] <> (prefix' <> contents))

1533

1528

1534−strongOrEmph :: MarkdownParser (F Inlines)

1529+strongOrEmph :: MarkdownParser Inlines

1535strongOrEmph = enclosure '*' <|> enclosure '_'

1530strongOrEmph = enclosure '*' <|> enclosure '_'

1536

1531

1537−-- | Parses a list of inlines between start and end delimiters.

1532+-- | Parses a list oInlines between start and end delimiters.

1538inlinesBetween :: (Show b)

1533inlinesBetween :: (Show b)

1539 => MarkdownParser a

1534 => MarkdownParser a

1540 -> MarkdownParser b

1535 -> MarkdownParser b

1541− -> MarkdownParser (F Inlines)

1536+ -> MarkdownParser Inlines

1542inlinesBetween start end =

1537inlinesBetween start end =

1543− (trimInlinesF . mconcat) <$> try (start >> many1Till inner end)

1538+ (trimInlines . mconcat) <$> try (start >> many1Till inner end)

1544 where inner = innerSpace <|> (notFollowedBy' (() <$ whitespace) >> inline)

1539 where inner = innerSpace <|> (notFollowedBy' (() <$ whitespace) >> inline)

1545 innerSpace = try $ whitespace <* notFollowedBy' end

1540 innerSpace = try $ whitespace <* notFollowedBy' end

1546

1541

1547−strikeout :: MarkdownParser (F Inlines)

1542+strikeout :: MarkdownParser Inlines

1548−strikeout = fmap B.strikeout <$>

1543+strikeout = B.strikeout <$>

1549 (guardEnabled Ext_strikeout >> inlinesBetween strikeStart strikeEnd)

1544 (guardEnabled Ext_strikeout >> inlinesBetween strikeStart strikeEnd)

1550 where strikeStart = string "~~" >> lookAhead nonspaceChar

1545 where strikeStart = string "~~" >> lookAhead nonspaceChar

1551 >> notFollowedBy (char '~')

1546 >> notFollowedBy (char '~')

1552 strikeEnd = try $ string "~~"

1547 strikeEnd = try $ string "~~"

1553

1548

1554−superscript :: MarkdownParser (F Inlines)

1549+superscript :: MarkdownParser Inlines

1555−superscript = fmap B.superscript <$> try (do

1550+superscript = B.superscript <$> try (do

1556 guardEnabled Ext_superscript

1551 guardEnabled Ext_superscript

1557 char '^'

1552 char '^'

1558 mconcat <$> many1Till (notFollowedBy spaceChar >> inline) (char '^'))

1553 mconcat <$> many1Till (notFollowedBy spaceChar >> inline) (char '^'))

1559

1554

1560−subscript :: MarkdownParser (F Inlines)

1555+subscript :: MarkdownParser Inlines

1561−subscript = fmap B.subscript <$> try (do

1556+subscript = B.subscript <$> try (do

1562 guardEnabled Ext_subscript

1557 guardEnabled Ext_subscript

1563 char '~'

1558 char '~'

1564 mconcat <$> many1Till (notFollowedBy spaceChar >> inline) (char '~'))

1559 mconcat <$> many1Till (notFollowedBy spaceChar >> inline) (char '~'))

1565

1560

1566−whitespace :: MarkdownParser (F Inlines)

1561+whitespace :: MarkdownParser Inlines

1567−whitespace = spaceChar >> return <$> (lb <|> regsp) <?> "whitespace"

1562+whitespace = spaceChar >> (lb <|> regsp) <?> "whitespace"

1568 where lb = spaceChar >> skipMany spaceChar >> option B.space (endline >> return B.linebreak)

1563 where lb = spaceChar >> skipMany spaceChar >> option B.space (endline >> return B.linebreak)

1569 regsp = skipMany spaceChar >> return B.space

1564 regsp = skipMany spaceChar >> return B.space

1570

1565

1571−nonEndline :: Parser [Char] st Char

1566+nonEndline :: Monad m => ParserT [Char] st m Char

1572nonEndline = satisfy (/='\n')

1567nonEndline = satisfy (/='\n')

1573

1568

1574−str :: MarkdownParser (F Inlines)

1569+str :: MarkdownParser Inlines

1575str = do

1570str = do

1576 result <- many1 alphaNum

1571 result <- many1 alphaNum

1577 updateLastStrPos

1572 updateLastStrPos

@@ -1579,14 +1574,14 @@ str = do

1579 isSmart <- getOption readerSmart

1574 isSmart <- getOption readerSmart

1580 if isSmart

1575 if isSmart

1581 then case likelyAbbrev result of

1576 then case likelyAbbrev result of

1582− [] -> return $ return $ B.str result

1577+ [] -> return $ B.str result

1583 xs -> choice (map (\x ->

1578 xs -> choice (map (\x ->

1584 try (string x >> oneOf " \n" >>

1579 try (string x >> oneOf " \n" >>

1585 lookAhead alphaNum >>

1580 lookAhead alphaNum >>

1586− return (return $ B.str

1581+ return (B.str $

1587− $ result ++ spacesToNbr x ++ "\160"))) xs)

1582+ result ++ spacesToNbr x ++ "\160"))) xs)

1588− <|> (return $ return $ B.str result)

1583+ <|> (return $ B.str result)

1589− else return $ return $ B.str result

1584+ else return $ B.str result

1590

1585

1591-- | if the string matches the beginning of an abbreviation (before

1586-- | if the string matches the beginning of an abbreviation (before

1592-- the first period, return strings that would finish the abbreviation.

1587-- the first period, return strings that would finish the abbreviation.

@@ -1601,7 +1596,7 @@ likelyAbbrev x =

1601 in map snd $ filter (\(y,_) -> y == x) abbrPairs

1596 in map snd $ filter (\(y,_) -> y == x) abbrPairs

1602

1597

1603-- an endline character that can be treated as a space, not a structural break

1598-- an endline character that can be treated as a space, not a structural break

1604−endline :: MarkdownParser (F Inlines)

1599+endline :: MarkdownParser Inlines

1605endline = try $ do

1600endline = try $ do

1606 newline

1601 newline

1607 notFollowedBy blankline

1602 notFollowedBy blankline

@@ -1614,18 +1609,18 @@ endline = try $ do

1614 notFollowedBy (() <$ (lookAhead (char '`') >> codeBlockFenced))

1609 notFollowedBy (() <$ (lookAhead (char '`') >> codeBlockFenced))

1615 notFollowedByHtmlCloser

1610 notFollowedByHtmlCloser

1616 (eof >> return mempty)

1611 (eof >> return mempty)

1617− <|> (guardEnabled Ext_hard_line_breaks >> return (return B.linebreak))

1612+ <|> (guardEnabled Ext_hard_line_breaks >> return B.linebreak)

1618 <|> (guardEnabled Ext_ignore_line_breaks >> return mempty)

1613 <|> (guardEnabled Ext_ignore_line_breaks >> return mempty)

1619− <|> (return $ return B.space)

1614+ <|> return B.space

1620

1615

1621--

1616--

1622-- links

1617-- links

1623--

1618--

1624

1619

1625-- a reference label for a link

1620-- a reference label for a link

1626−reference :: MarkdownParser (F Inlines, String)

1621+reference :: MarkdownParser (Inlines, String)

1627reference = do notFollowedBy' (string "[^") -- footnote reference

1622reference = do notFollowedBy' (string "[^") -- footnote reference

1628− withRaw $ trimInlinesF <$> inlinesInBalancedBrackets

1623+ withRaw $ trimInlines <$> inlinesInBalancedBrackets

1629

1624

1630parenthesizedChars :: MarkdownParser [Char]

1625parenthesizedChars :: MarkdownParser [Char]

1631parenthesizedChars = do

1626parenthesizedChars = do

@@ -1653,7 +1648,7 @@ source = do

1653linkTitle :: MarkdownParser String

1648linkTitle :: MarkdownParser String

1654linkTitle = quotedTitle '"' <|> quotedTitle '\''

1649linkTitle = quotedTitle '"' <|> quotedTitle '\''

1655

1650

1656−link :: MarkdownParser (F Inlines)

1651+link :: MarkdownParser Inlines

1657link = try $ do

1652link = try $ do

1658 st <- getState

1653 st <- getState

1659 guard $ stateAllowLinks st

1654 guard $ stateAllowLinks st

@@ -1663,14 +1658,14 @@ link = try $ do

1663 regLink B.link lab <|> referenceLink B.link (lab,raw)

1658 regLink B.link lab <|> referenceLink B.link (lab,raw)

1664

1659

1665regLink :: (String -> String -> Inlines -> Inlines)

1660regLink :: (String -> String -> Inlines -> Inlines)

1666− -> F Inlines -> MarkdownParser (F Inlines)

1661+ -> Inlines -> MarkdownParser Inlines

1667regLink constructor lab = try $ do

1662regLink constructor lab = try $ do

1668 (src, tit) <- source

1663 (src, tit) <- source

1669− return $ constructor src tit <$> lab

1664+ return $ constructor src tit lab

1670

1665

1671-- a link like [this][ref] or [this][] or [this]

1666-- a link like [this][ref] or [this][] or [this]

1672referenceLink :: (String -> String -> Inlines -> Inlines)

1667referenceLink :: (String -> String -> Inlines -> Inlines)

1673− -> (F Inlines, String) -> MarkdownParser (F Inlines)

1668+ -> (Inlines, String) -> MarkdownParser Inlines

1674referenceLink constructor (lab, raw) = do

1669referenceLink constructor (lab, raw) = do

1675 sp <- (True <$ lookAhead (char ' ')) <|> return False

1670 sp <- (True <$ lookAhead (char ' ')) <|> return False

1676 (ref,raw') <- option (mempty, "") $

1671 (ref,raw') <- option (mempty, "") $

@@ -1684,24 +1679,22 @@ referenceLink constructor (lab, raw) = do

1684 fallback <- parseFromString (mconcat <$> many inline) $ dropBrackets raw

1679 fallback <- parseFromString (mconcat <$> many inline) $ dropBrackets raw

1685 implicitHeaderRefs <- option False $

1680 implicitHeaderRefs <- option False $

1686 True <$ guardEnabled Ext_implicit_header_references

1681 True <$ guardEnabled Ext_implicit_header_references

1687− let makeFallback = do

1682+ let makeFallback =

1688− parsedRaw' <- parsedRaw

1689− fallback' <- fallback

1690− return $ B.str "[" <> fallback' <> B.str "]" <>

1683+ B.str "[" <> fallback <> B.str "]" <>

1691 (if sp && not (null raw) then B.space else mempty) <>

1684 (if sp && not (null raw) then B.space else mempty) <>

1692− parsedRaw'

1685+ parsedRaw

1693− return $ do

1694− keys <- asksF stateKeys

1686+ keys <- asks stateKeys

1687+ headers <- asks stateHeaders

1688+ return $

1695− case M.lookup key keys of

1689+ case M.lookup key keys of

1696− Nothing -> do

1690+ Nothing ->

1697− headers <- asksF stateHeaders

1698− ref' <- if labIsRef then lab else ref

1691+ let ref' = if labIsRef then lab else ref in

1699− if implicitHeaderRefs

1692+ if implicitHeaderRefs

1700− then case M.lookup ref' headers of

1693+ then case M.lookup ref' headers of

1701− Just ident -> constructor ('#':ident) "" <$> lab

1694+ Just ident -> constructor ('#':ident) "" lab

1702− Nothing -> makeFallback

1695+ Nothing -> makeFallback

1703− else makeFallback

1696+ else makeFallback

1704− Just (src,tit) -> constructor src tit <$> lab

1697+ Just (src,tit) -> constructor src tit lab

1705

1698

1706dropBrackets :: String -> String

1699dropBrackets :: String -> String

1707dropBrackets = reverse . dropRB . reverse . dropLB

1700dropBrackets = reverse . dropRB . reverse . dropLB

@@ -1710,14 +1703,14 @@ dropBrackets = reverse . dropRB . reverse . dropLB

1710 dropLB ('[':xs) = xs

1703 dropLB ('[':xs) = xs

1711 dropLB xs = xs

1704 dropLB xs = xs

1712

1705

1713−bareURL :: MarkdownParser (F Inlines)

1706+bareURL :: MarkdownParser Inlines

1714bareURL = try $ do

1707bareURL = try $ do

1715 guardEnabled Ext_autolink_bare_uris

1708 guardEnabled Ext_autolink_bare_uris

1716 (orig, src) <- uri <|> emailAddress

1709 (orig, src) <- uri <|> emailAddress

1717 notFollowedBy $ try $ spaces >> htmlTag (~== TagClose "a")

1710 notFollowedBy $ try $ spaces >> htmlTag (~== TagClose "a")

1718− return $ return $ B.link src "" (B.str orig)

1711+ return $ B.link src "" (B.str orig)

1719

1712

1720−autoLink :: MarkdownParser (F Inlines)

1713+autoLink :: MarkdownParser Inlines

1721autoLink = try $ do

1714autoLink = try $ do

1722 char '<'

1715 char '<'

1723 (orig, src) <- uri <|> emailAddress

1716 (orig, src) <- uri <|> emailAddress

@@ -1726,9 +1719,9 @@ autoLink = try $ do

1726 -- final punctuation. for example: in `<http://hi---there>`,

1719 -- final punctuation. for example: in `<http://hi---there>`,

1727 -- the URI parser will stop before the dashes.

1720 -- the URI parser will stop before the dashes.

1728 extra <- fromEntities <$> manyTill nonspaceChar (char '>')

1721 extra <- fromEntities <$> manyTill nonspaceChar (char '>')

1729− return $ return $ B.link (src ++ escapeURI extra) "" (B.str $ orig ++ extra)

1722+ return $ B.link (src ++ escapeURI extra) "" (B.str $ orig ++ extra)

1730

1723

1731−image :: MarkdownParser (F Inlines)

1724+image :: MarkdownParser Inlines

1732image = try $ do

1725image = try $ do

1733 char '!'

1726 char '!'

1734 (lab,raw) <- reference

1727 (lab,raw) <- reference

@@ -1738,38 +1731,33 @@ image = try $ do

1738 _ -> B.image src

1731 _ -> B.image src

1739 regLink constructor lab <|> referenceLink constructor (lab,raw)

1732 regLink constructor lab <|> referenceLink constructor (lab,raw)

1740

1733

1741−note :: MarkdownParser (F Inlines)

1734+note :: MarkdownParser Inlines

1742note = try $ do

1735note = try $ do

1743 guardEnabled Ext_footnotes

1736 guardEnabled Ext_footnotes

1737+ (stateInFootnote <$> getState) >>= guard . not

1744 ref <- noteMarker

1738 ref <- noteMarker

1745− return $ do

1746− notes <- asksF stateNotes'

1739+ notes <- asks stateNotes'

1740+ return $

1747 case lookup ref notes of

1741 case lookup ref notes of

1748− Nothing -> return $ B.str $ "[^" ++ ref ++ "]"

1742+ Nothing -> B.str $ "[^" ++ ref ++ "]"

1749− Just contents -> do

1743+ Just contents -> B.note contents

1750− st <- askF

1744+

1751− -- process the note in a context that doesn't resolve

1752− -- notes, to avoid infinite looping with notes inside

1753− -- notes:

1754− let contents' = runF contents st{ stateNotes' = [] }

1755− return $ B.note contents'

1756−

1757−inlineNote :: MarkdownParser (F Inlines)

1745+inlineNote :: MarkdownParser Inlines

1758inlineNote = try $ do

1746inlineNote = try $ do

1759 guardEnabled Ext_inline_notes

1747 guardEnabled Ext_inline_notes

1760 char '^'

1748 char '^'

1761 contents <- inlinesInBalancedBrackets

1749 contents <- inlinesInBalancedBrackets

1762− return $ B.note . B.para <$> contents

1750+ return . B.note . B.para $ contents

1763

1751

1764−rawLaTeXInline' :: MarkdownParser (F Inlines)

1752+rawLaTeXInline' :: MarkdownParser Inlines

1765rawLaTeXInline' = try $ do

1753rawLaTeXInline' = try $ do

1766 guardEnabled Ext_raw_tex

1754 guardEnabled Ext_raw_tex

1767 lookAhead $ char '\\' >> notFollowedBy' (string "start") -- context env

1755 lookAhead $ char '\\' >> notFollowedBy' (string "start") -- context env

1768− RawInline _ s <- rawLaTeXInline

1756+ RawInline _ s <- generalize rawLaTeXInline

1769− return $ return $ B.rawInline "tex" s

1757+ return $ B.rawInline "tex" s

1770 -- "tex" because it might be context or latex

1758 -- "tex" because it might be context or latex

1771

1759

1772−rawConTeXtEnvironment :: Parser [Char] st String

1760+rawConTeXtEnvironment :: Monad m => ParserT [Char] st m String

1773rawConTeXtEnvironment = try $ do

1761rawConTeXtEnvironment = try $ do

1774 string "\\start"

1762 string "\\start"

1775 completion <- inBrackets (letter <|> digit <|> spaceChar)

1763 completion <- inBrackets (letter <|> digit <|> spaceChar)

@@ -1778,14 +1766,14 @@ rawConTeXtEnvironment = try $ do

1778 (try $ string "\\stop" >> string completion)

1766 (try $ string "\\stop" >> string completion)

1779 return $ "\\start" ++ completion ++ concat contents ++ "\\stop" ++ completion

1767 return $ "\\start" ++ completion ++ concat contents ++ "\\stop" ++ completion

1780

1768

1781−inBrackets :: (Parser [Char] st Char) -> Parser [Char] st String

1769+inBrackets :: Monad m => (ParserT [Char] st m Char) -> ParserT [Char] st m String

1782inBrackets parser = do

1770inBrackets parser = do

1783 char '['

1771 char '['

1784 contents <- many parser

1772 contents <- many parser

1785 char ']'

1773 char ']'

1786 return $ "[" ++ contents ++ "]"

1774 return $ "[" ++ contents ++ "]"

1787

1775

1788−spanHtml :: MarkdownParser (F Inlines)

1776+spanHtml :: MarkdownParser Inlines

1789spanHtml = try $ do

1777spanHtml = try $ do

1790 guardEnabled Ext_native_spans

1778 guardEnabled Ext_native_spans

1791 (TagOpen _ attrs, _) <- htmlTag (~== TagOpen "span" [])

1779 (TagOpen _ attrs, _) <- htmlTag (~== TagOpen "span" [])

@@ -1797,10 +1785,10 @@ spanHtml = try $ do

1797 Just s | null ident && null classes &&

1785 Just s | null ident && null classes &&

1798 map toLower (filter (`notElem` " \t;") s) ==

1786 map toLower (filter (`notElem` " \t;") s) ==

1799 "font-variant:small-caps"

1787 "font-variant:small-caps"

1800− -> return $ B.smallcaps <$> contents

1788+ -> return $ B.smallcaps contents

1801− _ -> return $ B.spanWith (ident, classes, keyvals) <$> contents

1789+ _ -> return $ B.spanWith (ident, classes, keyvals) contents

1802

1790

1803−divHtml :: MarkdownParser (F Blocks)

1791+divHtml :: MarkdownParser Blocks

1804divHtml = try $ do

1792divHtml = try $ do

1805 guardEnabled Ext_native_divs

1793 guardEnabled Ext_native_divs

1806 (TagOpen _ attrs, rawtag) <- htmlTag (~== TagOpen "div" [])

1794 (TagOpen _ attrs, rawtag) <- htmlTag (~== TagOpen "div" [])

@@ -1818,11 +1806,11 @@ divHtml = try $ do

1818 let ident = fromMaybe "" $ lookup "id" attrs

1806 let ident = fromMaybe "" $ lookup "id" attrs

1819 let classes = maybe [] words $ lookup "class" attrs

1807 let classes = maybe [] words $ lookup "class" attrs

1820 let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]

1808 let keyvals = [(k,v) | (k,v) <- attrs, k /= "id" && k /= "class"]

1821− return $ B.divWith (ident, classes, keyvals) <$> contents

1809+ return $ B.divWith (ident, classes, keyvals) contents

1822 else -- avoid backtracing

1810 else -- avoid backtracing

1823− return $ return (B.rawBlock "html" (rawtag <> bls)) <> contents

1811+ return $ B.rawBlock "html" (rawtag <> bls) <> contents

1824

1812

1825−rawHtmlInline :: MarkdownParser (F Inlines)

1813+rawHtmlInline :: MarkdownParser Inlines

1826rawHtmlInline = do

1814rawHtmlInline = do

1827 guardEnabled Ext_raw_html

1815 guardEnabled Ext_raw_html

1828 inHtmlBlock <- stateInHtmlBlock <$> getState

1816 inHtmlBlock <- stateInHtmlBlock <$> getState

@@ -1837,19 +1825,17 @@ rawHtmlInline = do

1837 then (\x -> isInlineTag x &&

1825 then (\x -> isInlineTag x &&

1838 not (isCloseBlockTag x))

1826 not (isCloseBlockTag x))

1839 else not . isTextTag

1827 else not . isTextTag

1840− return $ return $ B.rawInline "html" result

1828+ return $ B.rawInline "html" result

1841

1829

1842-- Citations

1830-- Citations

1843

1831

1844−cite :: MarkdownParser (F Inlines)

1832+cite :: MarkdownParser Inlines

1845cite = do

1833cite = do

1846 guardEnabled Ext_citations

1834 guardEnabled Ext_citations

1847− citations <- textualCite

1848− <|> do (cs, raw) <- withRaw normalCite

1835+ textualCite <|> do (cs, raw) <- withRaw normalCite

1849− return $ (flip B.cite (B.text raw)) <$> cs

1836+ return $ B.cite cs (B.text raw)

1850− return citations

1851

1837

1852−textualCite :: MarkdownParser (F Inlines)

1838+textualCite :: MarkdownParser Inlines

1853textualCite = try $ do

1839textualCite = try $ do

1854 (_, key) <- citeKey

1840 (_, key) <- citeKey

1855 let first = Citation{ citationId = key

1841 let first = Citation{ citationId = key

@@ -1863,29 +1849,26 @@ textualCite = try $ do

1863 case mbrest of

1849 case mbrest of

1864 Just (rest, raw) ->

1850 Just (rest, raw) ->

1865 return $ (flip B.cite (B.text $ '@':key ++ " " ++ raw) . (first:))

1851 return $ (flip B.cite (B.text $ '@':key ++ " " ++ raw) . (first:))

1866− <$> rest

1852+ rest

1867 Nothing ->

1853 Nothing ->

1868 (do (cs, raw) <- withRaw $ bareloc first

1854 (do (cs, raw) <- withRaw $ bareloc first

1869− return $ (flip B.cite (B.text $ '@':key ++ " " ++ raw)) <$> cs)

1855+ return $ B.cite cs (B.text $ '@':key ++ " " ++ raw))

1870− <|> return (do st <- askF

1856+ <|> do st <- ask

1871− return $ case M.lookup key (stateExamples st) of

1857+ return $ case M.lookup key (stateExamples st) of

1872− Just n -> B.str (show n)

1858+ Just n -> B.str (show n)

1873− _ -> B.cite [first] $ B.str $ '@':key)

1859+ _ -> B.cite [first] $ B.str $ '@':key

1874

1860

1875−bareloc :: Citation -> MarkdownParser (F [Citation])

1861+bareloc :: Citation -> MarkdownParser [Citation]

1876bareloc c = try $ do

1862bareloc c = try $ do

1877 spnl

1863 spnl

1878 char '['

1864 char '['

1879 suff <- suffix

1865 suff <- suffix

1880− rest <- option (return []) $ try $ char ';' >> citeList

1866+ rest <- option [] $ try $ char ';' >> citeList

1881 spnl

1867 spnl

1882 char ']'

1868 char ']'

1883− return $ do

1884− suff' <- suff

1885− rest' <- rest

1886− return $ c{ citationSuffix = B.toList suff' } : rest'

1869+ return $ c{ citationSuffix = B.toList suff } : rest

1887

1870

1888−normalCite :: MarkdownParser (F [Citation])

1871+normalCite :: MarkdownParser [Citation]

1889normalCite = try $ do

1872normalCite = try $ do

1890 char '['

1873 char '['

1891 spnl

1874 spnl

@@ -1894,60 +1877,57 @@ normalCite = try $ do

1894 char ']'

1877 char ']'

1895 return citations

1878 return citations

1896

1879

1897−suffix :: MarkdownParser (F Inlines)

1880+suffix :: MarkdownParser Inlines

1898suffix = try $ do

1881suffix = try $ do

1899 hasSpace <- option False (notFollowedBy nonspaceChar >> return True)

1882 hasSpace <- option False (notFollowedBy nonspaceChar >> return True)

1900 spnl

1883 spnl

1901− rest <- trimInlinesF . mconcat <$> many (notFollowedBy (oneOf ";]") >> inline)

1884+ rest <- trimInlines . mconcat <$> many (notFollowedBy (oneOf ";]") >> inline)

1902 return $ if hasSpace

1885 return $ if hasSpace

1903− then (B.space <>) <$> rest

1886+ then B.space <> rest

1904 else rest

1887 else rest

1905

1888

1906−prefix :: MarkdownParser (F Inlines)

1889+prefix :: MarkdownParser Inlines

1907−prefix = trimInlinesF . mconcat <$>

1890+prefix = trimInlines . mconcat <$>

1908 manyTill inline (char ']' <|> liftM (const ']') (lookAhead citeKey))

1891 manyTill inline (char ']' <|> liftM (const ']') (lookAhead citeKey))

1909

1892

1910−citeList :: MarkdownParser (F [Citation])

1893+citeList :: MarkdownParser [Citation]

1911−citeList = fmap sequence $ sepBy1 citation (try $ char ';' >> spnl)

1894+citeList = sepBy1 citation (try $ char ';' >> spnl)

1912

1895

1913−citation :: MarkdownParser (F Citation)

1896+citation :: MarkdownParser Citation

1914citation = try $ do

1897citation = try $ do

1915 pref <- prefix

1898 pref <- prefix

1916 (suppress_author, key) <- citeKey

1899 (suppress_author, key) <- citeKey

1917 suff <- suffix

1900 suff <- suffix

1918− return $ do

1919− x <- pref

1920− y <- suff

1921− return $ Citation{ citationId = key

1901+ return Citation{ citationId = key

1922− , citationPrefix = B.toList x

1902+ , citationPrefix = B.toList pref

1923− , citationSuffix = B.toList y

1903+ , citationSuffix = B.toList suff

1924− , citationMode = if suppress_author

1904+ , citationMode = if suppress_author

1925− then SuppressAuthor

1905+ then SuppressAuthor

1926− else NormalCitation

1906+ else NormalCitation

1927− , citationNoteNum = 0

1907+ , citationNoteNum = 0

1928− , citationHash = 0

1908+ , citationHash = 0

1929− }

1909+ }

1930−

1910+

1931−smart :: MarkdownParser (F Inlines)

1911+smart :: MarkdownParser Inlines

1932smart = do

1912smart = do

1933 getOption readerSmart >>= guard

1913 getOption readerSmart >>= guard

1934 doubleQuoted <|> singleQuoted <|>

1914 doubleQuoted <|> singleQuoted <|>

1935− choice (map (return <$>) [apostrophe, dash, ellipses])

1915+ choice [apostrophe, dash, ellipses]

1936

1916

1937−singleQuoted :: MarkdownParser (F Inlines)

1917+singleQuoted :: MarkdownParser Inlines

1938singleQuoted = try $ do

1918singleQuoted = try $ do

1939 singleQuoteStart

1919 singleQuoteStart

1940 withQuoteContext InSingleQuote $

1920 withQuoteContext InSingleQuote $

1941− fmap B.singleQuoted . trimInlinesF . mconcat <$>

1921+ B.singleQuoted . trimInlines . mconcat <$>

1942 many1Till inline singleQuoteEnd

1922 many1Till inline singleQuoteEnd

1943

1923

1944-- doubleQuoted will handle regular double-quoted sections, as well

1924-- doubleQuoted will handle regular double-quoted sections, as well

1945-- as dialogues with an open double-quote without a close double-quote

1925-- as dialogues with an open double-quote without a close double-quote

1946-- in the same paragraph.

1926-- in the same paragraph.

1947−doubleQuoted :: MarkdownParser (F Inlines)

1927+doubleQuoted :: MarkdownParser Inlines

1948doubleQuoted = try $ do

1928doubleQuoted = try $ do

1949 doubleQuoteStart

1929 doubleQuoteStart

1950 contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)

1930 contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)

1951− (withQuoteContext InDoubleQuote $ doubleQuoteEnd >> return

1931+ (withQuoteContext InDoubleQuote doubleQuoteEnd >> return

1952− (fmap B.doubleQuoted . trimInlinesF $ contents))

1932+ (B.doubleQuoted . trimInlines $ contents))

1953− <|> (return $ return (B.str "\8220") <> contents)

1933+ <|> return (B.str "\8220" <> contents)

src/Text/Pandoc/Readers/Org.hs+221−241

@@ -1,6 +1,9 @@

1{-# LANGUAGE OverloadedStrings #-}

2{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3−{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-}

3+{-# LANGUAGE FlexibleContexts #-}

4+{-# LANGUAGE ScopedTypeVariables #-}

5+{-# LANGUAGE FlexibleInstances #-}

6+{-# LANGUAGE MultiParamTypeClasses #-}

4{-

7{-

@@ -36,8 +39,7 @@ import Text.Pandoc.Builder ( Inlines, Blocks, HasMeta(..), (<>)

36import Text.Pandoc.Definition

39import Text.Pandoc.Definition

37import Text.Pandoc.Options

40import Text.Pandoc.Options

38import qualified Text.Pandoc.Parsing as P

41import qualified Text.Pandoc.Parsing as P

39−import Text.Pandoc.Parsing hiding ( F, unF, askF, asksF, runF

40− , newline, orderedListMarker

42+import Text.Pandoc.Parsing hiding ( newline, orderedListMarker

41 , parseFromString, blanklines

43 , parseFromString, blanklines

42 )

44 )

43import Text.Pandoc.Readers.LaTeX (inlineCommand, rawLaTeXInline)

45import Text.Pandoc.Readers.LaTeX (inlineCommand, rawLaTeXInline)

@@ -45,36 +47,45 @@ import Text.Pandoc.Shared (compactify', compactify'DL)

45import Text.TeXMath (readTeX, writePandoc, DisplayType(..))

47import Text.TeXMath (readTeX, writePandoc, DisplayType(..))

46import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap

48import qualified Text.TeXMath.Readers.MathML.EntityMap as MathMLEntityMap

48−import Control.Applicative ( Applicative, pure

50+import Control.Applicative ( pure

49 , (<$>), (<$), (<*>), (<*), (*>) )

51 , (<$>), (<$), (<*>), (<*), (*>) )

50import Control.Arrow (first)

52import Control.Arrow (first)

51−import Control.Monad (foldM, guard, liftM, liftM2, mplus, mzero, when)

53+import Control.Monad (guard, mplus, mzero, when)

52−import Control.Monad.Reader (Reader, runReader, ask, asks, local)

54+import Control.Monad.Reader (Reader, runReader, asks, local)

53import Data.Char (isAlphaNum, toLower)

55import Data.Char (isAlphaNum, toLower)

54import Data.Default

56import Data.Default

55−import Data.List (intersperse, isPrefixOf, isSuffixOf)

57+import Data.List (intersperse, isPrefixOf, isSuffixOf, foldl')

56import qualified Data.Map as M

58import qualified Data.Map as M

57import Data.Maybe (fromMaybe, isJust)

59import Data.Maybe (fromMaybe, isJust)

58−import Data.Monoid (Monoid, mconcat, mempty, mappend)

60+import Data.Monoid (mconcat, mempty, mappend)

59import Network.HTTP (urlEncode)

61import Network.HTTP (urlEncode)

61-- | Parse org-mode string and return a Pandoc document.

63-- | Parse org-mode string and return a Pandoc document.

62readOrg :: ReaderOptions -- ^ Reader options

64readOrg :: ReaderOptions -- ^ Reader options

63 -> String -- ^ String to parse (assuming @'\n'@ line endings)

65 -> String -- ^ String to parse (assuming @'\n'@ line endings)

64 -> Pandoc

66 -> Pandoc

65−readOrg opts s = flip runReader def $ readWithM parseOrg def{ orgStateOptions = opts } (s ++ "\n\n")

67+readOrg opts s = runOrg opts s parseOrg

67−data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext }

69+data OrgParserLocal = OrgParserLocal { orgLocalQuoteContext :: QuoteContext

70+ , finalState :: OrgParserState }

69type OrgParser = ParserT [Char] OrgParserState (Reader OrgParserLocal)

72type OrgParser = ParserT [Char] OrgParserState (Reader OrgParserLocal)

74+runOrg :: ReaderOptions -> String -> OrgParser a -> a

75+runOrg opts inp p = fst res

76+ where

77+ imd = readWithM (returnState p) def{ orgStateOptions = opts } (inp ++ "\n\n")

78+ res = runReader imd def { finalState = s }

79+ s :: OrgParserState

80+ s = snd $ runReader imd (def { finalState = s })

81+

71parseOrg :: OrgParser Pandoc

82parseOrg :: OrgParser Pandoc

72parseOrg = do

83parseOrg = do

73 blocks' <- parseBlocks

84 blocks' <- parseBlocks

74 st <- getState

85 st <- getState

75− let meta = runF (orgStateMeta' st) st

86+ let meta = orgStateMeta st

76 let removeUnwantedBlocks = dropCommentTrees . filter (/= Null)

87 let removeUnwantedBlocks = dropCommentTrees . filter (/= Null)

77− return $ Pandoc meta $ removeUnwantedBlocks (B.toList $ runF blocks' st)

88+ return $ Pandoc meta $ removeUnwantedBlocks (B.toList $ blocks')

79-- | Drop COMMENT headers and the document tree below those headers.

90-- | Drop COMMENT headers and the document tree below those headers.

80dropCommentTrees :: [Block] -> [Block]

91dropCommentTrees :: [Block] -> [Block]

@@ -104,7 +115,7 @@ isHeaderLevelLowerEq n blk =

104-- Parser State for Org

115-- Parser State for Org

105--

116--

106

117

107−type OrgNoteRecord = (String, F Blocks)

118+type OrgNoteRecord = (String, Blocks)

108type OrgNoteTable = [OrgNoteRecord]

119type OrgNoteTable = [OrgNoteRecord]

109

120

110type OrgBlockAttributes = M.Map String String

121type OrgBlockAttributes = M.Map String String

@@ -123,12 +134,11 @@ data OrgParserState = OrgParserState

123 , orgStateLastStrPos :: Maybe SourcePos

134 , orgStateLastStrPos :: Maybe SourcePos

124 , orgStateLinkFormatters :: OrgLinkFormatters

135 , orgStateLinkFormatters :: OrgLinkFormatters

125 , orgStateMeta :: Meta

136 , orgStateMeta :: Meta

126− , orgStateMeta' :: F Meta

127 , orgStateNotes' :: OrgNoteTable

137 , orgStateNotes' :: OrgNoteTable

128 }

138 }

129

139

130instance Default OrgParserLocal where

140instance Default OrgParserLocal where

131− def = OrgParserLocal NoQuote

141+ def = OrgParserLocal NoQuote def

132

142

133instance HasReaderOptions OrgParserState where

143instance HasReaderOptions OrgParserState where

134 extractReaderOptions = orgStateOptions

144 extractReaderOptions = orgStateOptions

@@ -162,13 +172,13 @@ defaultOrgParserState = OrgParserState

162 , orgStateLastStrPos = Nothing

172 , orgStateLastStrPos = Nothing

163 , orgStateLinkFormatters = M.empty

173 , orgStateLinkFormatters = M.empty

164 , orgStateMeta = nullMeta

174 , orgStateMeta = nullMeta

165− , orgStateMeta' = return nullMeta

166 , orgStateNotes' = []

175 , orgStateNotes' = []

167 }

176 }

168

177

169recordAnchorId :: String -> OrgParser ()

178recordAnchorId :: String -> OrgParser ()

170recordAnchorId i = updateState $ \s ->

179recordAnchorId i = updateState $ \s ->

180+ let as = orgStateAnchorIds s in

171− s{ orgStateAnchorIds = i : (orgStateAnchorIds s) }

181+ s{ orgStateAnchorIds = i : as }

172

182

173addBlockAttribute :: String -> String -> OrgParser ()

183addBlockAttribute :: String -> String -> OrgParser ()

174addBlockAttribute key val = updateState $ \s ->

184addBlockAttribute key val = updateState $ \s ->

@@ -247,30 +257,6 @@ parseFromString parser str' = do

247-- Adaptions and specializations of parsing utilities

257-- Adaptions and specializations of parsing utilities

248--

258--

249

259

250−newtype F a = F { unF :: Reader OrgParserState a

251− } deriving (Monad, Applicative, Functor)

252−

253−runF :: F a -> OrgParserState -> a

254−runF = runReader . unF

255−

256−askF :: F OrgParserState

257−askF = F ask

258−

259−asksF :: (OrgParserState -> a) -> F a

260−asksF f = F $ asks f

261−

262−instance Monoid a => Monoid (F a) where

263− mempty = return mempty

264− mappend = liftM2 mappend

265− mconcat = fmap mconcat . sequence

266−

267−trimInlinesF :: F Inlines -> F Inlines

268−trimInlinesF = liftM trimInlines

269−

270−returnF :: a -> OrgParser (F a)

271−returnF = return . return

272−

273−

274-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.

260-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.

275newline :: OrgParser Char

261newline :: OrgParser Char

276newline =

262newline =

@@ -289,10 +275,10 @@ blanklines =

289-- parsing blocks

275-- parsing blocks

290--

276--

291

277

292−parseBlocks :: OrgParser (F Blocks)

278+parseBlocks :: OrgParser Blocks

293parseBlocks = mconcat <$> manyTill block eof

279parseBlocks = mconcat <$> manyTill block eof

294

280

295−block :: OrgParser (F Blocks)

281+block :: OrgParser Blocks

296block = choice [ mempty <$ blanklines

282block = choice [ mempty <$ blanklines

297 , optionalAttributes $ choice

283 , optionalAttributes $ choice

298 [ orgBlock

284 [ orgBlock

@@ -303,14 +289,14 @@ block = choice [ mempty <$ blanklines

303 , drawer

289 , drawer

304 , specialLine

290 , specialLine

305 , header

291 , header

306− , return <$> hline

292+ , hline

307 , list

293 , list

308 , latexFragment

294 , latexFragment

309 , noteBlock

295 , noteBlock

310 , paraOrPlain

296 , paraOrPlain

311 ] <?> "block"

297 ] <?> "block"

312

298

313−optionalAttributes :: OrgParser (F Blocks) -> OrgParser (F Blocks)

299+optionalAttributes :: OrgParser Blocks -> OrgParser Blocks

314optionalAttributes parser = try $

300optionalAttributes parser = try $

315 resetBlockAttributes *> parseBlockAttributes *> parser

301 resetBlockAttributes *> parseBlockAttributes *> parser

316

302

@@ -330,7 +316,7 @@ parseAndAddAttribute key value = do

330 let key' = map toLower key

316 let key' = map toLower key

331 () <$ addBlockAttribute key' value

317 () <$ addBlockAttribute key' value

332

318

333−lookupInlinesAttr :: String -> OrgParser (Maybe (F Inlines))

319+lookupInlinesAttr :: String -> OrgParser (Maybe Inlines)

334lookupInlinesAttr attr = try $ do

320lookupInlinesAttr attr = try $ do

335 val <- lookupBlockAttribute attr

321 val <- lookupBlockAttribute attr

336 maybe (return Nothing)

322 maybe (return Nothing)

@@ -344,20 +330,20 @@ lookupInlinesAttr attr = try $ do

344

330

345type BlockProperties = (Int, String) -- (Indentation, Block-Type)

331type BlockProperties = (Int, String) -- (Indentation, Block-Type)

346

332

347−orgBlock :: OrgParser (F Blocks)

333+orgBlock :: OrgParser Blocks

348orgBlock = try $ do

334orgBlock = try $ do

349 blockProp@(_, blkType) <- blockHeaderStart

335 blockProp@(_, blkType) <- blockHeaderStart

350 ($ blockProp) $

336 ($ blockProp) $

351 case blkType of

337 case blkType of

352 "comment" -> withRaw' (const mempty)

338 "comment" -> withRaw' (const mempty)

353− "html" -> withRaw' (return . (B.rawBlock blkType))

339+ "html" -> withRaw' (B.rawBlock blkType)

354− "latex" -> withRaw' (return . (B.rawBlock blkType))

340+ "latex" -> withRaw' (B.rawBlock blkType)

355− "ascii" -> withRaw' (return . (B.rawBlock blkType))

341+ "ascii" -> withRaw' (B.rawBlock blkType)

356− "example" -> withRaw' (return . exampleCode)

342+ "example" -> withRaw' exampleCode

357− "quote" -> withParsed (fmap B.blockQuote)

343+ "quote" -> withParsed B.blockQuote

358 "verse" -> verseBlock

344 "verse" -> verseBlock

359 "src" -> codeBlock

345 "src" -> codeBlock

360− _ -> withParsed (fmap $ divWithClass blkType)

346+ _ -> withParsed (divWithClass blkType)

361

347

362blockHeaderStart :: OrgParser (Int, String)

348blockHeaderStart :: OrgParser (Int, String)

363blockHeaderStart = try $ (,) <$> indent <*> blockType

349blockHeaderStart = try $ (,) <$> indent <*> blockType

@@ -365,10 +351,10 @@ blockHeaderStart = try $ (,) <$> indent <*> blockType

365 indent = length <$> many spaceChar

351 indent = length <$> many spaceChar

366 blockType = map toLower <$> (stringAnyCase "#+begin_" *> orgArgWord)

352 blockType = map toLower <$> (stringAnyCase "#+begin_" *> orgArgWord)

367

353

368−withRaw' :: (String -> F Blocks) -> BlockProperties -> OrgParser (F Blocks)

354+withRaw' :: (String -> Blocks) -> BlockProperties -> OrgParser Blocks

369withRaw' f blockProp = (ignHeaders *> (f <$> rawBlockContent blockProp))

355withRaw' f blockProp = (ignHeaders *> (f <$> rawBlockContent blockProp))

370

356

371−withParsed :: (F Blocks -> F Blocks) -> BlockProperties -> OrgParser (F Blocks)

357+withParsed :: (Blocks -> Blocks) -> BlockProperties -> OrgParser Blocks

372withParsed f blockProp = (ignHeaders *> (f <$> parsedBlockContent blockProp))

358withParsed f blockProp = (ignHeaders *> (f <$> parsedBlockContent blockProp))

373

359

374ignHeaders :: OrgParser ()

360ignHeaders :: OrgParser ()

@@ -377,11 +363,11 @@ ignHeaders = (() <$ newline) <|> (() <$ anyLine)

377divWithClass :: String -> Blocks -> Blocks

363divWithClass :: String -> Blocks -> Blocks

378divWithClass cls = B.divWith ("", [cls], [])

364divWithClass cls = B.divWith ("", [cls], [])

379

365

380−verseBlock :: BlockProperties -> OrgParser (F Blocks)

366+verseBlock :: BlockProperties -> OrgParser Blocks

381verseBlock blkProp = try $ do

367verseBlock blkProp = try $ do

382 ignHeaders

368 ignHeaders

383 content <- rawBlockContent blkProp

369 content <- rawBlockContent blkProp

384− fmap B.para . mconcat . intersperse (pure B.linebreak)

370+ B.para . mconcat . intersperse B.linebreak

385 <$> mapM (parseFromString parseInlines) (lines content)

371 <$> mapM (parseFromString parseInlines) (lines content)

386

372

387exportsCode :: [(String, String)] -> Bool

373exportsCode :: [(String, String)] -> Bool

@@ -398,7 +384,7 @@ followingResultsBlock =

398 *> blankline

384 *> blankline

399 *> (unlines <$> many1 exampleLine))

385 *> (unlines <$> many1 exampleLine))

400

386

401−codeBlock :: BlockProperties -> OrgParser (F Blocks)

387+codeBlock :: BlockProperties -> OrgParser Blocks

402codeBlock blkProp = do

388codeBlock blkProp = do

403 skipSpaces

389 skipSpaces

404 (classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders)

390 (classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders)

@@ -408,17 +394,15 @@ codeBlock blkProp = do

408 let includeCode = exportsCode kv

394 let includeCode = exportsCode kv

409 let includeResults = exportsResults kv

395 let includeResults = exportsResults kv

410 let codeBlck = B.codeBlockWith ( id', classes, kv ) content

396 let codeBlck = B.codeBlockWith ( id', classes, kv ) content

411− labelledBlck <- maybe (pure codeBlck)

397+ labelledBlck <- maybe codeBlck (labelDiv codeBlck)

412− (labelDiv codeBlck)

413 <$> lookupInlinesAttr "caption"

398 <$> lookupInlinesAttr "caption"

414− let resultBlck = pure $ maybe mempty (exampleCode) resultsContent

399+ let resultBlck = maybe mempty exampleCode resultsContent

415 return $ (if includeCode then labelledBlck else mempty)

400 return $ (if includeCode then labelledBlck else mempty)

416 <> (if includeResults then resultBlck else mempty)

401 <> (if includeResults then resultBlck else mempty)

417 where

402 where

418 labelDiv blk value =

403 labelDiv blk value =

419− B.divWith nullAttr <$> (mappend <$> labelledBlock value

404+ B.divWith nullAttr (labelledBlock value <> blk)

420− <*> pure blk)

421− labelledBlock = fmap (B.plain . B.spanWith ("", ["label"], []))

405+ labelledBlock = B.plain . B.spanWith ("", ["label"], [])

422

406

423rawBlockContent :: BlockProperties -> OrgParser String

407rawBlockContent :: BlockProperties -> OrgParser String

424rawBlockContent (indent, blockType) = try $

408rawBlockContent (indent, blockType) = try $

@@ -427,7 +411,7 @@ rawBlockContent (indent, blockType) = try $

427 indentedLine = try $ ("" <$ blankline) <|> (indentWith indent *> anyLine)

411 indentedLine = try $ ("" <$ blankline) <|> (indentWith indent *> anyLine)

428 blockEnder = try $ indentWith indent *> stringAnyCase ("#+end_" <> blockType)

412 blockEnder = try $ indentWith indent *> stringAnyCase ("#+end_" <> blockType)

429

413

430−parsedBlockContent :: BlockProperties -> OrgParser (F Blocks)

414+parsedBlockContent :: BlockProperties -> OrgParser Blocks

431parsedBlockContent blkProps = try $ do

415parsedBlockContent blkProps = try $ do

432 raw <- rawBlockContent blkProps

416 raw <- rawBlockContent blkProps

433 parseFromString parseBlocks (raw ++ "\n")

417 parseFromString parseBlocks (raw ++ "\n")

@@ -518,9 +502,9 @@ commaEscaped (',':cs@('*':_)) = cs

518commaEscaped (',':cs@('#':'+':_)) = cs

502commaEscaped (',':cs@('#':'+':_)) = cs

519commaEscaped cs = cs

503commaEscaped cs = cs

520

504

521−example :: OrgParser (F Blocks)

505+example :: OrgParser Blocks

522example = try $ do

506example = try $ do

523− return . return . exampleCode =<< unlines <$> many1 exampleLine

507+ return . exampleCode =<< unlines <$> many1 exampleLine

524

508

525exampleCode :: String -> Blocks

509exampleCode :: String -> Blocks

526exampleCode = B.codeBlockWith ("", ["example"], [])

510exampleCode = B.codeBlockWith ("", ["example"], [])

@@ -529,7 +513,7 @@ exampleLine :: OrgParser String

529exampleLine = try $ skipSpaces *> string ": " *> anyLine

513exampleLine = try $ skipSpaces *> string ": " *> anyLine

530

514

531-- Drawers for properties or a logbook

515-- Drawers for properties or a logbook

532−drawer :: OrgParser (F Blocks)

516+drawer :: OrgParser Blocks

533drawer = try $ do

517drawer = try $ do

534 drawerStart

518 drawerStart

535 manyTill drawerLine (try drawerEnd)

519 manyTill drawerLine (try drawerEnd)

@@ -555,14 +539,12 @@ drawerEnd = try $

555--

539--

556

540

557-- Figures (Image on a line by itself, preceded by name and/or caption)

541-- Figures (Image on a line by itself, preceded by name and/or caption)

558−figure :: OrgParser (F Blocks)

542+figure :: OrgParser Blocks

559figure = try $ do

543figure = try $ do

560 (cap, nam) <- nameAndCaption

544 (cap, nam) <- nameAndCaption

561 src <- skipSpaces *> selfTarget <* skipSpaces <* P.newline

545 src <- skipSpaces *> selfTarget <* skipSpaces <* P.newline

562 guard (isImageFilename src)

546 guard (isImageFilename src)

563− return $ do

564− cap' <- cap

565− return $ B.para $ B.image src nam cap'

547+ return $ B.para $ B.image src nam cap

566 where

548 where

567 nameAndCaption =

549 nameAndCaption =

568 do

550 do

@@ -578,8 +560,8 @@ figure = try $ do

578

560

579--

561--

580-- Comments, Options and Metadata

562-- Comments, Options and Metadata

581−specialLine :: OrgParser (F Blocks)

563+specialLine :: OrgParser Blocks

582−specialLine = fmap return . try $ metaLine <|> commentLine

564+specialLine = try $ metaLine <|> commentLine

583

565

584metaLine :: OrgParser Blocks

566metaLine :: OrgParser Blocks

585metaLine = try $ mempty

567metaLine = try $ mempty

@@ -599,14 +581,14 @@ commentLineStart = try $ mappend <$> many spaceChar <*> string "# "

599declarationLine :: OrgParser ()

581declarationLine :: OrgParser ()

600declarationLine = try $ do

582declarationLine = try $ do

601 key <- metaKey

583 key <- metaKey

602− inlinesF <- metaInlines

584+ inlines <- metaInlines

603 updateState $ \st ->

585 updateState $ \st ->

604− let meta' = B.setMeta <$> pure key <*> inlinesF <*> pure nullMeta

586+ let meta' = B.setMeta key inlines nullMeta

605− in st { orgStateMeta' = orgStateMeta' st <> meta' }

587+ in st { orgStateMeta = orgStateMeta st <> meta' }

606 return ()

588 return ()

607

589

608−metaInlines :: OrgParser (F MetaValue)

590+metaInlines :: OrgParser MetaValue

609−metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline

591+metaInlines = (MetaInlines . B.toList) <$> inlinesTillNewline

610

592

611metaKey :: OrgParser String

593metaKey :: OrgParser String

612metaKey = map toLower <$> many1 (noneOf ": \n\r")

594metaKey = map toLower <$> many1 (noneOf ": \n\r")

@@ -647,11 +629,11 @@ parseFormat = try $ do

647--

629--

648

630

649-- | Headers

631-- | Headers

650−header :: OrgParser (F Blocks)

632+header :: OrgParser Blocks

651header = try $ do

633header = try $ do

652 level <- headerStart

634 level <- headerStart

653 title <- inlinesTillNewline

635 title <- inlinesTillNewline

654− return $ B.header level <$> title

636+ return $ B.header level title

655

637

656headerStart :: OrgParser Int

638headerStart :: OrgParser Int

657headerStart = try $

639headerStart = try $

@@ -675,7 +657,7 @@ hline = try $ do

675-- Tables

657-- Tables

676--

658--

677

659

678−data OrgTableRow = OrgContentRow (F [Blocks])

660+data OrgTableRow = OrgContentRow [Blocks]

679 | OrgAlignRow [Alignment]

661 | OrgAlignRow [Alignment]

680 | OrgHlineRow

662 | OrgHlineRow

681

663

@@ -686,13 +668,13 @@ data OrgTable = OrgTable

686 , orgTableRows :: [[Blocks]]

668 , orgTableRows :: [[Blocks]]

687 }

669 }

688

670

689−table :: OrgParser (F Blocks)

671+table :: OrgParser Blocks

690table = try $ do

672table = try $ do

691 lookAhead tableStart

673 lookAhead tableStart

692 do

674 do

693 rows <- tableRows

675 rows <- tableRows

694− cptn <- fromMaybe (pure "") <$> lookupInlinesAttr "caption"

676+ (cptn :: Inlines) <- fromMaybe "" <$> lookupInlinesAttr "caption"

695− return $ (<$> cptn) . orgToPandocTable . normalizeTable =<< rowsToTable rows

677+ return $ ($ cptn) . orgToPandocTable . normalizeTable . rowsToTable $ rows

696

678

697orgToPandocTable :: OrgTable

679orgToPandocTable :: OrgTable

698 -> Inlines

680 -> Inlines

@@ -708,11 +690,11 @@ tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)

708

690

709tableContentRow :: OrgParser OrgTableRow

691tableContentRow :: OrgParser OrgTableRow

710tableContentRow = try $

692tableContentRow = try $

711− OrgContentRow . sequence <$> (tableStart *> manyTill tableContentCell newline)

693+ OrgContentRow <$> (tableStart *> manyTill tableContentCell newline)

712

694

713−tableContentCell :: OrgParser (F Blocks)

695+tableContentCell :: OrgParser Blocks

714tableContentCell = try $

696tableContentCell = try $

715− fmap B.plain . trimInlinesF . mconcat <$> many1Till inline endOfCell

697+ B.plain . trimInlines . mconcat <$> many1Till inline endOfCell

716

698

717endOfCell :: OrgParser Char

699endOfCell :: OrgParser Char

718endOfCell = try $ char '|' <|> lookAhead newline

700endOfCell = try $ char '|' <|> lookAhead newline

@@ -744,8 +726,8 @@ tableHline = try $

744 OrgHlineRow <$ (tableStart *> char '-' *> anyLine)

726 OrgHlineRow <$ (tableStart *> char '-' *> anyLine)

745

727

746rowsToTable :: [OrgTableRow]

728rowsToTable :: [OrgTableRow]

747− -> F OrgTable

729+ -> OrgTable

748−rowsToTable = foldM (flip rowToContent) zeroTable

730+rowsToTable = foldl' (flip rowToContent) zeroTable

749 where zeroTable = OrgTable 0 mempty mempty mempty

731 where zeroTable = OrgTable 0 mempty mempty mempty

750

732

751normalizeTable :: OrgTable

733normalizeTable :: OrgTable

@@ -764,45 +746,43 @@ normalizeTable (OrgTable cols aligns heads lns) =

764-- line as a header. All other horizontal lines are discarded.

746-- line as a header. All other horizontal lines are discarded.

765rowToContent :: OrgTableRow

747rowToContent :: OrgTableRow

766 -> OrgTable

748 -> OrgTable

767− -> F OrgTable

749+ -> OrgTable

768rowToContent OrgHlineRow t = maybeBodyToHeader t

750rowToContent OrgHlineRow t = maybeBodyToHeader t

769−rowToContent (OrgAlignRow as) t = setLongestRow as =<< setAligns as t

751+rowToContent (OrgAlignRow as) t = setLongestRow as . setAligns as $ t

770−rowToContent (OrgContentRow rf) t = do

752+rowToContent (OrgContentRow rf) t = setLongestRow rf . appendToBody rf $ t

771− rs <- rf

772− setLongestRow rs =<< appendToBody rs t

773

753

774setLongestRow :: [a]

754setLongestRow :: [a]

775 -> OrgTable

755 -> OrgTable

776− -> F OrgTable

756+ -> OrgTable

777setLongestRow rs t =

757setLongestRow rs t =

778− return t{ orgTableColumns = max (length rs) (orgTableColumns t) }

758+ t{ orgTableColumns = max (length rs) (orgTableColumns t) }

779

759

780maybeBodyToHeader :: OrgTable

760maybeBodyToHeader :: OrgTable

781− -> F OrgTable

761+ -> OrgTable

782maybeBodyToHeader t = case t of

762maybeBodyToHeader t = case t of

783 OrgTable{ orgTableHeader = [], orgTableRows = b:[] } ->

763 OrgTable{ orgTableHeader = [], orgTableRows = b:[] } ->

784− return t{ orgTableHeader = b , orgTableRows = [] }

764+ t{ orgTableHeader = b , orgTableRows = [] }

785− _ -> return t

765+ _ -> t

786

766

787appendToBody :: [Blocks]

767appendToBody :: [Blocks]

788 -> OrgTable

768 -> OrgTable

789− -> F OrgTable

769+ -> OrgTable

790−appendToBody r t = return t{ orgTableRows = orgTableRows t ++ [r] }

770+appendToBody r t = t{ orgTableRows = orgTableRows t ++ [r] }

791

771

792setAligns :: [Alignment]

772setAligns :: [Alignment]

793 -> OrgTable

773 -> OrgTable

794− -> F OrgTable

774+ -> OrgTable

795−setAligns aligns t = return $ t{ orgTableAlignments = aligns }

775+setAligns aligns t = t{ orgTableAlignments = aligns }

796

776

797

777

798--

778--

799-- LaTeX fragments

779-- LaTeX fragments

800--

780--

801−latexFragment :: OrgParser (F Blocks)

781+latexFragment :: OrgParser Blocks

802latexFragment = try $ do

782latexFragment = try $ do

803 envName <- latexEnvStart

783 envName <- latexEnvStart

804 content <- mconcat <$> manyTill anyLineNewline (latexEnd envName)

784 content <- mconcat <$> manyTill anyLineNewline (latexEnd envName)

805− return . return $ B.rawBlock "latex" (content `inLatexEnv` envName)

785+ return $ B.rawBlock "latex" (content `inLatexEnv` envName)

806 where

786 where

807 c `inLatexEnv` e = mconcat [ "\\begin{", e, "}\n"

787 c `inLatexEnv` e = mconcat [ "\\begin{", e, "}\n"

808 , c

788 , c

@@ -832,7 +812,7 @@ latexEnvName = try $ do

832--

812--

833-- Footnote defintions

813-- Footnote defintions

834--

814--

835−noteBlock :: OrgParser (F Blocks)

815+noteBlock :: OrgParser Blocks

836noteBlock = try $ do

816noteBlock = try $ do

837 ref <- noteMarker <* skipSpaces

817 ref <- noteMarker <* skipSpaces

838 content <- mconcat <$> blocksTillHeaderOrNote

818 content <- mconcat <$> blocksTillHeaderOrNote

@@ -844,37 +824,37 @@ noteBlock = try $ do

844 <|> () <$ lookAhead headerStart)

824 <|> () <$ lookAhead headerStart)

845

825

846-- Paragraphs or Plain text

826-- Paragraphs or Plain text

847−paraOrPlain :: OrgParser (F Blocks)

827+paraOrPlain :: OrgParser Blocks

848paraOrPlain = try $ do

828paraOrPlain = try $ do

849 ils <- parseInlines

829 ils <- parseInlines

850 nl <- option False (newline >> return True)

830 nl <- option False (newline >> return True)

851 try (guard nl >> notFollowedBy (orderedListStart <|> bulletListStart) >>

831 try (guard nl >> notFollowedBy (orderedListStart <|> bulletListStart) >>

852− return (B.para <$> ils))

832+ (return $ B.para ils))

853− <|> (return (B.plain <$> ils))

833+ <|> (return $ B.plain ils)

854

834

855−inlinesTillNewline :: OrgParser (F Inlines)

835+inlinesTillNewline :: OrgParser Inlines

856−inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline

836+inlinesTillNewline = trimInlines . mconcat <$> manyTill inline newline

857

837

858

838

859--

839--

860-- list blocks

840-- list blocks

861--

841--

862

842

863−list :: OrgParser (F Blocks)

843+list :: OrgParser Blocks

864list = choice [ definitionList, bulletList, orderedList ] <?> "list"

844list = choice [ definitionList, bulletList, orderedList ] <?> "list"

865

845

866−definitionList :: OrgParser (F Blocks)

846+definitionList :: OrgParser Blocks

867definitionList = try $ do n <- lookAhead (bulletListStart' Nothing)

847definitionList = try $ do n <- lookAhead (bulletListStart' Nothing)

868− fmap B.definitionList . fmap compactify'DL . sequence

848+ B.definitionList . compactify'DL

869 <$> many1 (definitionListItem $ bulletListStart' (Just n))

849 <$> many1 (definitionListItem $ bulletListStart' (Just n))

870

850

871−bulletList :: OrgParser (F Blocks)

851+bulletList :: OrgParser Blocks

872bulletList = try $ do n <- lookAhead (bulletListStart' Nothing)

852bulletList = try $ do n <- lookAhead (bulletListStart' Nothing)

873− fmap B.bulletList . fmap compactify' . sequence

853+ B.bulletList . compactify'

874 <$> many1 (listItem (bulletListStart' $ Just n))

854 <$> many1 (listItem (bulletListStart' $ Just n))

875

855

876−orderedList :: OrgParser (F Blocks)

856+orderedList :: OrgParser Blocks

877−orderedList = fmap B.orderedList . fmap compactify' . sequence

857+orderedList = B.orderedList . compactify'

878 <$> many1 (listItem orderedListStart)

858 <$> many1 (listItem orderedListStart)

879

859

880genericListStart :: OrgParser String

860genericListStart :: OrgParser String

@@ -911,7 +891,7 @@ orderedListStart = genericListStart orderedListMarker

911 where orderedListMarker = mappend <$> many1 digit <*> (pure <$> oneOf ".)")

891 where orderedListMarker = mappend <$> many1 digit <*> (pure <$> oneOf ".)")

912

892

913definitionListItem :: OrgParser Int

893definitionListItem :: OrgParser Int

914− -> OrgParser (F (Inlines, [Blocks]))

894+ -> OrgParser (Inlines, [Blocks])

915definitionListItem parseMarkerGetLength = try $ do

895definitionListItem parseMarkerGetLength = try $ do

916 markerLength <- parseMarkerGetLength

896 markerLength <- parseMarkerGetLength

917 term <- manyTill (noneOf "\n\r") (try $ string "::")

897 term <- manyTill (noneOf "\n\r") (try $ string "::")

@@ -920,12 +900,12 @@ definitionListItem parseMarkerGetLength = try $ do

920 cont <- concat <$> many (listContinuation markerLength)

900 cont <- concat <$> many (listContinuation markerLength)

921 term' <- parseFromString parseInlines term

901 term' <- parseFromString parseInlines term

922 contents' <- parseFromString parseBlocks $ line1 ++ blank ++ cont

902 contents' <- parseFromString parseBlocks $ line1 ++ blank ++ cont

923− return $ (,) <$> term' <*> fmap (:[]) contents'

903+ return (term', [contents'])

924

904

925

905

926-- parse raw text for one list item, excluding start marker and continuations

906-- parse raw text for one list item, excluding start marker and continuations

927listItem :: OrgParser Int

907listItem :: OrgParser Int

928− -> OrgParser (F Blocks)

908+ -> OrgParser Blocks

929listItem start = try $ do

909listItem start = try $ do

930 markerLength <- try start

910 markerLength <- try start

931 firstLine <- anyLineNewline

911 firstLine <- anyLineNewline

@@ -951,7 +931,7 @@ anyLineNewline = (++ "\n") <$> anyLine

951-- inline

931-- inline

952--

932--

953

933

954−inline :: OrgParser (F Inlines)

934+inline :: OrgParser Inlines

955inline =

935inline =

956 choice [ whitespace

936 choice [ whitespace

957 , linebreak

937 , linebreak

@@ -978,31 +958,31 @@ inline =

978 ] <* (guard =<< newlinesCountWithinLimits)

958 ] <* (guard =<< newlinesCountWithinLimits)

979 <?> "inline"

959 <?> "inline"

980

960

981−parseInlines :: OrgParser (F Inlines)

961+parseInlines :: OrgParser Inlines

982−parseInlines = trimInlinesF . mconcat <$> many1 inline

962+parseInlines = trimInlines . mconcat <$> many1 inline

983

963

984-- treat these as potentially non-text when parsing inline:

964-- treat these as potentially non-text when parsing inline:

985specialChars :: [Char]

965specialChars :: [Char]

986specialChars = "\"$'()*+-,./:<=>[\\]^_{|}~"

966specialChars = "\"$'()*+-,./:<=>[\\]^_{|}~"

987

967

988

968

989−whitespace :: OrgParser (F Inlines)

969+whitespace :: OrgParser Inlines

990−whitespace = pure B.space <$ skipMany1 spaceChar

970+whitespace = B.space <$ skipMany1 spaceChar

991 <* updateLastPreCharPos

971 <* updateLastPreCharPos

992 <* updateLastForbiddenCharPos

972 <* updateLastForbiddenCharPos

993 <?> "whitespace"

973 <?> "whitespace"

994

974

995−linebreak :: OrgParser (F Inlines)

975+linebreak :: OrgParser Inlines

996−linebreak = try $ pure B.linebreak <$ string "\\\\" <* skipSpaces <* newline

976+linebreak = try $ B.linebreak <$ string "\\\\" <* skipSpaces <* newline

997

977

998−str :: OrgParser (F Inlines)

978+str :: OrgParser Inlines

999−str = return . B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")

979+str = B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")

1000 <* updateLastStrPos

980 <* updateLastStrPos

1001

981

1002-- | An endline character that can be treated as a space, not a structural

982-- | An endline character that can be treated as a space, not a structural

1003-- break. This should reflect the values of the Emacs variable

983-- break. This should reflect the values of the Emacs variable

1004-- @org-element-pagaraph-separate@.

984-- @org-element-pagaraph-separate@.

1005−endline :: OrgParser (F Inlines)

985+endline :: OrgParser Inlines

1006endline = try $ do

986endline = try $ do

1007 newline

987 newline

1008 notFollowedBy blankline

988 notFollowedBy blankline

@@ -1020,77 +1000,72 @@ endline = try $ do

1020 decEmphasisNewlinesCount

1000 decEmphasisNewlinesCount

1021 guard =<< newlinesCountWithinLimits

1001 guard =<< newlinesCountWithinLimits

1022 updateLastPreCharPos

1002 updateLastPreCharPos

1023− return . return $ B.space

1003+ return $ B.space

1024

1004

1025−cite :: OrgParser (F Inlines)

1005+cite :: OrgParser Inlines

1026cite = try $ do

1006cite = try $ do

1027 guardEnabled Ext_citations

1007 guardEnabled Ext_citations

1028 (cs, raw) <- withRaw normalCite

1008 (cs, raw) <- withRaw normalCite

1029− return $ (flip B.cite (B.text raw)) <$> cs

1009+ return $ flip B.cite (B.text raw) cs

1030

1010

1031−normalCite :: OrgParser (F [Citation])

1011+normalCite :: OrgParser [Citation]

1032normalCite = try $ char '['

1012normalCite = try $ char '['

1033 *> skipSpaces

1013 *> skipSpaces

1034 *> citeList

1014 *> citeList

1035 <* skipSpaces

1015 <* skipSpaces

1036 <* char ']'

1016 <* char ']'

1037

1017

1038−citeList :: OrgParser (F [Citation])

1018+citeList :: OrgParser [Citation]

1039−citeList = sequence <$> sepBy1 citation (try $ char ';' *> skipSpaces)

1019+citeList = sepBy1 citation (try $ char ';' *> skipSpaces)

1040

1020

1041−citation :: OrgParser (F Citation)

1021+citation :: OrgParser Citation

1042citation = try $ do

1022citation = try $ do

1043 pref <- prefix

1023 pref <- prefix

1044 (suppress_author, key) <- citeKey

1024 (suppress_author, key) <- citeKey

1045 suff <- suffix

1025 suff <- suffix

1046− return $ do

1047− x <- pref

1048− y <- suff

1049− return $ Citation{ citationId = key

1026+ return $ Citation{ citationId = key

1050− , citationPrefix = B.toList x

1027+ , citationPrefix = B.toList pref

1051− , citationSuffix = B.toList y

1028+ , citationSuffix = B.toList suff

1052− , citationMode = if suppress_author

1029+ , citationMode = if suppress_author

1053− then SuppressAuthor

1030+ then SuppressAuthor

1054− else NormalCitation

1031+ else NormalCitation

1055− , citationNoteNum = 0

1032+ , citationNoteNum = 0

1056− , citationHash = 0

1033+ , citationHash = 0

1057− }

1034+ }

1058 where

1035 where

1059− prefix = trimInlinesF . mconcat <$>

1036+ prefix = trimInlines . mconcat <$>

1060 manyTill inline (char ']' <|> (']' <$ lookAhead citeKey))

1037 manyTill inline (char ']' <|> (']' <$ lookAhead citeKey))

1061 suffix = try $ do

1038 suffix = try $ do

1062 hasSpace <- option False (notFollowedBy nonspaceChar >> return True)

1039 hasSpace <- option False (notFollowedBy nonspaceChar >> return True)

1063 skipSpaces

1040 skipSpaces

1064− rest <- trimInlinesF . mconcat <$>

1041+ rest <- trimInlines . mconcat <$>

1065 many (notFollowedBy (oneOf ";]") *> inline)

1042 many (notFollowedBy (oneOf ";]") *> inline)

1043+ return $

1066− return $ if hasSpace

1044+ if hasSpace

1067− then (B.space <>) <$> rest

1045+ then B.space <> rest

1068− else rest

1046+ else rest

1069

1047

1070−footnote :: OrgParser (F Inlines)

1048+footnote :: OrgParser Inlines

1071footnote = try $ inlineNote <|> referencedNote

1049footnote = try $ inlineNote <|> referencedNote

1072

1050

1073−inlineNote :: OrgParser (F Inlines)

1051+inlineNote :: OrgParser Inlines

1074inlineNote = try $ do

1052inlineNote = try $ do

1075 string "[fn:"

1053 string "[fn:"

1076 ref <- many alphaNum

1054 ref <- many alphaNum

1077 char ':'

1055 char ':'

1078− note <- fmap B.para . trimInlinesF . mconcat <$> many1Till inline (char ']')

1056+ note <- B.para . trimInlines . mconcat <$> many1Till inline (char ']')

1079 when (not $ null ref) $

1057 when (not $ null ref) $

1080 addToNotesTable ("fn:" ++ ref, note)

1058 addToNotesTable ("fn:" ++ ref, note)

1081− return $ B.note <$> note

1059+ return $ B.note note

1082

1060

1083−referencedNote :: OrgParser (F Inlines)

1061+referencedNote :: OrgParser Inlines

1084referencedNote = try $ do

1062referencedNote = try $ do

1085 ref <- noteMarker

1063 ref <- noteMarker

1086− return $ do

1087− notes <- asksF orgStateNotes'

1064+ notes <- asks (orgStateNotes' . finalState)

1065+ return $

1088 case lookup ref notes of

1066 case lookup ref notes of

1067+ Just contents -> B.note contents

1089− Nothing -> return $ B.str $ "[" ++ ref ++ "]"

1068+ Nothing -> B.str $ "[" ++ ref ++ "]"

1090− Just contents -> do

1091− st <- askF

1092− let contents' = runF contents st{ orgStateNotes' = [] }

1093− return $ B.note contents'

1094

1069

1095noteMarker :: OrgParser String

1070noteMarker :: OrgParser String

1096noteMarker = try $ do

1071noteMarker = try $ do

@@ -1100,37 +1075,37 @@ noteMarker = try $ do

1100 <*> many1Till (noneOf "\n\r\t ") (char ']')

1075 <*> many1Till (noneOf "\n\r\t ") (char ']')

1101 ]

1076 ]

1102

1077

1103−linkOrImage :: OrgParser (F Inlines)

1078+linkOrImage :: OrgParser Inlines

1104linkOrImage = explicitOrImageLink

1079linkOrImage = explicitOrImageLink

1105 <|> selflinkOrImage

1080 <|> selflinkOrImage

1106 <|> angleLink

1081 <|> angleLink

1107 <|> plainLink

1082 <|> plainLink

1108 <?> "link or image"

1083 <?> "link or image"

1109

1084

1110−explicitOrImageLink :: OrgParser (F Inlines)

1085+explicitOrImageLink :: OrgParser Inlines

1111explicitOrImageLink = try $ do

1086explicitOrImageLink = try $ do

1112 char '['

1087 char '['

1113− srcF <- applyCustomLinkFormat =<< possiblyEmptyLinkTarget

1088+ src <- applyCustomLinkFormat =<< possiblyEmptyLinkTarget

1114 title <- enclosedRaw (char '[') (char ']')

1089 title <- enclosedRaw (char '[') (char ']')

1115 title' <- parseFromString (mconcat <$> many inline) title

1090 title' <- parseFromString (mconcat <$> many inline) title

1116 char ']'

1091 char ']'

1117− return $ do

1092+ alt <- internalLink src title'

1118− src <- srcF

1093+ return $

1119− if isImageFilename src && isImageFilename title

1094+ (if isImageFilename src && isImageFilename title

1120− then pure $ B.link src "" $ B.image title mempty mempty

1095+ then B.link src "" $ B.image title mempty mempty

1121− else linkToInlinesF src =<< title'

1096+ else fromMaybe alt (linkToInlines src title'))

1122

1097

1123−selflinkOrImage :: OrgParser (F Inlines)

1098+selflinkOrImage :: OrgParser Inlines

1124selflinkOrImage = try $ do

1099selflinkOrImage = try $ do

1125 src <- char '[' *> linkTarget <* char ']'

1100 src <- char '[' *> linkTarget <* char ']'

1126− return $ linkToInlinesF src (B.str src)

1101+ return $ fromMaybe "" (linkToInlines src (B.str src))

1127

1102

1128−plainLink :: OrgParser (F Inlines)

1103+plainLink :: OrgParser Inlines

1129plainLink = try $ do

1104plainLink = try $ do

1130 (orig, src) <- uri

1105 (orig, src) <- uri

1131− returnF $ B.link src "" (B.str orig)

1106+ return $ B.link src "" (B.str orig)

1132

1107

1133−angleLink :: OrgParser (F Inlines)

1108+angleLink :: OrgParser Inlines

1134angleLink = try $ do

1109angleLink = try $ do

1135 char '<'

1110 char '<'

1136 link <- plainLink

1111 link <- plainLink

@@ -1146,26 +1121,31 @@ linkTarget = enclosedByPair '[' ']' (noneOf "\n\r[]")

1146possiblyEmptyLinkTarget :: OrgParser String

1121possiblyEmptyLinkTarget :: OrgParser String

1147possiblyEmptyLinkTarget = try linkTarget <|> ("" <$ string "[]")

1122possiblyEmptyLinkTarget = try linkTarget <|> ("" <$ string "[]")

1148

1123

1149−applyCustomLinkFormat :: String -> OrgParser (F String)

1124+applyCustomLinkFormat :: String -> OrgParser String

1150applyCustomLinkFormat link = do

1125applyCustomLinkFormat link = do

1151 let (linkType, rest) = break (== ':') link

1126 let (linkType, rest) = break (== ':') link

1152− return $ do

1127+ fmts <- asks finalState

1128+ return $

1153− formatter <- M.lookup linkType <$> asksF orgStateLinkFormatters

1129+ case M.lookup linkType (orgStateLinkFormatters fmts) of

1154− return $ maybe link ($ drop 1 rest) formatter

1130+ Just v -> (v (drop 1 rest))

1131+ Nothing -> link

1155

1132

1156-- TODO: might be a lot smarter/cleaner to use parsec and ADTs for this kind

1133-- TODO: might be a lot smarter/cleaner to use parsec and ADTs for this kind

1157-- of parsing.

1134-- of parsing.

1158−linkToInlinesF :: String -> Inlines -> F Inlines

1135+linkToInlines :: String -> Inlines -> Maybe Inlines

1159−linkToInlinesF s =

1136+linkToInlines = \s ->

1160 case s of

1137 case s of

1161− "" -> pure . B.link "" ""

1138+ _ | null s -> Just . B.link "" ""

1162− ('#':_) -> pure . B.link s ""

1139+ _ | isAnchor s -> Just . B.link s ""

1163− _ | isImageFilename s -> const . pure $ B.image s "" ""

1140+ _ | isImageFilename s -> const . Just $ B.image s "" ""

1164− _ | isFileLink s -> pure . B.link (dropLinkType s) ""

1141+ _ | isFileLink s -> Just . B.link (dropLinkType s) ""

1165− _ | isUri s -> pure . B.link s ""

1142+ _ | isUri s -> Just . B.link s ""

1166− _ | isAbsoluteFilePath s -> pure . B.link ("file://" ++ s) ""

1143+ _ | isAbsoluteFilePath s -> Just . B.link ("file://" ++ s) ""

1167− _ | isRelativeFilePath s -> pure . B.link s ""

1144+ _ | isRelativeFilePath s -> Just . B.link s ""

1168− _ -> internalLink s

1145+ _ -> const Nothing

1146+

1147+isAnchor :: String -> Bool

1148+isAnchor s = "#" `isPrefixOf` s

1169

1149

1170isFileLink :: String -> Bool

1150isFileLink :: String -> Bool

1171isFileLink s = ("file:" `isPrefixOf` s) && not ("file://" `isPrefixOf` s)

1151isFileLink s = ("file:" `isPrefixOf` s) && not ("file://" `isPrefixOf` s)

@@ -1194,12 +1174,13 @@ isImageFilename filename =

1194 imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]

1174 imageExtensions = [ "jpeg" , "jpg" , "png" , "gif" , "svg" ]

1195 protocols = [ "file", "http", "https" ]

1175 protocols = [ "file", "http", "https" ]

1196

1176

1197−internalLink :: String -> Inlines -> F Inlines

1177+internalLink :: String -> Inlines -> OrgParser Inlines

1198internalLink link title = do

1178internalLink link title = do

1179+ anchorB <- asks finalState

1180+ return $

1199− anchorB <- (link `elem`) <$> asksF orgStateAnchorIds

1181+ if link `elem` (orgStateAnchorIds anchorB)

1200− if anchorB

1201− then return $ B.link ('#':link) "" title

1182+ then B.link ('#':link) "" title

1202− else return $ B.emph title

1183+ else B.emph title

1203

1184

1204-- | Parse an anchor like @<<anchor-id>>@ and return an empty span with

1185-- | Parse an anchor like @<<anchor-id>>@ and return an empty span with

1205-- @anchor-id@ set as id. Legal anchors in org-mode are defined through

1186-- @anchor-id@ set as id. Legal anchors in org-mode are defined through

@@ -1207,11 +1188,11 @@ internalLink link title = do

1207-- @anchor-id@ contains spaces, we are more restrictive in what is accepted as

1188-- @anchor-id@ contains spaces, we are more restrictive in what is accepted as

1208-- an anchor.

1189-- an anchor.

1209

1190

1210−anchor :: OrgParser (F Inlines)

1191+anchor :: OrgParser Inlines

1211anchor = try $ do

1192anchor = try $ do

1212 anchorId <- parseAnchor

1193 anchorId <- parseAnchor

1213 recordAnchorId anchorId

1194 recordAnchorId anchorId

1214− returnF $ B.spanWith (solidify anchorId, [], []) mempty

1195+ return $ B.spanWith (solidify anchorId, [], []) mempty

1215 where

1196 where

1216 parseAnchor = string "<<"

1197 parseAnchor = string "<<"

1217 *> many1 (noneOf "\t\n\r<>\"' ")

1198 *> many1 (noneOf "\t\n\r<>\"' ")

@@ -1229,7 +1210,7 @@ solidify = map replaceSpecialChar

1229 | otherwise = '-'

1210 | otherwise = '-'

1230

1211

1231-- | Parses an inline code block and marks it as an babel block.

1212-- | Parses an inline code block and marks it as an babel block.

1232−inlineCodeBlock :: OrgParser (F Inlines)

1213+inlineCodeBlock :: OrgParser Inlines

1233inlineCodeBlock = try $ do

1214inlineCodeBlock = try $ do

1234 string "src_"

1215 string "src_"

1235 lang <- many1 orgArgWordChar

1216 lang <- many1 orgArgWordChar

@@ -1237,7 +1218,7 @@ inlineCodeBlock = try $ do

1237 inlineCode <- enclosedByPair '{' '}' (noneOf "\n\r")

1218 inlineCode <- enclosedByPair '{' '}' (noneOf "\n\r")

1238 let attrClasses = [translateLang lang, rundocBlockClass]

1219 let attrClasses = [translateLang lang, rundocBlockClass]

1239 let attrKeyVal = map toRundocAttrib (("language", lang) : opts)

1220 let attrKeyVal = map toRundocAttrib (("language", lang) : opts)

1240− returnF $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode

1221+ return $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode

1241

1222

1242enclosedByPair :: Char -- ^ opening char

1223enclosedByPair :: Char -- ^ opening char

1243 -> Char -- ^ closing char

1224 -> Char -- ^ closing char

@@ -1245,41 +1226,40 @@ enclosedByPair :: Char -- ^ opening char

1245 -> OrgParser [a]

1226 -> OrgParser [a]

1246enclosedByPair s e p = char s *> many1Till p (char e)

1227enclosedByPair s e p = char s *> many1Till p (char e)

1247

1228

1248−emph :: OrgParser (F Inlines)

1229+emph :: OrgParser Inlines

1249−emph = fmap B.emph <$> emphasisBetween '/'

1230+emph = B.emph <$> emphasisBetween '/'

1250

1231

1251−strong :: OrgParser (F Inlines)

1232+strong :: OrgParser Inlines

1252−strong = fmap B.strong <$> emphasisBetween '*'

1233+strong = B.strong <$> emphasisBetween '*'

1253

1234

1254−strikeout :: OrgParser (F Inlines)

1235+strikeout :: OrgParser Inlines

1255−strikeout = fmap B.strikeout <$> emphasisBetween '+'

1236+strikeout = B.strikeout <$> emphasisBetween '+'

1256

1237

1257-- There is no underline, so we use strong instead.

1238-- There is no underline, so we use strong instead.

1258−underline :: OrgParser (F Inlines)

1239+underline :: OrgParser Inlines

1259−underline = fmap B.strong <$> emphasisBetween '_'

1240+underline = B.strong <$> emphasisBetween '_'

1260

1241

1261−verbatim :: OrgParser (F Inlines)

1242+verbatim :: OrgParser Inlines

1262−verbatim = return . B.code <$> verbatimBetween '='

1243+verbatim = B.code <$> verbatimBetween '='

1263

1244

1264−code :: OrgParser (F Inlines)

1245+code :: OrgParser Inlines

1265−code = return . B.code <$> verbatimBetween '~'

1246+code = B.code <$> verbatimBetween '~'

1266

1247

1267−subscript :: OrgParser (F Inlines)

1248+subscript :: OrgParser Inlines

1268−subscript = fmap B.subscript <$> try (char '_' *> subOrSuperExpr)

1249+subscript = B.subscript <$> try (char '_' *> subOrSuperExpr)

1269

1250

1270−superscript :: OrgParser (F Inlines)

1251+superscript :: OrgParser Inlines

1271−superscript = fmap B.superscript <$> try (char '^' *> subOrSuperExpr)

1252+superscript = B.superscript <$> try (char '^' *> subOrSuperExpr)

1272

1253

1273−math :: OrgParser (F Inlines)

1254+math :: OrgParser Inlines

1274−math = return . B.math <$> choice [ math1CharBetween '$'

1255+math = B.math <$> choice [ math1CharBetween '$'

1275 , mathStringBetween '$'

1256 , mathStringBetween '$'

1276 , rawMathBetween "\$" "\$"

1257 , rawMathBetween "\$" "\$"

1277 ]

1258 ]

1278

1259

1279−displayMath :: OrgParser (F Inlines)

1260+displayMath :: OrgParser Inlines

1280−displayMath = return . B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"

1261+displayMath = B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"

1281− , rawMathBetween "$$" "$$"

1262+ , rawMathBetween "$$" "$$" ]

1282− ]

1283

1263

1284updatePositions :: Char

1264updatePositions :: Char

1285 -> OrgParser (Char)

1265 -> OrgParser (Char)

@@ -1288,11 +1268,11 @@ updatePositions c = do

1288 when (c `elem` emphasisForbiddenBorderChars) updateLastForbiddenCharPos

1268 when (c `elem` emphasisForbiddenBorderChars) updateLastForbiddenCharPos

1289 return c

1269 return c

1290

1270

1291−symbol :: OrgParser (F Inlines)

1271+symbol :: OrgParser Inlines

1292−symbol = return . B.str . (: "") <$> (oneOf specialChars >>= updatePositions)

1272+symbol = B.str . (: "") <$> (oneOf specialChars >>= updatePositions)

1293

1273

1294emphasisBetween :: Char

1274emphasisBetween :: Char

1295− -> OrgParser (F Inlines)

1275+ -> OrgParser Inlines

1296emphasisBetween c = try $ do

1276emphasisBetween c = try $ do

1297 startEmphasisNewlinesCounting emphasisAllowedNewlines

1277 startEmphasisNewlinesCounting emphasisAllowedNewlines

1298 res <- enclosedInlines (emphasisStart c) (emphasisEnd c)

1278 res <- enclosedInlines (emphasisStart c) (emphasisEnd c)

@@ -1369,9 +1349,9 @@ mathEnd c = try $ do

1369

1349

1370enclosedInlines :: OrgParser a

1350enclosedInlines :: OrgParser a

1371 -> OrgParser b

1351 -> OrgParser b

1372− -> OrgParser (F Inlines)

1352+ -> OrgParser Inlines

1373enclosedInlines start end = try $

1353enclosedInlines start end = try $

1374− trimInlinesF . mconcat <$> enclosed start end inline

1354+ trimInlines . mconcat <$> enclosed start end inline

1375

1355

1376enclosedRaw :: OrgParser a

1356enclosedRaw :: OrgParser a

1377 -> OrgParser b

1357 -> OrgParser b

@@ -1450,7 +1430,7 @@ notAfterForbiddenBorderChar = do

1450 return $ lastFBCPos /= Just pos

1430 return $ lastFBCPos /= Just pos

1451

1431

1452-- | Read a sub- or superscript expression

1432-- | Read a sub- or superscript expression

1453−subOrSuperExpr :: OrgParser (F Inlines)

1433+subOrSuperExpr :: OrgParser Inlines

1454subOrSuperExpr = try $

1434subOrSuperExpr = try $

1455 choice [ id <$> charsInBalanced '{' '}' (noneOf "\n\r")

1435 choice [ id <$> charsInBalanced '{' '}' (noneOf "\n\r")

1456 , enclosing ('(', ')') <$> charsInBalanced '(' ')' (noneOf "\n\r")

1436 , enclosing ('(', ')') <$> charsInBalanced '(' ')' (noneOf "\n\r")

@@ -1465,10 +1445,10 @@ simpleSubOrSuperString = try $

1465 <*> many1 alphaNum

1445 <*> many1 alphaNum

1466 ]

1446 ]

1467

1447

1468−inlineLaTeX :: OrgParser (F Inlines)

1448+inlineLaTeX :: OrgParser Inlines

1469inlineLaTeX = try $ do

1449inlineLaTeX = try $ do

1470 cmd <- inlineLaTeXCommand

1450 cmd <- inlineLaTeXCommand

1471− maybe mzero returnF $

1451+ maybe mzero return $

1472 parseAsMath cmd `mplus` parseAsMathMLSym cmd `mplus` parseAsInlineLaTeX cmd

1452 parseAsMath cmd `mplus` parseAsMathMLSym cmd `mplus` parseAsInlineLaTeX cmd

1473 where

1453 where

1474 parseAsMath :: String -> Maybe Inlines

1454 parseAsMath :: String -> Maybe Inlines

@@ -1501,30 +1481,30 @@ inlineLaTeXCommand = try $ do

1501 return cs

1481 return cs

1502 _ -> mzero

1482 _ -> mzero

1503

1483

1504−smart :: OrgParser (F Inlines)

1484+smart :: OrgParser Inlines

1505smart = do

1485smart = do

1506 getOption readerSmart >>= guard

1486 getOption readerSmart >>= guard

1507 doubleQuoted <|> singleQuoted <|>

1487 doubleQuoted <|> singleQuoted <|>

1508− choice (map (return <$>) [orgApostrophe, dash, ellipses])

1488+ choice [orgApostrophe, dash, ellipses]

1509 where orgApostrophe =

1489 where orgApostrophe =

1510 (char '\'' <|> char '\8217') <* updateLastPreCharPos

1490 (char '\'' <|> char '\8217') <* updateLastPreCharPos

1511 <* updateLastForbiddenCharPos

1491 <* updateLastForbiddenCharPos

1512 *> return (B.str "\x2019")

1492 *> return (B.str "\x2019")

1513

1493

1514−singleQuoted :: OrgParser (F Inlines)

1494+singleQuoted :: OrgParser Inlines

1515singleQuoted = try $ do

1495singleQuoted = try $ do

1516 singleQuoteStart

1496 singleQuoteStart

1517 withQuoteContext InSingleQuote $

1497 withQuoteContext InSingleQuote $

1518− fmap B.singleQuoted . trimInlinesF . mconcat <$>

1498+ B.singleQuoted . trimInlines . mconcat <$>

1519 many1Till inline singleQuoteEnd

1499 many1Till inline singleQuoteEnd

1520

1500

1521-- doubleQuoted will handle regular double-quoted sections, as well

1501-- doubleQuoted will handle regular double-quoted sections, as well

1522-- as dialogues with an open double-quote without a close double-quote

1502-- as dialogues with an open double-quote without a close double-quote

1523-- in the same paragraph.

1503-- in the same paragraph.

1524−doubleQuoted :: OrgParser (F Inlines)

1504+doubleQuoted :: OrgParser Inlines

1525doubleQuoted = try $ do

1505doubleQuoted = try $ do

1526 doubleQuoteStart

1506 doubleQuoteStart

1527 contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)

1507 contents <- mconcat <$> many (try $ notFollowedBy doubleQuoteEnd >> inline)

1528 (withQuoteContext InDoubleQuote $ (doubleQuoteEnd <* updateLastForbiddenCharPos) >> return

1508 (withQuoteContext InDoubleQuote $ (doubleQuoteEnd <* updateLastForbiddenCharPos) >> return

1529− (fmap B.doubleQuoted . trimInlinesF $ contents))

1509+ (B.doubleQuoted . trimInlines $ contents))

1530− <|> (return $ return (B.str "\8220") <> contents)

1510+ <|> (return $ (B.str "\8220") <> contents)

src/Text/Pandoc/Readers/RST.hs+1−1

@@ -58,7 +58,7 @@ readRST :: ReaderOptions -- ^ Reader options

58readRST opts s = (readWith parseRST) def{ stateOptions = opts } (s ++ "\n\n")

60readRSTWithWarnings :: ReaderOptions -> String -> (Pandoc, [String])

61−readRSTWithWarnings opts s = (readWithWarnings parseRST) def{ stateOptions = opts } (s ++ "\n\n")

61+readRSTWithWarnings opts s = (readWith (returnWarnings parseRST)) def{ stateOptions = opts } (s ++ "\n\n")

63type RSTParser = Parser [Char] ParserState