b53ebcd · typeable/pandoc

git.iko.soy/typeable/pandoc

Working on readers.

commitb53ebcdf8e8e1f7098a0c93ead4b5bf99971c77f authorJesse Rosenthal <jrosenthal@jhu.edu> dateMon 28 Nov 2016, 17:13 (10 years ago) parent840439a

26 files changed+1328−1157

compare with master

unifiedsplit

src/Text/Pandoc.hs+49−46

@@ -69,7 +69,6 @@ module Text.Pandoc

6969 , writers

7070 -- * Readers: converting /to/ Pandoc format

7171 , Reader (..)

72− , mkStringReader

7372 , readDocx

7473 , readOdt

7574 , readMarkdown

@@ -183,7 +182,7 @@ import Text.Pandoc.Options

183182import Text.Pandoc.Shared (safeRead, warn, mapLeft, pandocVersion)

184183import Text.Pandoc.MediaBag (MediaBag)

185184import Text.Pandoc.Error

186−import Text.Pandoc.Class (PandocMonad, runIOorExplode)

185+import Text.Pandoc.Class (PandocMonad, runIOorExplode, PandocExecutionError(..))

187186import Data.Aeson

188187import qualified Data.ByteString.Lazy as BL

189188import Data.List (intercalate)

@@ -192,6 +191,7 @@ import qualified Data.Set as Set

192191import Text.Parsec

193192import Text.Parsec.Error

194193import qualified Text.Pandoc.UTF8 as UTF8

194+import Control.Monad.Except (throwError)

195195

196196parseFormatSpec :: String

197197 -> Either ParseError (String, Set Extension -> Set Extension)

@@ -216,55 +216,58 @@ parseFormatSpec = parse formatSpec ""

216216-- TODO: when we get the PandocMonad stuff all sorted out,

217217-- we can simply these types considerably. Errors/MediaBag can be

218218-- part of the monad's internal state.

219−data Reader m = StringReader (ReaderOptions -> String -> m (Either PandocError Pandoc))

220− | ByteStringReader (ReaderOptions -> BL.ByteString -> m (Either PandocError (Pandoc,MediaBag)))

219+data Reader m = StringReader (ReaderOptions -> String -> m Pandoc)

220+ | ByteStringReader (ReaderOptions -> BL.ByteString -> m Pandoc)

221221

222−mkStringReader :: (ReaderOptions -> String -> Either PandocError Pandoc) -> Reader IO

223−mkStringReader r = StringReader (\o s -> return $ r o s)

222+-- mkStringReader :: (ReaderOptions -> String -> Either PandocError Pandoc) -> Reader IO

223+-- mkStringReader r = StringReader (\o s -> return $ r o s)

224224

225−mkStringReaderWithWarnings :: (ReaderOptions -> String -> Either PandocError (Pandoc, [String])) -> Reader IO

226−mkStringReaderWithWarnings r = StringReader $ \o s ->

227− case r o s of

228− Left err -> return $ Left err

229− Right (doc, warnings) -> do

230− mapM_ warn warnings

231− return (Right doc)

225+-- mkStringReaderWithWarnings :: (ReaderOptions -> String -> Either PandocError (Pandoc, [String])) -> Reader IO

226+-- mkStringReaderWithWarnings r = StringReader $ \o s ->

227+-- case r o s of

228+-- Left err -> return $ Left err

229+-- Right (doc, warnings) -> do

230+-- mapM_ warn warnings

231+-- return (Right doc)

232232

233−mkBSReader :: (ReaderOptions -> BL.ByteString -> Either PandocError (Pandoc, MediaBag)) -> Reader IO

234−mkBSReader r = ByteStringReader (\o s -> return $ r o s)

233+-- mkBSReader :: (ReaderOptions -> BL.ByteString -> Either PandocError (Pandoc, MediaBag)) -> Reader IO

234+-- mkBSReader r = ByteStringReader (\o s -> return $ r o s)

235235

236−mkBSReaderWithWarnings :: (ReaderOptions -> BL.ByteString -> Either PandocError (Pandoc, MediaBag, [String])) -> Reader IO

237−mkBSReaderWithWarnings r = ByteStringReader $ \o s ->

238− case r o s of

239− Left err -> return $ Left err

240− Right (doc, mediaBag, warnings) -> do

241− mapM_ warn warnings

242− return $ Right (doc, mediaBag)

236+-- mkBSReaderWithWarnings :: (ReaderOptions -> BL.ByteString -> Either PandocError (Pandoc, MediaBag, [String])) -> Reader IO

237+-- mkBSReaderWithWarnings r = ByteStringReader $ \o s ->

238+-- case r o s of

239+-- Left err -> return $ Left err

240+-- Right (doc, mediaBag, warnings) -> do

241+-- mapM_ warn warnings

242+-- return $ Right (doc, mediaBag)

243243

244244-- | Association list of formats and readers.

245−readers :: [(String, Reader IO)]

246−readers = [ ("native" , StringReader $ \_ s -> runIOorExplode (readNative s))

247− ,("json" , mkStringReader readJSON )

248− ,("markdown" , mkStringReaderWithWarnings readMarkdownWithWarnings)

249− ,("markdown_strict" , mkStringReaderWithWarnings readMarkdownWithWarnings)

250− ,("markdown_phpextra" , mkStringReaderWithWarnings readMarkdownWithWarnings)

251− ,("markdown_github" , mkStringReaderWithWarnings readMarkdownWithWarnings)

252− ,("markdown_mmd", mkStringReaderWithWarnings readMarkdownWithWarnings)

253− ,("commonmark" , mkStringReader readCommonMark)

254− ,("rst" , mkStringReaderWithWarnings readRSTWithWarnings )

255− ,("mediawiki" , mkStringReader readMediaWiki)

256− ,("docbook" , mkStringReader readDocBook)

257− ,("opml" , mkStringReader readOPML)

258− ,("org" , mkStringReader readOrg)

259− ,("textile" , mkStringReader readTextile) -- TODO : textile+lhs

260− ,("html" , mkStringReader readHtml)

261− ,("latex" , mkStringReader readLaTeX)

262− ,("haddock" , mkStringReader readHaddock)

263− ,("twiki" , mkStringReader readTWiki)

264− ,("docx" , mkBSReaderWithWarnings readDocxWithWarnings)

265− ,("odt" , mkBSReader readOdt)

266− ,("t2t" , mkStringReader readTxt2TagsNoMacros)

267− ,("epub" , mkBSReader readEPUB)

245+readers :: PandocMonad m => [(String, Reader m)]

246+readers = [ ("native" , StringReader $ \_ s -> readNative s)

247+ ,("json" , StringReader $ \o s ->

248+ case readJSON o s of

249+ Right doc -> return doc

250+ Left _ -> throwError $ PandocParseError "JSON parse error")

251+ ,("markdown" , StringReader readMarkdown)

252+ ,("markdown_strict" , StringReader readMarkdown)

253+ ,("markdown_phpextra" , StringReader readMarkdown)

254+ ,("markdown_github" , StringReader readMarkdown)

255+ ,("markdown_mmd", StringReader readMarkdown)

256+ ,("commonmark" , StringReader readCommonMark)

257+ ,("rst" , StringReader readRSTWithWarnings )

258+ ,("mediawiki" , StringReader readMediaWiki)

259+ ,("docbook" , StringReader readDocBook)

260+ ,("opml" , StringReader readOPML)

261+ ,("org" , StringReader readOrg)

262+ ,("textile" , StringReader readTextile) -- TODO : textile+lhs

263+ ,("html" , StringReader readHtml)

264+ ,("latex" , StringReader readLaTeX)

265+ ,("haddock" , StringReader readHaddock)

266+ ,("twiki" , StringReader readTWiki)

267+ ,("docx" , ByteStringReader readDocx)

268+ ,("odt" , ByteStringReader readOdt)

269+ -- ,("t2t" , mkStringReader readTxt2TagsNoMacros)

270+ ,("epub" , ByteStringReader readEPUB)

268271 ]

269272

270273data Writer m = StringWriter (WriterOptions -> Pandoc -> m String)

@@ -351,7 +354,7 @@ getDefaultExtensions "epub" = Set.fromList [Ext_raw_html,

351354getDefaultExtensions _ = Set.fromList [Ext_auto_identifiers]

352355

353356-- | Retrieve reader based on formatSpec (format+extensions).

354−getReader :: String -> Either String (Reader IO)

357+getReader :: PandocMonad m => String -> Either String (Reader m)

355358getReader s =

356359 case parseFormatSpec s of

357360 Left e -> Left $ intercalate "\n" [m | Message m <- errorMessages e]

src/Text/Pandoc/Class.hs+10

@@ -35,6 +35,7 @@ module Text.Pandoc.Class ( PandocMonad(..)

3535 , PureState(..)

3636 , PureEnv(..)

3737 , getPOSIXTime

38+ , addWarningWithPos

3839 , PandocIO(..)

3940 , PandocPure(..)

4041 , PandocExecutionError(..)

@@ -57,6 +58,7 @@ import qualified Text.Pandoc.Shared as IO ( fetchItem

5758 , warn

5859 , readDataFile)

5960import Text.Pandoc.Compat.Time (UTCTime)

61+import Text.Pandoc.Parsing (ParserT, ParserState, SourcePos)

6062import qualified Text.Pandoc.Compat.Time as IO (getCurrentTime)

6163import Data.Time.Clock.POSIX ( utcTimeToPOSIXSeconds

6264 , posixSecondsToUTCTime

@@ -109,6 +111,14 @@ class (Functor m, Applicative m, Monad m, MonadError PandocExecutionError m) =>

109111getPOSIXTime :: (PandocMonad m) => m POSIXTime

110112getPOSIXTime = utcTimeToPOSIXSeconds <$> getCurrentTime

111113

114+addWarningWithPos :: PandocMonad m

115+ => Maybe SourcePos

116+ -> String

117+ -> ParserT [Char] ParserState m ()

118+addWarningWithPos mbpos msg =

119+ lift $

120+ warn $

121+ msg ++ maybe "" (\pos -> " " ++ show pos) mbpos

112122

113123-- We can add to this as we go

114124data PandocExecutionError = PandocFileReadError FilePath

src/Text/Pandoc/Readers/CommonMark.hs+4−3

@@ -37,11 +37,12 @@ import Data.Text (unpack, pack)

3737import Data.List (groupBy)

3838import Text.Pandoc.Definition

3939import Text.Pandoc.Options

40−import Text.Pandoc.Error

40+import Text.Pandoc.Class (PandocMonad)

4141

4242-- | Parse a CommonMark formatted string into a 'Pandoc' structure.

43−readCommonMark :: ReaderOptions -> String -> Either PandocError Pandoc

44−readCommonMark opts = Right . nodeToPandoc . commonmarkToNode opts' . pack

43+readCommonMark :: PandocMonad m => ReaderOptions -> String -> m Pandoc

44+readCommonMark opts s = return $

45+ nodeToPandoc $ commonmarkToNode opts' $ pack s

4546 where opts' = if readerSmart opts

4647 then [optNormalize, optSmart]

4748 else [optNormalize]

src/Text/Pandoc/Readers/DocBook.hs+16−16

@@ -13,10 +13,9 @@ import Control.Monad.State

1313import Data.List (intersperse)

1414import Data.Maybe (fromMaybe)

1515import Text.TeXMath (readMathML, writeTeX)

16−import Text.Pandoc.Error (PandocError)

17−import Control.Monad.Except

1816import Data.Default

1917import Data.Foldable (asum)

18+import Text.Pandoc.Class (PandocMonad)

2019

2120{-

2221

@@ -502,7 +501,7 @@ List of all DocBook tags, with [x] indicating implemented,

502501[x] ?asciidoc-br? - line break from asciidoc docbook output

503502-}

504503

505−type DB = ExceptT PandocError (State DBState)

504+type DB m = StateT DBState m

506505

507506data DBState = DBState{ dbSectionLevel :: Int

508507 , dbQuoteType :: QuoteType

@@ -523,10 +522,11 @@ instance Default DBState where

523522 , dbContent = [] }

524523

525524

526−readDocBook :: ReaderOptions -> String -> Either PandocError Pandoc

527−readDocBook _ inp = (\blocks -> Pandoc (dbMeta st') (toList . mconcat $ blocks)) <$> bs

528− where (bs , st') = flip runState (def{ dbContent = tree }) . runExceptT . mapM parseBlock $ tree

529− tree = normalizeTree . parseXML . handleInstructions $ inp

525+readDocBook :: PandocMonad m => ReaderOptions -> String -> m Pandoc

526+readDocBook _ inp = do

527+ let tree = normalizeTree . parseXML . handleInstructions $ inp

528+ (bs, st') <- flip runStateT (def{ dbContent = tree }) $ mapM parseBlock $ tree

529+ return $ Pandoc (dbMeta st') (toList . mconcat $ bs)

530530

531531-- We treat <?asciidoc-br?> specially (issue #1236), converting it

532532-- to <br/>, since xml-light doesn't parse the instruction correctly.

@@ -538,7 +538,7 @@ handleInstructions xs = case break (=='<') xs of

538538 ([], '<':zs) -> '<' : handleInstructions zs

539539 (ys, zs) -> ys ++ handleInstructions zs

540540

541−getFigure :: Element -> DB Blocks

541+getFigure :: PandocMonad m => Element -> DB m Blocks

542542getFigure e = do

543543 tit <- case filterChild (named "title") e of

544544 Just t -> getInlines t

@@ -579,20 +579,20 @@ named s e = qName (elName e) == s

579579

580580--

581581

582−acceptingMetadata :: DB a -> DB a

582+acceptingMetadata :: PandocMonad m => DB m a -> DB m a

583583acceptingMetadata p = do

584584 modify (\s -> s { dbAcceptsMeta = True } )

585585 res <- p

586586 modify (\s -> s { dbAcceptsMeta = False })

587587 return res

588588

589−checkInMeta :: Monoid a => DB () -> DB a

589+checkInMeta :: (PandocMonad m, Monoid a) => DB m () -> DB m a

590590checkInMeta p = do

591591 accepts <- dbAcceptsMeta <$> get

592592 when accepts p

593593 return mempty

594594

595−addMeta :: ToMetaValue a => String -> a -> DB ()

595+addMeta :: PandocMonad m => ToMetaValue a => String -> a -> DB m ()

596596addMeta field val = modify (setMeta field val)

597597

598598instance HasMeta DBState where

@@ -631,7 +631,7 @@ addToStart toadd bs =

631631-- function that is used by both mediaobject (in parseBlock)

632632-- and inlinemediaobject (in parseInline)

633633-- A DocBook mediaobject is a wrapper around a set of alternative presentations

634−getMediaobject :: Element -> DB Inlines

634+getMediaobject :: PandocMonad m => Element -> DB m Inlines

635635getMediaobject e = do

636636 (imageUrl, attr) <-

637637 case filterChild (named "imageobject") e of

@@ -658,11 +658,11 @@ getMediaobject e = do

658658 else (return figTitle, "fig:")

659659 liftM (imageWith attr imageUrl title) caption

660660

661−getBlocks :: Element -> DB Blocks

661+getBlocks :: PandocMonad m => Element -> DB m Blocks

662662getBlocks e = mconcat <$> (mapM parseBlock $ elContent e)

663663

664664

665−parseBlock :: Content -> DB Blocks

665+parseBlock :: PandocMonad m => Content -> DB m Blocks

666666parseBlock (Text (CData CDataRaw _ _)) = return mempty -- DOCTYPE

667667parseBlock (Text (CData _ s _)) = if all isSpace s

668668 then return mempty

@@ -902,7 +902,7 @@ parseBlock (Elem e) =

902902 lineItems = mapM getInlines $ filterChildren (named "line") e

903903 metaBlock = acceptingMetadata (getBlocks e) >> return mempty

904904

905−getInlines :: Element -> DB Inlines

905+getInlines :: PandocMonad m => Element -> DB m Inlines

906906getInlines e' = (trimInlines . mconcat) <$> (mapM parseInline $ elContent e')

907907

908908strContentRecursive :: Element -> String

@@ -913,7 +913,7 @@ elementToStr :: Content -> Content

913913elementToStr (Elem e') = Text $ CData CDataText (strContentRecursive e') Nothing

914914elementToStr x = x

915915

916−parseInline :: Content -> DB Inlines

916+parseInline :: PandocMonad m => Content -> DB m Inlines

917917parseInline (Text (CData _ s _)) = return $ text s

918918parseInline (CRef ref) =

919919 return $ maybe (text $ map toUpper ref) (text) $ lookupEntity ref

src/Text/Pandoc/Readers/Docx.hs+44−52

@@ -82,7 +82,7 @@ import Text.Pandoc.Readers.Docx.Parse

8282import Text.Pandoc.Readers.Docx.Lists

8383import Text.Pandoc.Readers.Docx.Combine

8484import Text.Pandoc.Shared

85−import Text.Pandoc.MediaBag (insertMedia, MediaBag)

85+import Text.Pandoc.MediaBag (MediaBag)

8686import Data.List (delete, intersect)

8787import Text.TeXMath (writeTeX)

8888import Data.Default (Default)

@@ -96,27 +96,28 @@ import qualified Data.Sequence as Seq (null)

9696#if !(MIN_VERSION_base(4,8,0))

9797import Data.Traversable (traverse)

9898#endif

99+import Control.Monad.Except (throwError)

100+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))

101+import qualified Text.Pandoc.Class as P

99102

100−import Text.Pandoc.Error

101−import Control.Monad.Except

102−

103−readDocxWithWarnings :: ReaderOptions

104− -> B.ByteString

105− -> Either PandocError (Pandoc, MediaBag, [String])

106−readDocxWithWarnings opts bytes

103+readDocx :: PandocMonad m

104+ => ReaderOptions

105+ -> B.ByteString

106+ -> m Pandoc

107+readDocx opts bytes

107108 | Right archive <- toArchiveOrFail bytes

108109 , Right (docx, parserWarnings) <- archiveToDocxWithWarnings archive = do

109− (meta, blks, mediaBag, warnings) <- docxToOutput opts docx

110− return (Pandoc meta blks, mediaBag, parserWarnings ++ warnings)

111−readDocxWithWarnings _ _ =

112− Left (ParseFailure "couldn't parse docx file")

113−

114−readDocx :: ReaderOptions

110+ mapM_ P.warn parserWarnings

111+ (meta, blks) <- docxToOutput opts docx

112+ return $ Pandoc meta blks

113+readDocx _ _ =

114+ throwError $ PandocSomeError "couldn't parse docx file"

115+

116+readDocxWithWarnings :: PandocMonad m

117+ => ReaderOptions

115118 -> B.ByteString

116− -> Either PandocError (Pandoc, MediaBag)

117−readDocx opts bytes = do

118− (pandoc, mediaBag, _) <- readDocxWithWarnings opts bytes

119− return (pandoc, mediaBag)

119+ -> m Pandoc

120+readDocxWithWarnings = readDocx

120121

121122data DState = DState { docxAnchorMap :: M.Map String String

122123 , docxMediaBag :: MediaBag

@@ -137,15 +138,10 @@ data DEnv = DEnv { docxOptions :: ReaderOptions

137138instance Default DEnv where

138139 def = DEnv def False

139140

140−type DocxContext = ExceptT PandocError (ReaderT DEnv (State DState))

141+type DocxContext m = ReaderT DEnv (StateT DState m)

141142

142−evalDocxContext :: DocxContext a -> DEnv -> DState -> Either PandocError a

143−evalDocxContext ctx env st = flip evalState st . flip runReaderT env . runExceptT $ ctx

144−

145−addDocxWarning :: String -> DocxContext ()

146−addDocxWarning msg = do

147− warnings <- gets docxWarnings

148− modify $ \s -> s {docxWarnings = msg : warnings}

143+evalDocxContext :: PandocMonad m => DocxContext m a -> DEnv -> DState -> m a

144+evalDocxContext ctx env st = flip evalStateT st $ flip runReaderT env $ ctx

149145

150146-- This is empty, but we put it in for future-proofing.

151147spansToKeep :: [String]

@@ -179,7 +175,7 @@ isEmptyPar (Paragraph _ parParts) =

179175 isEmptyElem _ = True

180176isEmptyPar _ = False

181177

182−bodyPartsToMeta' :: [BodyPart] -> DocxContext (M.Map String MetaValue)

178+bodyPartsToMeta' :: PandocMonad m => [BodyPart] -> DocxContext m (M.Map String MetaValue)

183179bodyPartsToMeta' [] = return M.empty

184180bodyPartsToMeta' (bp : bps)

185181 | (Paragraph pPr parParts) <- bp

@@ -195,7 +191,7 @@ bodyPartsToMeta' (bp : bps)

195191 return $ M.insertWith f metaField (MetaInlines (toList inlines)) remaining

196192bodyPartsToMeta' (_ : bps) = bodyPartsToMeta' bps

197193

198−bodyPartsToMeta :: [BodyPart] -> DocxContext Meta

194+bodyPartsToMeta :: PandocMonad m => [BodyPart] -> DocxContext m Meta

199195bodyPartsToMeta bps = do

200196 mp <- bodyPartsToMeta' bps

201197 let mp' =

@@ -297,7 +293,7 @@ runStyleToTransform rPr

297293 emph . (runStyleToTransform rPr {rUnderline = Nothing})

298294 | otherwise = id

299295

300−runToInlines :: Run -> DocxContext Inlines

296+runToInlines :: PandocMonad m => Run -> DocxContext m Inlines

301297runToInlines (Run rs runElems)

302298 | Just (s, _) <- rStyle rs

303299 , s `elem` codeStyles =

@@ -318,8 +314,7 @@ runToInlines (Endnote bps) = do

318314 blksList <- smushBlocks <$> (mapM bodyPartToBlocks bps)

319315 return $ note blksList

320316runToInlines (InlineDrawing fp title alt bs ext) = do

321− mediaBag <- gets docxMediaBag

322− modify $ \s -> s { docxMediaBag = insertMedia fp Nothing bs mediaBag }

317+ (lift . lift) $ P.insertMedia fp Nothing bs

323318 return $ imageWith (extentToAttr ext) fp title $ text alt

324319runToInlines InlineChart = return $ spanWith ("", ["chart"], []) $ text "[CHART]"

325320

@@ -330,7 +325,7 @@ extentToAttr (Just (w, h)) =

330325 showDim d = show (d / 914400) ++ "in"

331326extentToAttr _ = nullAttr

332327

333−blocksToInlinesWarn :: String -> Blocks -> DocxContext Inlines

328+blocksToInlinesWarn :: PandocMonad m => String -> Blocks -> DocxContext m Inlines

334329blocksToInlinesWarn cmtId blks = do

335330 let blkList = toList blks

336331 notParaOrPlain :: Block -> Bool

@@ -338,10 +333,10 @@ blocksToInlinesWarn cmtId blks = do

338333 notParaOrPlain (Plain _) = False

339334 notParaOrPlain _ = True

340335 when (not $ null $ filter notParaOrPlain blkList)

341− (addDocxWarning $ "Docx comment " ++ cmtId ++ " will not retain formatting")

336+ ((lift . lift) $ P.warn $ "Docx comment " ++ cmtId ++ " will not retain formatting")

342337 return $ fromList $ blocksToInlines blkList

343338

344−parPartToInlines :: ParPart -> DocxContext Inlines

339+parPartToInlines :: PandocMonad m => ParPart -> DocxContext m Inlines

345340parPartToInlines (PlainRun r) = runToInlines r

346341parPartToInlines (Insertion _ author date runs) = do

347342 opts <- asks docxOptions

@@ -403,8 +398,7 @@ parPartToInlines (BookMark _ anchor) =

403398 (modify $ \s -> s { docxAnchorMap = M.insert anchor newAnchor anchorMap})

404399 return $ spanWith (newAnchor, ["anchor"], []) mempty

405400parPartToInlines (Drawing fp title alt bs ext) = do

406− mediaBag <- gets docxMediaBag

407− modify $ \s -> s { docxMediaBag = insertMedia fp Nothing bs mediaBag }

401+ (lift . lift) $ P.insertMedia fp Nothing bs

408402 return $ imageWith (extentToAttr ext) fp title $ text alt

409403parPartToInlines Chart = do

410404 return $ spanWith ("", ["chart"], []) $ text "[CHART]"

@@ -426,10 +420,10 @@ isAnchorSpan _ = False

426420dummyAnchors :: [String]

427421dummyAnchors = ["_GoBack"]

428422

429−makeHeaderAnchor :: Blocks -> DocxContext Blocks

423+makeHeaderAnchor :: PandocMonad m => Blocks -> DocxContext m Blocks

430424makeHeaderAnchor bs = traverse makeHeaderAnchor' bs

431425

432−makeHeaderAnchor' :: Block -> DocxContext Block

426+makeHeaderAnchor' :: PandocMonad m => Block -> DocxContext m Block

433427-- If there is an anchor already there (an anchor span in the header,

434428-- to be exact), we rename and associate the new id with the old one.

435429makeHeaderAnchor' (Header n (ident, classes, kvs) ils)

@@ -463,12 +457,12 @@ singleParaToPlain blks

463457 singleton $ Plain ils

464458singleParaToPlain blks = blks

465459

466−cellToBlocks :: Cell -> DocxContext Blocks

460+cellToBlocks :: PandocMonad m => Cell -> DocxContext m Blocks

467461cellToBlocks (Cell bps) = do

468462 blks <- smushBlocks <$> mapM bodyPartToBlocks bps

469463 return $ fromList $ blocksToDefinitions $ blocksToBullets $ toList blks

470464

471−rowToBlocksList :: Row -> DocxContext [Blocks]

465+rowToBlocksList :: PandocMonad m => Row -> DocxContext m [Blocks]

472466rowToBlocksList (Row cells) = do

473467 blksList <- mapM cellToBlocks cells

474468 return $ map singleParaToPlain blksList

@@ -518,7 +512,7 @@ parStyleToTransform pPr

518512 False -> parStyleToTransform pPr'

519513parStyleToTransform _ = id

520514

521−bodyPartToBlocks :: BodyPart -> DocxContext Blocks

515+bodyPartToBlocks :: PandocMonad m => BodyPart -> DocxContext m Blocks

522516bodyPartToBlocks (Paragraph pPr parparts)

523517 | not $ null $ codeDivs `intersect` (pStyle pPr) =

524518 return

@@ -597,7 +591,7 @@ bodyPartToBlocks (OMathPara e) = do

597591

598592

599593-- replace targets with generated anchors.

600−rewriteLink' :: Inline -> DocxContext Inline

594+rewriteLink' :: PandocMonad m => Inline -> DocxContext m Inline

601595rewriteLink' l@(Link attr ils ('#':target, title)) = do

602596 anchorMap <- gets docxAnchorMap

603597 return $ case M.lookup target anchorMap of

@@ -605,23 +599,21 @@ rewriteLink' l@(Link attr ils ('#':target, title)) = do

605599 Nothing -> l

606600rewriteLink' il = return il

607601

608−rewriteLinks :: [Block] -> DocxContext [Block]

602+rewriteLinks :: PandocMonad m => [Block] -> DocxContext m [Block]

609603rewriteLinks = mapM (walkM rewriteLink')

610604

611−bodyToOutput :: Body -> DocxContext (Meta, [Block], MediaBag, [String])

605+bodyToOutput :: PandocMonad m => Body -> DocxContext m (Meta, [Block])

612606bodyToOutput (Body bps) = do

613607 let (metabps, blkbps) = sepBodyParts bps

614608 meta <- bodyPartsToMeta metabps

615609 blks <- smushBlocks <$> mapM bodyPartToBlocks blkbps

616610 blks' <- rewriteLinks $ blocksToDefinitions $ blocksToBullets $ toList blks

617− mediaBag <- gets docxMediaBag

618− warnings <- gets docxWarnings

619− return $ (meta,

620− blks',

621− mediaBag,

622− warnings)

623−

624−docxToOutput :: ReaderOptions -> Docx -> Either PandocError (Meta, [Block], MediaBag, [String])

611+ return $ (meta, blks')

612+

613+docxToOutput :: PandocMonad m

614+ => ReaderOptions

615+ -> Docx

616+ -> m (Meta, [Block])

625617docxToOutput opts (Docx (Document _ body)) =

626618 let dEnv = def { docxOptions = opts} in

627619 evalDocxContext (bodyToOutput body) dEnv def

src/Text/Pandoc/Readers/EPUB.hs+24−26

@@ -11,13 +11,12 @@ module Text.Pandoc.Readers.EPUB

1111import Text.XML.Light

1212import Text.Pandoc.Definition hiding (Attr)

1313import Text.Pandoc.Readers.HTML (readHtml)

14−import Text.Pandoc.Error

1514import Text.Pandoc.Walk (walk, query)

1615import Text.Pandoc.Options ( ReaderOptions(..), readerTrace)

1716import Text.Pandoc.Shared (escapeURI, collapseFilePath, addMetaField)

1817import Network.URI (unEscapeString)

1918import Text.Pandoc.MediaBag (MediaBag, insertMedia)

20−import Control.Monad.Except (MonadError, throwError, runExcept, Except)

19+import Control.Monad.Except (throwError)

2120import Text.Pandoc.MIME (MimeType)

2221import qualified Text.Pandoc.Builder as B

2322import Codec.Archive.Zip ( Archive (..), toArchiveOrFail, fromEntry

@@ -33,23 +32,25 @@ import Data.Maybe (mapMaybe, fromMaybe)

3332import qualified Data.Map as M (Map, lookup, fromList, elems)

3433import Data.Monoid ((<>))

3534import Control.DeepSeq (deepseq, NFData)

35+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))

36+import qualified Text.Pandoc.Class as P

3637

3738import Debug.Trace (trace)

3839

3940type Items = M.Map String (FilePath, MimeType)

4041

41−readEPUB :: ReaderOptions -> BL.ByteString -> Either PandocError (Pandoc, MediaBag)

42+readEPUB :: PandocMonad m => ReaderOptions -> BL.ByteString -> m Pandoc

4243readEPUB opts bytes = case toArchiveOrFail bytes of

43− Right archive -> runEPUB $ archiveToEPUB opts $ archive

44− Left _ -> Left $ ParseFailure "Couldn't extract ePub file"

44+ Right archive -> archiveToEPUB opts $ archive

45+ Left _ -> throwError $ PandocParseError "Couldn't extract ePub file"

4546

46−runEPUB :: Except PandocError a -> Either PandocError a

47−runEPUB = runExcept

47+-- runEPUB :: Except PandocError a -> Either PandocError a

48+-- runEPUB = runExcept

4849

4950-- Note that internal reference are aggresively normalised so that all ids

5051-- are of the form "filename#id"

5152--

52−archiveToEPUB :: (MonadError PandocError m) => ReaderOptions -> Archive -> m (Pandoc, MediaBag)

53+archiveToEPUB :: (PandocMonad m) => ReaderOptions -> Archive -> m Pandoc

5354archiveToEPUB os archive = do

5455 -- root is path to folder with manifest file in

5556 (root, content) <- getManifest archive

@@ -63,24 +64,21 @@ archiveToEPUB os archive = do

6364 foldM' (\a b -> ((a <>) . walk (prependHash escapedSpine))

6465 `liftM` parseSpineElem root b) mempty spine

6566 let ast = coverDoc <> (Pandoc meta bs)

66− let mediaBag = fetchImages (M.elems items) root archive ast

67− return $ (ast, mediaBag)

67+ P.setMediaBag $ fetchImages (M.elems items) root archive ast

68+ return ast

6869 where

6970 os' = os {readerParseRaw = True}

70− parseSpineElem :: MonadError PandocError m => FilePath -> (FilePath, MimeType) -> m Pandoc

71+ parseSpineElem :: PandocMonad m => FilePath -> (FilePath, MimeType) -> m Pandoc

7172 parseSpineElem (normalise -> r) (normalise -> path, mime) = do

7273 when (readerTrace os) (traceM path)

7374 doc <- mimeToReader mime r path

7475 let docSpan = B.doc $ B.para $ B.spanWith (takeFileName path, [], []) mempty

7576 return $ docSpan <> doc

76− mimeToReader :: MonadError PandocError m => MimeType -> FilePath -> FilePath -> m Pandoc

77+ mimeToReader :: PandocMonad m => MimeType -> FilePath -> FilePath -> m Pandoc

7778 mimeToReader "application/xhtml+xml" (unEscapeString -> root)

7879 (unEscapeString -> path) = do

7980 fname <- findEntryByPathE (root </> path) archive

80− html <- either throwError return .

81− readHtml os' .

82− UTF8.toStringLazy $

83− fromEntry fname

81+ html <- readHtml os' . UTF8.toStringLazy $ fromEntry fname

8482 return $ fixInternalReferences path html

8583 mimeToReader s _ (unEscapeString -> path)

8684 | s `elem` imageMimes = return $ imageToPandoc path

@@ -121,7 +119,7 @@ imageMimes = ["image/gif", "image/jpeg", "image/png"]

121119

122120type CoverImage = FilePath

123121

124−parseManifest :: (MonadError PandocError m) => Element -> m (Maybe CoverImage, Items)

122+parseManifest :: (PandocMonad m) => Element -> m (Maybe CoverImage, Items)

125123parseManifest content = do

126124 manifest <- findElementE (dfName "manifest") content

127125 let items = findChildren (dfName "item") manifest

@@ -137,7 +135,7 @@ parseManifest content = do

137135 mime <- findAttrE (emptyName "media-type") e

138136 return (uid, (href, mime))

139137

140−parseSpine :: MonadError PandocError m => Items -> Element -> m [(FilePath, MimeType)]

138+parseSpine :: PandocMonad m => Items -> Element -> m [(FilePath, MimeType)]

141139parseSpine is e = do

142140 spine <- findElementE (dfName "spine") e

143141 let itemRefs = findChildren (dfName "itemref") spine

@@ -148,7 +146,7 @@ parseSpine is e = do

148146 guard linear

149147 findAttr (emptyName "idref") ref

150148

151−parseMeta :: MonadError PandocError m => Element -> m Meta

149+parseMeta :: PandocMonad m => Element -> m Meta

152150parseMeta content = do

153151 meta <- findElementE (dfName "metadata") content

154152 let dcspace (QName _ (Just "http://purl.org/dc/elements/1.1/") (Just "dc")) = True

@@ -166,7 +164,7 @@ renameMeta :: String -> String

166164renameMeta "creator" = "author"

167165renameMeta s = s

168166

169−getManifest :: MonadError PandocError m => Archive -> m (String, Element)

167+getManifest :: PandocMonad m => Archive -> m (String, Element)

170168getManifest archive = do

171169 metaEntry <- findEntryByPathE ("META-INF" </> "container.xml") archive

172170 docElem <- (parseXMLDocE . UTF8.toStringLazy . fromEntry) metaEntry

@@ -268,18 +266,18 @@ emptyName s = QName s Nothing Nothing

268266

269267-- Convert Maybe interface to Either

270268

271−findAttrE :: MonadError PandocError m => QName -> Element -> m String

269+findAttrE :: PandocMonad m => QName -> Element -> m String

272270findAttrE q e = mkE "findAttr" $ findAttr q e

273271

274−findEntryByPathE :: MonadError PandocError m => FilePath -> Archive -> m Entry

272+findEntryByPathE :: PandocMonad m => FilePath -> Archive -> m Entry

275273findEntryByPathE (normalise -> path) a =

276274 mkE ("No entry on path: " ++ path) $ findEntryByPath path a

277275

278−parseXMLDocE :: MonadError PandocError m => String -> m Element

276+parseXMLDocE :: PandocMonad m => String -> m Element

279277parseXMLDocE doc = mkE "Unable to parse XML doc" $ parseXMLDoc doc

280278

281−findElementE :: MonadError PandocError m => QName -> Element -> m Element

279+findElementE :: PandocMonad m => QName -> Element -> m Element

282280findElementE e x = mkE ("Unable to find element: " ++ show e) $ findElement e x

283281

284−mkE :: MonadError PandocError m => String -> Maybe a -> m a

285−mkE s = maybe (throwError . ParseFailure $ s) return

282+mkE :: PandocMonad m => String -> Maybe a -> m a

283+mkE s = maybe (throwError . PandocParseError $ s) return

src/Text/Pandoc/Readers/HTML.hs+115−98

@@ -44,7 +44,7 @@ import Text.Pandoc.Definition

4444import qualified Text.Pandoc.Builder as B

4545import Text.Pandoc.Builder (Blocks, Inlines, trimInlines, HasMeta(..))

4646import Text.Pandoc.Shared ( extractSpaces, renderTags', addMetaField

47− , escapeURI, safeRead, mapLeft )

47+ , escapeURI, safeRead )

4848import Text.Pandoc.Options (ReaderOptions(readerParseRaw, readerTrace)

4949 , Extension (Ext_epub_html_exts,

5050 Ext_native_divs, Ext_native_spans))

@@ -62,38 +62,46 @@ import Text.Printf (printf)

6262import Debug.Trace (trace)

6363import Text.TeXMath (readMathML, writeTeX)

6464import Data.Default (Default (..), def)

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

65+import Control.Monad.Reader (ask, asks, local, ReaderT, runReaderT, lift)

6666import Network.URI (URI, parseURIReference, nonStrictRelativeTo)

67−import Text.Pandoc.Error

6867import Text.Pandoc.CSS (foldOrElse, pickStyleAttrProps)

6968import Data.Monoid ((<>))

7069import Text.Parsec.Error

7170import qualified Data.Set as Set

71+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))

72+import Control.Monad.Except (throwError)

73+

7274

7375-- | Convert HTML-formatted string to 'Pandoc' document.

74−readHtml :: ReaderOptions -- ^ Reader options

76+readHtml :: PandocMonad m

77+ => ReaderOptions -- ^ Reader options

7578 -> String -- ^ String to parse (assumes @'\n'@ line endings)

76− -> Either PandocError Pandoc

77−readHtml opts inp =

78− mapLeft (ParseFailure . getError) . flip runReader def $

79− runParserT parseDoc

80− (HTMLState def{ stateOptions = opts } [] Nothing Set.empty M.empty)

81− "source" tags

82− where tags = stripPrefixes . canonicalizeTags $

83− parseTagsOptions parseOptions{ optTagPosition = True } inp

84− parseDoc = do

85− blocks <- (fixPlains False) . mconcat <$> manyTill block eof

86− meta <- stateMeta . parserState <$> getState

87− bs' <- replaceNotes (B.toList blocks)

88− return $ Pandoc meta bs'

89− getError (errorMessages -> ms) = case ms of

90− [] -> ""

91− (m:_) -> messageString m

92−

93−replaceNotes :: [Block] -> TagParser [Block]

79+ -> m Pandoc

80+readHtml opts inp = do

81+ let tags = stripPrefixes . canonicalizeTags $

82+ parseTagsOptions parseOptions{ optTagPosition = True } inp

83+ parseDoc = do

84+ blocks <- (fixPlains False) . mconcat <$> manyTill block eof

85+ meta <- stateMeta . parserState <$> getState

86+ bs' <- replaceNotes (B.toList blocks)

87+ return $ Pandoc meta bs'

88+ getError (errorMessages -> ms) = case ms of

89+ [] -> ""

90+ (m:_) -> messageString m

91+ result <- flip runReaderT def $

92+ runParserT parseDoc

93+ (HTMLState def{ stateOptions = opts } [] Nothing Set.empty M.empty)

94+ "source" tags

95+ case result of

96+ Right doc -> return doc

97+ Left err -> throwError $ PandocParseError $ getError err

98+

99+ where

100+

101+replaceNotes :: PandocMonad m => [Block] -> TagParser m [Block]

94102replaceNotes = walkM replaceNotes'

95103

96−replaceNotes' :: Inline -> TagParser Inline

104+replaceNotes' :: PandocMonad m => Inline -> TagParser m Inline

97105replaceNotes' (RawInline (Format "noteref") ref) = maybe (Str "") (Note . B.toList) . lookup ref <$> getNotes

98106 where

99107 getNotes = noteTable <$> getState

@@ -113,20 +121,20 @@ data HTMLLocal = HTMLLocal { quoteContext :: QuoteContext

113121 , inPlain :: Bool -- ^ Set if in pPlain

114122 }

115123

116−setInChapter :: HTMLParser s a -> HTMLParser s a

124+setInChapter :: PandocMonad m => HTMLParser m s a -> HTMLParser m s a

117125setInChapter = local (\s -> s {inChapter = True})

118126

119−setInPlain :: HTMLParser s a -> HTMLParser s a

127+setInPlain :: PandocMonad m => HTMLParser m s a -> HTMLParser m s a

120128setInPlain = local (\s -> s {inPlain = True})

121129

122−type HTMLParser s = ParserT s HTMLState (Reader HTMLLocal)

130+type HTMLParser m s = ParserT s HTMLState (ReaderT HTMLLocal m)

123131

124−type TagParser = HTMLParser [Tag String]

132+type TagParser m = HTMLParser m [Tag String]

125133

126−pBody :: TagParser Blocks

134+pBody :: PandocMonad m => TagParser m Blocks

127135pBody = pInTags "body" block

128136

129−pHead :: TagParser Blocks

137+pHead :: PandocMonad m => TagParser m Blocks

130138pHead = pInTags "head" $ pTitle <|> pMetaTag <|> pBaseTag <|> (mempty <$ pAnyTag)

131139 where pTitle = pInTags "title" inline >>= setTitle . trimInlines

132140 setTitle t = mempty <$ (updateState $ B.setMeta "title" t)

@@ -149,7 +157,7 @@ pHead = pInTags "head" $ pTitle <|> pMetaTag <|> pBaseTag <|> (mempty <$ pAnyTag

149157 parseURIReference $ fromAttrib "href" bt }

150158 return mempty

151159

152−block :: TagParser Blocks

160+block :: PandocMonad m => TagParser m Blocks

153161block = do

154162 tr <- getOption readerTrace

155163 pos <- getPosition

@@ -176,13 +184,16 @@ block = do

176184 (take 60 $ show $ B.toList res)) (return ())

177185 return res

178186

179−namespaces :: [(String, TagParser Inlines)]

187+namespaces :: PandocMonad m => [(String, TagParser m Inlines)]

180188namespaces = [(mathMLNamespace, pMath True)]

181189

182190mathMLNamespace :: String

183191mathMLNamespace = "http://www.w3.org/1998/Math/MathML"

184192

185−eSwitch :: Monoid a => (Inlines -> a) -> TagParser a -> TagParser a

193+eSwitch :: (PandocMonad m, Monoid a)

194+ => (Inlines -> a)

195+ -> TagParser m a

196+ -> TagParser m a

186197eSwitch constructor parser = try $ do

187198 guardEnabled Ext_epub_html_exts

188199 pSatisfy (~== TagOpen "switch" [])

@@ -195,7 +206,7 @@ eSwitch constructor parser = try $ do

195206 pSatisfy (~== TagClose "switch")

196207 return $ maybe fallback constructor cases

197208

198−eCase :: TagParser (Maybe Inlines)

209+eCase :: PandocMonad m => TagParser m (Maybe Inlines)

199210eCase = do

200211 skipMany pBlank

201212 TagOpen _ attr <- lookAhead $ pSatisfy $ (~== TagOpen "case" [])

@@ -203,7 +214,7 @@ eCase = do

203214 Just p -> Just <$> (pInTags "case" (skipMany pBlank *> p <* skipMany pBlank))

204215 Nothing -> Nothing <$ manyTill pAnyTag (pSatisfy (~== TagClose "case"))

205216

206−eFootnote :: TagParser ()

217+eFootnote :: PandocMonad m => TagParser m ()

207218eFootnote = try $ do

208219 let notes = ["footnote", "rearnote"]

209220 guardEnabled Ext_epub_html_exts

@@ -213,10 +224,10 @@ eFootnote = try $ do

213224 content <- pInTags tag block

214225 addNote ident content

215226

216−addNote :: String -> Blocks -> TagParser ()

227+addNote :: PandocMonad m => String -> Blocks -> TagParser m ()

217228addNote uid cont = updateState (\s -> s {noteTable = (uid, cont) : (noteTable s)})

218229

219−eNoteref :: TagParser Inlines

230+eNoteref :: PandocMonad m => TagParser m Inlines

220231eNoteref = try $ do

221232 guardEnabled Ext_epub_html_exts

222233 TagOpen tag attr <- lookAhead $ pAnyTag

@@ -227,17 +238,17 @@ eNoteref = try $ do

227238 return $ B.rawInline "noteref" ident

228239

229240-- Strip TOC if there is one, better to generate again

230−eTOC :: TagParser ()

241+eTOC :: PandocMonad m => TagParser m ()

231242eTOC = try $ do

232243 guardEnabled Ext_epub_html_exts

233244 (TagOpen tag attr) <- lookAhead $ pAnyTag

234245 guard (maybe False (== "toc") (lookup "type" attr))

235246 void (pInTags tag block)

236247

237−pList :: TagParser Blocks

248+pList :: PandocMonad m => TagParser m Blocks

238249pList = pBulletList <|> pOrderedList <|> pDefinitionList

239250

240−pBulletList :: TagParser Blocks

251+pBulletList :: PandocMonad m => TagParser m Blocks

241252pBulletList = try $ do

242253 pSatisfy (~== TagOpen "ul" [])

243254 let nonItem = pSatisfy (\t ->

@@ -249,7 +260,7 @@ pBulletList = try $ do

249260 items <- manyTill (pListItem nonItem) (pCloses "ul")

250261 return $ B.bulletList $ map (fixPlains True) items

251262

252−pListItem :: TagParser a -> TagParser Blocks

263+pListItem :: PandocMonad m => TagParser m a -> TagParser m Blocks

253264pListItem nonItem = do

254265 TagOpen _ attr <- lookAhead $ pSatisfy (~== TagOpen "li" [])

255266 let liDiv = maybe mempty (\x -> B.divWith (x, [], []) mempty) (lookup "id" attr)

@@ -271,7 +282,7 @@ parseTypeAttr "A" = UpperAlpha

271282parseTypeAttr "1" = Decimal

272283parseTypeAttr _ = DefaultStyle

273284

274−pOrderedList :: TagParser Blocks

285+pOrderedList :: PandocMonad m => TagParser m Blocks

275286pOrderedList = try $ do

276287 TagOpen _ attribs <- pSatisfy (~== TagOpen "ol" [])

277288 let (start, style) = (sta', sty')

@@ -302,13 +313,13 @@ pOrderedList = try $ do

302313 items <- manyTill (pListItem nonItem) (pCloses "ol")

303314 return $ B.orderedListWith (start, style, DefaultDelim) $ map (fixPlains True) items

304315

305−pDefinitionList :: TagParser Blocks

316+pDefinitionList :: PandocMonad m => TagParser m Blocks

306317pDefinitionList = try $ do

307318 pSatisfy (~== TagOpen "dl" [])

308319 items <- manyTill pDefListItem (pCloses "dl")

309320 return $ B.definitionList items

310321

311−pDefListItem :: TagParser (Inlines, [Blocks])

322+pDefListItem :: PandocMonad m => TagParser m (Inlines, [Blocks])

312323pDefListItem = try $ do

313324 let nonItem = pSatisfy (\t -> not (t ~== TagOpen "dt" []) &&

314325 not (t ~== TagOpen "dd" []) && not (t ~== TagClose "dl"))

@@ -334,7 +345,7 @@ fixPlains inList bs = if any isParaish bs'

334345 plainToPara x = x

335346 bs' = B.toList bs

336347

337−pRawTag :: TagParser String

348+pRawTag :: PandocMonad m => TagParser m String

338349pRawTag = do

339350 tag <- pAnyTag

340351 let ignorable x = x `elem` ["html","head","body","!DOCTYPE","?xml"]

@@ -342,7 +353,7 @@ pRawTag = do

342353 then return []

343354 else return $ renderTags' [tag]

344355

345−pDiv :: TagParser Blocks

356+pDiv :: PandocMonad m => TagParser m Blocks

346357pDiv = try $ do

347358 guardEnabled Ext_native_divs

348359 let isDivLike "div" = True

@@ -356,7 +367,7 @@ pDiv = try $ do

356367 else classes

357368 return $ B.divWith (ident, classes', kvs) contents

358369

359−pRawHtmlBlock :: TagParser Blocks

370+pRawHtmlBlock :: PandocMonad m => TagParser m Blocks

360371pRawHtmlBlock = do

361372 raw <- pHtmlBlock "script" <|> pHtmlBlock "style" <|> pRawTag

362373 parseRaw <- getOption readerParseRaw

@@ -364,21 +375,21 @@ pRawHtmlBlock = do

364375 then return $ B.rawBlock "html" raw

365376 else return mempty

366377

367−pHtmlBlock :: String -> TagParser String

378+pHtmlBlock :: PandocMonad m => String -> TagParser m String

368379pHtmlBlock t = try $ do

369380 open <- pSatisfy (~== TagOpen t [])

370381 contents <- manyTill pAnyTag (pSatisfy (~== TagClose t))

371382 return $ renderTags' $ [open] ++ contents ++ [TagClose t]

372383

373384-- Sets chapter context

374−eSection :: TagParser Blocks

385+eSection :: PandocMonad m => TagParser m Blocks

375386eSection = try $ do

376387 let matchChapter as = maybe False (isInfixOf "chapter") (lookup "type" as)

377388 let sectTag = tagOpen (`elem` sectioningContent) matchChapter

378389 TagOpen tag _ <- lookAhead $ pSatisfy sectTag

379390 setInChapter (pInTags tag block)

380391

381−headerLevel :: String -> TagParser Int

392+headerLevel :: PandocMonad m => String -> TagParser m Int

382393headerLevel tagtype = do

383394 let level = read (drop 1 tagtype)

384395 (try $ do

@@ -388,7 +399,7 @@ headerLevel tagtype = do

388399 <|>

389400 return level

390401

391−eTitlePage :: TagParser ()

402+eTitlePage :: PandocMonad m => TagParser m ()

392403eTitlePage = try $ do

393404 let isTitlePage as = maybe False (isInfixOf "titlepage") (lookup "type" as)

394405 let groupTag = tagOpen (\x -> x `elem` groupingContent || x == "section")

@@ -396,7 +407,7 @@ eTitlePage = try $ do

396407 TagOpen tag _ <- lookAhead $ pSatisfy groupTag

397408 () <$ pInTags tag block

398409

399−pHeader :: TagParser Blocks

410+pHeader :: PandocMonad m => TagParser m Blocks

400411pHeader = try $ do

401412 TagOpen tagtype attr <- pSatisfy $

402413 tagOpen (`elem` ["h1","h2","h3","h4","h5","h6"])

@@ -412,12 +423,12 @@ pHeader = try $ do

412423 then mempty -- skip a representation of the title in the body

413424 else B.headerWith attr' level contents

414425

415−pHrule :: TagParser Blocks

426+pHrule :: PandocMonad m => TagParser m Blocks

416427pHrule = do

417428 pSelfClosing (=="hr") (const True)

418429 return B.horizontalRule

419430

420−pTable :: TagParser Blocks

431+pTable :: PandocMonad m => TagParser m Blocks

421432pTable = try $ do

422433 TagOpen _ _ <- pSatisfy (~== TagOpen "table" [])

423434 skipMany pBlank

@@ -456,7 +467,7 @@ pTable = try $ do

456467 else widths'

457468 return $ B.table caption (zip aligns widths) head' rows

458469

459−pCol :: TagParser Double

470+pCol :: PandocMonad m => TagParser m Double

460471pCol = try $ do

461472 TagOpen _ attribs <- pSatisfy (~== TagOpen "col" [])

462473 skipMany pBlank

@@ -472,7 +483,7 @@ pCol = try $ do

472483 fromMaybe 0.0 $ safeRead ('0':'.':init x)

473484 _ -> 0.0

474485

475−pColgroup :: TagParser [Double]

486+pColgroup :: PandocMonad m => TagParser m [Double]

476487pColgroup = try $ do

477488 pSatisfy (~== TagOpen "colgroup" [])

478489 skipMany pBlank

@@ -485,31 +496,31 @@ noColOrRowSpans t = isNullOrOne "colspan" && isNullOrOne "rowspan"

485496 "1" -> True

486497 _ -> False

487498

488−pCell :: String -> TagParser [Blocks]

499+pCell :: PandocMonad m => String -> TagParser m [Blocks]

489500pCell celltype = try $ do

490501 skipMany pBlank

491502 res <- pInTags' celltype noColOrRowSpans block

492503 skipMany pBlank

493504 return [res]

494505

495−pBlockQuote :: TagParser Blocks

506+pBlockQuote :: PandocMonad m => TagParser m Blocks

496507pBlockQuote = do

497508 contents <- pInTags "blockquote" block

498509 return $ B.blockQuote $ fixPlains False contents

499510

500−pPlain :: TagParser Blocks

511+pPlain :: PandocMonad m => TagParser m Blocks

501512pPlain = do

502513 contents <- setInPlain $ trimInlines . mconcat <$> many1 inline

503514 if B.isNull contents

504515 then return mempty

505516 else return $ B.plain contents

506517

507−pPara :: TagParser Blocks

518+pPara :: PandocMonad m => TagParser m Blocks

508519pPara = do

509520 contents <- trimInlines <$> pInTags "p" inline

510521 return $ B.para contents

511522

512−pCodeBlock :: TagParser Blocks

523+pCodeBlock :: PandocMonad m => TagParser m Blocks

513524pCodeBlock = try $ do

514525 TagOpen _ attr <- pSatisfy (~== TagOpen "pre" [])

515526 contents <- manyTill pAnyTag (pCloses "pre" <|> eof)

@@ -529,7 +540,7 @@ tagToString (TagText s) = s

529540tagToString (TagOpen "br" _) = "\n"

530541tagToString _ = ""

531542

532−inline :: TagParser Inlines

543+inline :: PandocMonad m => TagParser m Inlines

533544inline = choice

534545 [ eNoteref

535546 , eSwitch id inline

@@ -549,30 +560,31 @@ inline = choice

549560 , pRawHtmlInline

550561 ]

551562

552−pLocation :: TagParser ()

563+pLocation :: PandocMonad m => TagParser m ()

553564pLocation = do

554565 (TagPosition r c) <- pSat isTagPosition

555566 setPosition $ newPos "input" r c

556567

557−pSat :: (Tag String -> Bool) -> TagParser (Tag String)

568+pSat :: PandocMonad m => (Tag String -> Bool) -> TagParser m (Tag String)

558569pSat f = do

559570 pos <- getPosition

560571 token show (const pos) (\x -> if f x then Just x else Nothing)

561572

562−pSatisfy :: (Tag String -> Bool) -> TagParser (Tag String)

573+pSatisfy :: PandocMonad m => (Tag String -> Bool) -> TagParser m (Tag String)

563574pSatisfy f = try $ optional pLocation >> pSat f

564575

565−pAnyTag :: TagParser (Tag String)

576+pAnyTag :: PandocMonad m => TagParser m (Tag String)

566577pAnyTag = pSatisfy (const True)

567578

568−pSelfClosing :: (String -> Bool) -> ([Attribute String] -> Bool)

569− -> TagParser (Tag String)

579+pSelfClosing :: PandocMonad m

580+ => (String -> Bool) -> ([Attribute String] -> Bool)

581+ -> TagParser m (Tag String)

570582pSelfClosing f g = do

571583 open <- pSatisfy (tagOpen f g)

572584 optional $ pSatisfy (tagClose f)

573585 return open

574586

575−pQ :: TagParser Inlines

587+pQ :: PandocMonad m => TagParser m Inlines

576588pQ = do

577589 context <- asks quoteContext

578590 let quoteType = case context of

@@ -587,19 +599,19 @@ pQ = do

587599 withQuoteContext innerQuoteContext $

588600 pInlinesInTags "q" constructor

589601

590−pEmph :: TagParser Inlines

602+pEmph :: PandocMonad m => TagParser m Inlines

591603pEmph = pInlinesInTags "em" B.emph <|> pInlinesInTags "i" B.emph

592604

593−pStrong :: TagParser Inlines

605+pStrong :: PandocMonad m => TagParser m Inlines

594606pStrong = pInlinesInTags "strong" B.strong <|> pInlinesInTags "b" B.strong

595607

596−pSuperscript :: TagParser Inlines

608+pSuperscript :: PandocMonad m => TagParser m Inlines

597609pSuperscript = pInlinesInTags "sup" B.superscript

598610

599−pSubscript :: TagParser Inlines

611+pSubscript :: PandocMonad m => TagParser m Inlines

600612pSubscript = pInlinesInTags "sub" B.subscript

601613

602−pStrikeout :: TagParser Inlines

614+pStrikeout :: PandocMonad m => TagParser m Inlines

603615pStrikeout = do

604616 pInlinesInTags "s" B.strikeout <|>

605617 pInlinesInTags "strike" B.strikeout <|>

@@ -608,7 +620,7 @@ pStrikeout = do

608620 contents <- mconcat <$> manyTill inline (pCloses "span")

609621 return $ B.strikeout contents)

610622

611−pLineBreak :: TagParser Inlines

623+pLineBreak :: PandocMonad m => TagParser m Inlines

612624pLineBreak = do

613625 pSelfClosing (=="br") (const True)

614626 return B.linebreak

@@ -619,7 +631,7 @@ maybeFromAttrib :: String -> Tag String -> Maybe String

619631maybeFromAttrib name (TagOpen _ attrs) = lookup name attrs

620632maybeFromAttrib _ _ = Nothing

621633

622−pLink :: TagParser Inlines

634+pLink :: PandocMonad m => TagParser m Inlines

623635pLink = try $ do

624636 tag <- pSatisfy $ tagOpenLit "a" (const True)

625637 let title = fromAttrib "title" tag

@@ -639,7 +651,7 @@ pLink = try $ do

639651 _ -> url'

640652 return $ B.linkWith (uid, cls, []) (escapeURI url) title lab

641653

642−pImage :: TagParser Inlines

654+pImage :: PandocMonad m => TagParser m Inlines

643655pImage = do

644656 tag <- pSelfClosing (=="img") (isJust . lookup "src")

645657 mbBaseHref <- baseHref <$> getState

@@ -657,13 +669,13 @@ pImage = do

657669 let kvs = concat $ map getAtt ["width", "height", "sizes", "srcset"]

658670 return $ B.imageWith (uid, cls, kvs) (escapeURI url) title (B.text alt)

659671

660−pCode :: TagParser Inlines

672+pCode :: PandocMonad m => TagParser m Inlines

661673pCode = try $ do

662674 (TagOpen open attr) <- pSatisfy $ tagOpen (`elem` ["code","tt"]) (const True)

663675 result <- manyTill pAnyTag (pCloses open)

664676 return $ B.codeWith (mkAttr attr) $ intercalate " " $ lines $ innerText result

665677

666−pSpan :: TagParser Inlines

678+pSpan :: PandocMonad m => TagParser m Inlines

667679pSpan = try $ do

668680 guardEnabled Ext_native_spans

669681 TagOpen _ attr <- lookAhead $ pSatisfy $ tagOpen (=="span") (const True)

@@ -674,7 +686,7 @@ pSpan = try $ do

674686 let tag = if isSmallCaps then B.smallcaps else B.spanWith (mkAttr attr)

675687 return $ tag contents

676688

677−pRawHtmlInline :: TagParser Inlines

689+pRawHtmlInline :: PandocMonad m => TagParser m Inlines

678690pRawHtmlInline = do

679691 inplain <- asks inPlain

680692 result <- pSatisfy (tagComment (const True))

@@ -689,7 +701,7 @@ pRawHtmlInline = do

689701mathMLToTeXMath :: String -> Either String String

690702mathMLToTeXMath s = writeTeX <$> readMathML s

691703

692−pMath :: Bool -> TagParser Inlines

704+pMath :: PandocMonad m => Bool -> TagParser m Inlines

693705pMath inCase = try $ do

694706 open@(TagOpen _ attr) <- pSatisfy $ tagOpen (=="math") (const True)

695707 -- we'll assume math tags are MathML unless specially marked

@@ -705,22 +717,25 @@ pMath inCase = try $ do

705717 Just "block" -> B.displayMath x

706718 _ -> B.math x

707719

708−pInlinesInTags :: String -> (Inlines -> Inlines)

709− -> TagParser Inlines

720+pInlinesInTags :: PandocMonad m => String -> (Inlines -> Inlines)

721+ -> TagParser m Inlines

710722pInlinesInTags tagtype f = extractSpaces f <$> pInTags tagtype inline

711723

712−pInTags :: (Monoid a) => String -> TagParser a -> TagParser a

724+pInTags :: (PandocMonad m, Monoid a) => String -> TagParser m a -> TagParser m a

713725pInTags tagtype parser = pInTags' tagtype (const True) parser

714726

715−pInTags' :: (Monoid a) => String -> (Tag String -> Bool) -> TagParser a

716− -> TagParser a

727+pInTags' :: (PandocMonad m, Monoid a)

728+ => String

729+ -> (Tag String -> Bool)

730+ -> TagParser m a

731+ -> TagParser m a

717732pInTags' tagtype tagtest parser = try $ do

718733 pSatisfy (\t -> t ~== TagOpen tagtype [] && tagtest t)

719734 mconcat <$> manyTill parser (pCloses tagtype <|> eof)

720735

721736-- parses p, preceeded by an optional opening tag

722737-- and followed by an optional closing tags

723−pOptInTag :: String -> TagParser a -> TagParser a

738+pOptInTag :: PandocMonad m => String -> TagParser m a -> TagParser m a

724739pOptInTag tagtype p = try $ do

725740 skipMany pBlank

726741 optional $ pSatisfy (~== TagOpen tagtype [])

@@ -731,7 +746,7 @@ pOptInTag tagtype p = try $ do

731746 skipMany pBlank

732747 return x

733748

734−pCloses :: String -> TagParser ()

749+pCloses :: PandocMonad m => String -> TagParser m ()

735750pCloses tagtype = try $ do

736751 t <- lookAhead $ pSatisfy $ \tag -> isTagClose tag || isTagOpen tag

737752 case t of

@@ -744,23 +759,25 @@ pCloses tagtype = try $ do

744759 (TagClose "table") | tagtype == "tr" -> return ()

745760 _ -> mzero

746761

747−pTagText :: TagParser Inlines

762+pTagText :: PandocMonad m => TagParser m Inlines

748763pTagText = try $ do

749764 (TagText str) <- pSatisfy isTagText

750765 st <- getState

751766 qu <- ask

752− case flip runReader qu $ runParserT (many pTagContents) st "text" str of

753− Left _ -> fail $ "Could not parse `" ++ str ++ "'"

767+ parsed <- lift $ lift $

768+ flip runReaderT qu $ runParserT (many pTagContents) st "text" str

769+ case parsed of

770+ Left _ -> throwError $ PandocParseError $ "Could not parse `" ++ str ++ "'"

754771 Right result -> return $ mconcat result

755772

756−pBlank :: TagParser ()

773+pBlank :: PandocMonad m => TagParser m ()

757774pBlank = try $ do

758775 (TagText str) <- pSatisfy isTagText

759776 guard $ all isSpace str

760777

761−type InlinesParser = HTMLParser String

778+type InlinesParser m = HTMLParser m String

762779

763−pTagContents :: InlinesParser Inlines

780+pTagContents :: PandocMonad m => InlinesParser m Inlines

764781pTagContents =

765782 B.displayMath <$> mathDisplay

766783 <|> B.math <$> mathInline

@@ -770,7 +787,7 @@ pTagContents =

770787 <|> pSymbol

771788 <|> pBad

772789

773−pStr :: InlinesParser Inlines

790+pStr :: PandocMonad m => InlinesParser m Inlines

774791pStr = do

775792 result <- many1 $ satisfy $ \c ->

776793 not (isSpace c) && not (isSpecial c) && not (isBad c)

@@ -789,13 +806,13 @@ isSpecial '\8220' = True

789806isSpecial '\8221' = True

790807isSpecial _ = False

791808

792−pSymbol :: InlinesParser Inlines

809+pSymbol :: PandocMonad m => InlinesParser m Inlines

793810pSymbol = satisfy isSpecial >>= return . B.str . (:[])

794811

795812isBad :: Char -> Bool

796813isBad c = c >= '\128' && c <= '\159' -- not allowed in HTML

797814

798−pBad :: InlinesParser Inlines

815+pBad :: PandocMonad m => InlinesParser m Inlines

799816pBad = do

800817 c <- satisfy isBad

801818 let c' = case c of

@@ -829,7 +846,7 @@ pBad = do

829846 _ -> '?'

830847 return $ B.str [c']

831848

832−pSpace :: InlinesParser Inlines

849+pSpace :: PandocMonad m => InlinesParser m Inlines

833850pSpace = many1 (satisfy isSpace) >>= \xs ->

834851 if '\n' `elem` xs

835852 then return B.softbreak

@@ -1070,7 +1087,7 @@ instance HasHeaderMap HTMLState where

10701087

10711088-- This signature should be more general

10721089-- MonadReader HTMLLocal m => HasQuoteContext st m

1073−instance HasQuoteContext st (Reader HTMLLocal) where

1090+instance PandocMonad m => HasQuoteContext st (ReaderT HTMLLocal m) where

10741091 getQuoteContext = asks quoteContext

10751092 withQuoteContext q = local (\s -> s{quoteContext = q})

10761093

src/Text/Pandoc/Readers/Haddock.hs+14−5

@@ -25,14 +25,23 @@ import Text.Pandoc.Options

2525import Documentation.Haddock.Parser

2626import Documentation.Haddock.Types

2727import Debug.Trace (trace)

28+import Control.Monad.Except (throwError)

29+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))

2830

29−import Text.Pandoc.Error

3031

3132-- | Parse Haddock markup and return a 'Pandoc' document.

32−readHaddock :: ReaderOptions -- ^ Reader options

33− -> String -- ^ String to parse

34− -> Either PandocError Pandoc

35−readHaddock opts =

33+readHaddock :: PandocMonad m

34+ => ReaderOptions

35+ -> String

36+ -> m Pandoc

37+readHaddock opts s = case readHaddockEither opts s of

38+ Right result -> return result

39+ Left e -> throwError e

40+

41+readHaddockEither :: ReaderOptions -- ^ Reader options

42+ -> String -- ^ String to parse

43+ -> Either PandocExecutionError Pandoc

44+readHaddockEither opts =

3645#if MIN_VERSION_haddock_library(1,2,0)

3746 Right . B.doc . docHToBlocks . trace' . _doc . parseParas

3847#else

src/Text/Pandoc/Readers/LaTeX.hs+105−98

@@ -56,14 +56,21 @@ import qualified Control.Exception as E

5656import Text.Pandoc.Highlighting (fromListingsLanguage)

5757import Text.Pandoc.ImageSize (numUnit, showFl)

5858import Text.Pandoc.Error

59+import Control.Monad.Except (throwError)

60+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..), PandocPure)

5961

6062-- | Parse LaTeX from string and return 'Pandoc' document.

61−readLaTeX :: ReaderOptions -- ^ Reader options

63+readLaTeX :: PandocMonad m

64+ => ReaderOptions -- ^ Reader options

6265 -> String -- ^ String to parse (assumes @'\n'@ line endings)

63− -> Either PandocError Pandoc

64−readLaTeX opts = readWith parseLaTeX def{ stateOptions = opts }

65−

66−parseLaTeX :: LP Pandoc

66+ -> m Pandoc

67+readLaTeX opts ltx = do

68+ parsed <- readWithM parseLaTeX def{ stateOptions = opts } ltx

69+ case parsed of

70+ Right result -> return result

71+ Left _ -> throwError $ PandocParseError "parsing error"

72+

73+parseLaTeX :: PandocMonad m => LP m Pandoc

6774parseLaTeX = do

6875 bs <- blocks

6976 eof

@@ -72,9 +79,9 @@ parseLaTeX = do

7279 let (Pandoc _ bs') = doc bs

7380 return $ Pandoc meta bs'

7481

75−type LP = Parser String ParserState

82+type LP m = ParserT String ParserState m

7683

77−anyControlSeq :: LP String

84+anyControlSeq :: PandocMonad m => LP m String

7885anyControlSeq = do

7986 char '\\'

8087 next <- option '\n' anyChar

@@ -83,7 +90,7 @@ anyControlSeq = do

8390 c | isLetter c -> (c:) <$> (many letter <* optional sp)

8491 | otherwise -> return [c]

8592

86−controlSeq :: String -> LP String

93+controlSeq :: PandocMonad m => String -> LP m String

8794controlSeq name = try $ do

8895 char '\\'

8996 case name of

@@ -92,26 +99,26 @@ controlSeq name = try $ do

9299 cs -> string cs <* notFollowedBy letter <* optional sp

93100 return name

94101

95−dimenarg :: LP String

102+dimenarg :: PandocMonad m => LP m String

96103dimenarg = try $ do

97104 ch <- option "" $ string "="

98105 num <- many1 digit

99106 dim <- oneOfStrings ["pt","pc","in","bp","cm","mm","dd","cc","sp"]

100107 return $ ch ++ num ++ dim

101108

102−sp :: LP ()

109+sp :: PandocMonad m => LP m ()

103110sp = whitespace <|> endline

104111

105−whitespace :: LP ()

112+whitespace :: PandocMonad m => LP m ()

106113whitespace = skipMany1 $ satisfy (\c -> c == ' ' || c == '\t')

107114

108−endline :: LP ()

115+endline :: PandocMonad m => LP m ()

109116endline = try (newline >> lookAhead anyChar >> notFollowedBy blankline)

110117

111118isLowerHex :: Char -> Bool

112119isLowerHex x = x >= '0' && x <= '9' || x >= 'a' && x <= 'f'

113120

114−tildeEscape :: LP Char

121+tildeEscape :: PandocMonad m => LP m Char

115122tildeEscape = try $ do

116123 string "^^"

117124 c <- satisfy (\x -> x >= '\0' && x <= '\128')

@@ -124,29 +131,29 @@ tildeEscape = try $ do

124131 | otherwise -> return $ chr (x + 64)

125132 else return $ chr $ read ('0':'x':c:d)

126133

127−comment :: LP ()

134+comment :: PandocMonad m => LP m ()

128135comment = do

129136 char '%'

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

131138 optional newline

132139 return ()

133140

134−bgroup :: LP ()

141+bgroup :: PandocMonad m => LP m ()

135142bgroup = try $ do

136143 skipMany (spaceChar <|> try (newline <* notFollowedBy blankline))

137144 () <$ char '{'

138145 <|> () <$ controlSeq "bgroup"

139146 <|> () <$ controlSeq "begingroup"

140147

141−egroup :: LP ()

148+egroup :: PandocMonad m => LP m ()

142149egroup = () <$ char '}'

143150 <|> () <$ controlSeq "egroup"

144151 <|> () <$ controlSeq "endgroup"

145152

146−grouped :: Monoid a => LP a -> LP a

153+grouped :: PandocMonad m => Monoid a => LP m a -> LP m a

147154grouped parser = try $ bgroup *> (mconcat <$> manyTill parser egroup)

148155

149−braced :: LP String

156+braced :: PandocMonad m => LP m String

150157braced = bgroup *> (concat <$> manyTill

151158 ( many1 (satisfy (\c -> c /= '\\' && c /= '}' && c /= '{'))

152159 <|> try (string "\\}")

@@ -156,16 +163,16 @@ braced = bgroup *> (concat <$> manyTill

156163 <|> count 1 anyChar

157164 ) egroup)

158165

159−bracketed :: Monoid a => LP a -> LP a

166+bracketed :: PandocMonad m => Monoid a => LP m a -> LP m a

160167bracketed parser = try $ char '[' *> (mconcat <$> manyTill parser (char ']'))

161168

162−mathDisplay :: LP String -> LP Inlines

169+mathDisplay :: PandocMonad m => LP m String -> LP m Inlines

163170mathDisplay p = displayMath <$> (try p >>= applyMacros' . trim)

164171

165−mathInline :: LP String -> LP Inlines

172+mathInline :: PandocMonad m => LP m String -> LP m Inlines

166173mathInline p = math <$> (try p >>= applyMacros')

167174

168−mathChars :: LP String

175+mathChars :: PandocMonad m => LP m String

169176mathChars =

170177 concat <$> many (escapedChar

171178 <|> (snd <$> withRaw braced)

@@ -179,7 +186,7 @@ mathChars =

179186 isOrdChar '\\' = False

180187 isOrdChar _ = True

181188

182−quoted' :: (Inlines -> Inlines) -> LP String -> LP () -> LP Inlines

189+quoted' :: PandocMonad m => (Inlines -> Inlines) -> LP m String -> LP m () -> LP m Inlines

183190quoted' f starter ender = do

184191 startchs <- starter

185192 smart <- getOption readerSmart

@@ -194,7 +201,7 @@ quoted' f starter ender = do

194201 _ -> startchs)

195202 else lit startchs

196203

197−doubleQuote :: LP Inlines

204+doubleQuote :: PandocMonad m => LP m Inlines

198205doubleQuote = do

199206 quoted' doubleQuoted (try $ string "``") (void $ try $ string "''")

200207 <|> quoted' doubleQuoted (string "“") (void $ char '”')

@@ -202,7 +209,7 @@ doubleQuote = do

202209 <|> quoted' doubleQuoted (try $ string "\"`") (void $ try $ string "\"'")

203210 <|> quoted' doubleQuoted (string "\"") (void $ char '"')

204211

205−singleQuote :: LP Inlines

212+singleQuote :: PandocMonad m => LP m Inlines

206213singleQuote = do

207214 smart <- getOption readerSmart

208215 if smart

@@ -210,7 +217,7 @@ singleQuote = do

210217 <|> quoted' singleQuoted (string "‘") (try $ char '’' >> notFollowedBy letter)

211218 else str <$> many1 (oneOf "`\'‘’")

212219

213−inline :: LP Inlines

220+inline :: PandocMonad m => LP m Inlines

214221inline = (mempty <$ comment)

215222 <|> (space <$ whitespace)

216223 <|> (softbreak <$ endline)

@@ -235,10 +242,10 @@ inline = (mempty <$ comment)

235242 <|> (str . (:[]) <$> oneOf "#&~^'`\"[]") -- TODO print warning?

236243 -- <|> (str <$> count 1 (satisfy (\c -> c /= '\\' && c /='\n' && c /='}' && c /='{'))) -- eat random leftover characters

237244

238−inlines :: LP Inlines

245+inlines :: PandocMonad m => LP m Inlines

239246inlines = mconcat <$> many (notFollowedBy (char '}') *> inline)

240247

241−inlineGroup :: LP Inlines

248+inlineGroup :: PandocMonad m => LP m Inlines

242249inlineGroup = do

243250 ils <- grouped inline

244251 if isNull ils

@@ -247,7 +254,7 @@ inlineGroup = do

247254 -- we need the span so we can detitlecase bibtex entries;

248255 -- we need to know when something is {C}apitalized

249256

250−block :: LP Blocks

257+block :: PandocMonad m => LP m Blocks

251258block = (mempty <$ comment)

252259 <|> (mempty <$ ((spaceChar <|> newline) *> spaces))

253260 <|> environment

@@ -258,10 +265,10 @@ block = (mempty <$ comment)

258265 <|> (mempty <$ char '&') -- loose & in table environment

259266

260267

261−blocks :: LP Blocks

268+blocks :: PandocMonad m => LP m Blocks

262269blocks = mconcat <$> many block

263270

264−getRawCommand :: String -> LP String

271+getRawCommand :: PandocMonad m => String -> LP m String

265272getRawCommand name' = do

266273 rawargs <- withRaw (many (try (optional sp *> opt)) *>

267274 option "" (try (optional sp *> dimenarg)) *>

@@ -273,7 +280,7 @@ lookupListDefault d = (fromMaybe d .) . lookupList

273280 where

274281 lookupList l m = msum $ map (`M.lookup` m) l

275282

276−blockCommand :: LP Blocks

283+blockCommand :: PandocMonad m => LP m Blocks

277284blockCommand = try $ do

278285 name <- anyControlSeq

279286 guard $ name /= "begin" && name /= "end"

@@ -291,21 +298,21 @@ inBrackets :: Inlines -> Inlines

291298inBrackets x = str "[" <> x <> str "]"

292299

293300-- eat an optional argument and one or more arguments in braces

294−ignoreInlines :: String -> (String, LP Inlines)

301+ignoreInlines :: PandocMonad m => String -> (String, LP m Inlines)

295302ignoreInlines name = (name, doraw <|> (mempty <$ optargs))

296303 where optargs = skipopts *> skipMany (try $ optional sp *> braced)

297304 contseq = '\\':name

298305 doraw = (rawInline "latex" . (contseq ++) . snd) <$>

299306 (getOption readerParseRaw >>= guard >> withRaw optargs)

300307

301−ignoreBlocks :: String -> (String, LP Blocks)

308+ignoreBlocks :: PandocMonad m => String -> (String, LP m Blocks)

302309ignoreBlocks name = (name, doraw <|> (mempty <$ optargs))

303310 where optargs = skipopts *> skipMany (try $ optional sp *> braced)

304311 contseq = '\\':name

305312 doraw = (rawBlock "latex" . (contseq ++) . snd) <$>

306313 (getOption readerParseRaw >>= guard >> withRaw optargs)

307314

308−blockCommands :: M.Map String (LP Blocks)

315+blockCommands :: PandocMonad m => M.Map String (LP m Blocks)

309316blockCommands = M.fromList $

310317 [ ("par", mempty <$ skipopts)

311318 , ("title", mempty <$ (skipopts *>

@@ -370,14 +377,14 @@ blockCommands = M.fromList $

370377 , "newpage"

371378 ]

372379

373−addMeta :: ToMetaValue a => String -> a -> LP ()

380+addMeta :: PandocMonad m => ToMetaValue a => String -> a -> LP m ()

374381addMeta field val = updateState $ \st ->

375382 st{ stateMeta = addMetaField field val $ stateMeta st }

376383

377384splitBibs :: String -> [Inlines]

378385splitBibs = map (str . flip replaceExtension "bib" . trim) . splitBy (==',')

379386

380−setCaption :: LP Blocks

387+setCaption :: PandocMonad m => LP m Blocks

381388setCaption = do

382389 ils <- tok

383390 mblabel <- option Nothing $

@@ -389,10 +396,10 @@ setCaption = do

389396 updateState $ \st -> st{ stateCaption = Just ils' }

390397 return mempty

391398

392−resetCaption :: LP ()

399+resetCaption :: PandocMonad m => LP m ()

393400resetCaption = updateState $ \st -> st{ stateCaption = Nothing }

394401

395−authors :: LP ()

402+authors :: PandocMonad m => LP m ()

396403authors = try $ do

397404 char '{'

398405 let oneAuthor = mconcat <$>

@@ -403,7 +410,7 @@ authors = try $ do

403410 char '}'

404411 addMeta "author" (map trimInlines auths)

405412

406−section :: Attr -> Int -> LP Blocks

413+section :: PandocMonad m => Attr -> Int -> LP m Blocks

407414section (ident, classes, kvs) lvl = do

408415 hasChapters <- stateHasChapters `fmap` getState

409416 let lvl' = if hasChapters then lvl + 1 else lvl

@@ -413,7 +420,7 @@ section (ident, classes, kvs) lvl = do

413420 attr' <- registerHeader (lab, classes, kvs) contents

414421 return $ headerWith attr' lvl' contents

415422

416−inlineCommand :: LP Inlines

423+inlineCommand :: PandocMonad m => LP m Inlines

417424inlineCommand = try $ do

418425 name <- anyControlSeq

419426 guard $ name /= "begin" && name /= "end"

@@ -435,14 +442,14 @@ inlineCommand = try $ do

435442 optional (try (string "{}")))

436443 <|> raw

437444

438−unlessParseRaw :: LP ()

445+unlessParseRaw :: PandocMonad m => LP m ()

439446unlessParseRaw = getOption readerParseRaw >>= guard . not

440447

441448isBlockCommand :: String -> Bool

442−isBlockCommand s = s `M.member` blockCommands

449+isBlockCommand s = s `M.member` (blockCommands :: M.Map String (LP PandocPure Blocks))

443450

444451

445−inlineEnvironments :: M.Map String (LP Inlines)

452+inlineEnvironments :: PandocMonad m => M.Map String (LP m Inlines)

446453inlineEnvironments = M.fromList

447454 [ ("displaymath", mathEnv id Nothing "displaymath")

448455 , ("math", math <$> verbEnv "math")

@@ -460,7 +467,7 @@ inlineEnvironments = M.fromList

460467 , ("alignat*", mathEnv id (Just "aligned") "alignat*")

461468 ]

462469

463−inlineCommands :: M.Map String (LP Inlines)

470+inlineCommands :: PandocMonad m => M.Map String (LP m Inlines)

464471inlineCommands = M.fromList $

465472 [ ("emph", extractSpaces emph <$> tok)

466473 , ("textit", extractSpaces emph <$> tok)

@@ -621,7 +628,7 @@ inlineCommands = M.fromList $

621628 -- in which case they will appear as raw latex blocks:

622629 [ "index" ]

623630

624−mkImage :: [(String, String)] -> String -> LP Inlines

631+mkImage :: PandocMonad m => [(String, String)] -> String -> LP m Inlines

625632mkImage options src = do

626633 let replaceTextwidth (k,v) = case numUnit v of

627634 Just (num, "\\textwidth") -> (k, showFl (num * 100) ++ "%")

@@ -645,7 +652,7 @@ unescapeURL ('\\':x:xs) | isEscapable x = x:unescapeURL xs

645652unescapeURL (x:xs) = x:unescapeURL xs

646653unescapeURL [] = ""

647654

648−enquote :: LP Inlines

655+enquote :: PandocMonad m => LP m Inlines

649656enquote = do

650657 skipopts

651658 context <- stateQuoteContext <$> getState

@@ -653,18 +660,18 @@ enquote = do

653660 then singleQuoted <$> withQuoteContext InSingleQuote tok

654661 else doubleQuoted <$> withQuoteContext InDoubleQuote tok

655662

656−doverb :: LP Inlines

663+doverb :: PandocMonad m => LP m Inlines

657664doverb = do

658665 marker <- anyChar

659666 code <$> manyTill (satisfy (/='\n')) (char marker)

660667

661−doLHSverb :: LP Inlines

668+doLHSverb :: PandocMonad m => LP m Inlines

662669doLHSverb = codeWith ("",["haskell"],[]) <$> manyTill (satisfy (/='\n')) (char '|')

663670

664−lit :: String -> LP Inlines

671+lit :: String -> LP m Inlines

665672lit = pure . str

666673

667−accent :: (Char -> String) -> Inlines -> LP Inlines

674+accent :: (Char -> String) -> Inlines -> LP m Inlines

668675accent f ils =

669676 case toList ils of

670677 (Str (x:xs) : ys) -> return $ fromList (Str (f x ++ xs) : ys)

@@ -870,53 +877,53 @@ breve 'U' = "Ŭ"

870877breve 'u' = "ŭ"

871878breve c = [c]

872879

873−tok :: LP Inlines

880+tok :: PandocMonad m => LP m Inlines

874881tok = try $ grouped inline <|> inlineCommand <|> str <$> count 1 inlineChar

875882

876−opt :: LP Inlines

883+opt :: PandocMonad m => LP m Inlines

877884opt = bracketed inline

878885

879−rawopt :: LP String

886+rawopt :: PandocMonad m => LP m String

880887rawopt = do

881888 contents <- bracketed (many1 (noneOf "[]") <|> try (string "\\]") <|>

882889 try (string "\\[") <|> rawopt)

883890 optional sp

884891 return $ "[" ++ contents ++ "]"

885892

886−skipopts :: LP ()

893+skipopts :: PandocMonad m => LP m ()

887894skipopts = skipMany rawopt

888895

889896-- opts in angle brackets are used in beamer

890−rawangle :: LP ()

897+rawangle :: PandocMonad m => LP m ()

891898rawangle = try $ do

892899 char '<'

893900 skipMany (noneOf ">")

894901 char '>'

895902 return ()

896903

897−skipangles :: LP ()

904+skipangles :: PandocMonad m => LP m ()

898905skipangles = skipMany rawangle

899906

900−inlineText :: LP Inlines

907+inlineText :: PandocMonad m => LP m Inlines

901908inlineText = str <$> many1 inlineChar

902909

903−inlineChar :: LP Char

910+inlineChar :: PandocMonad m => LP m Char

904911inlineChar = noneOf "\\$%&~#{}^'`\"‘’“”-[] \t\n"

905912

906−environment :: LP Blocks

913+environment :: PandocMonad m => LP m Blocks

907914environment = do

908915 controlSeq "begin"

909916 name <- braced

910917 M.findWithDefault mzero name environments

911918 <|> rawEnv name

912919

913−inlineEnvironment :: LP Inlines

920+inlineEnvironment :: PandocMonad m => LP m Inlines

914921inlineEnvironment = try $ do

915922 controlSeq "begin"

916923 name <- braced

917924 M.findWithDefault mzero name inlineEnvironments

918925

919−rawEnv :: String -> LP Blocks

926+rawEnv :: PandocMonad m => String -> LP m Blocks

920927rawEnv name = do

921928 parseRaw <- getOption readerParseRaw

922929 rawOptions <- mconcat <$> many rawopt

@@ -1045,7 +1052,7 @@ readFileFromDirs (d:ds) f =

10451052

10461053----

10471054

1048−keyval :: LP (String, String)

1055+keyval :: PandocMonad m => LP m (String, String)

10491056keyval = try $ do

10501057 key <- many1 alphaNum

10511058 val <- option "" $ char '=' >> many1 (alphaNum <|> char '.' <|> char '\\')

@@ -1055,25 +1062,25 @@ keyval = try $ do

10551062 return (key, val)

10561063

10571064

1058−keyvals :: LP [(String, String)]

1065+keyvals :: PandocMonad m => LP m [(String, String)]

10591066keyvals = try $ char '[' *> manyTill keyval (char ']')

10601067

1061−alltt :: String -> LP Blocks

1068+alltt :: PandocMonad m => String -> LP m Blocks

10621069alltt t = walk strToCode <$> parseFromString blocks

10631070 (substitute " " "\\ " $ substitute "%" "\\%" $

10641071 intercalate "\\\\\n" $ lines t)

10651072 where strToCode (Str s) = Code nullAttr s

10661073 strToCode x = x

10671074

1068−rawLaTeXBlock :: LP String

1075+rawLaTeXBlock :: PandocMonad m => LP m String

10691076rawLaTeXBlock = snd <$> try (withRaw (environment <|> blockCommand))

10701077

1071−rawLaTeXInline :: LP Inline

1078+rawLaTeXInline :: PandocMonad m => LP m Inline

10721079rawLaTeXInline = do

10731080 raw <- (snd <$> withRaw inlineCommand) <|> (snd <$> withRaw blockCommand)

10741081 RawInline "latex" <$> applyMacros' raw

10751082

1076−addImageCaption :: Blocks -> LP Blocks

1083+addImageCaption :: PandocMonad m => Blocks -> LP m Blocks

10771084addImageCaption = walkM go

10781085 where go (Image attr alt (src,tit)) = do

10791086 mbcapt <- stateCaption <$> getState

@@ -1082,7 +1089,7 @@ addImageCaption = walkM go

10821089 Nothing -> Image attr alt (src,tit)

10831090 go x = return x

10841091

1085−addTableCaption :: Blocks -> LP Blocks

1092+addTableCaption :: PandocMonad m => Blocks -> LP m Blocks

10861093addTableCaption = walkM go

10871094 where go (Table c als ws hs rs) = do

10881095 mbcapt <- stateCaption <$> getState

@@ -1091,7 +1098,7 @@ addTableCaption = walkM go

10911098 Nothing -> Table c als ws hs rs

10921099 go x = return x

10931100

1094−environments :: M.Map String (LP Blocks)

1101+environments :: PandocMonad m => M.Map String (LP m Blocks)

10951102environments = M.fromList

10961103 [ ("document", env "document" blocks <* skipMany anyChar)

10971104 , ("abstract", mempty <$ (env "abstract" blocks >>= addMeta "abstract"))

@@ -1159,7 +1166,7 @@ environments = M.fromList

11591166 , ("alignat*", mathEnv para (Just "aligned") "alignat*")

11601167 ]

11611168

1162−letterContents :: LP Blocks

1169+letterContents :: PandocMonad m => LP m Blocks

11631170letterContents = do

11641171 bs <- blocks

11651172 st <- getState

@@ -1170,7 +1177,7 @@ letterContents = do

11701177 _ -> mempty

11711178 return $ addr <> bs -- sig added by \closing

11721179

1173−closing :: LP Blocks

1180+closing :: PandocMonad m => LP m Blocks

11741181closing = do

11751182 contents <- tok

11761183 st <- getState

@@ -1184,17 +1191,17 @@ closing = do

11841191 _ -> mempty

11851192 return $ para (trimInlines contents) <> sigs

11861193

1187−item :: LP Blocks

1194+item :: PandocMonad m => LP m Blocks

11881195item = blocks *> controlSeq "item" *> skipopts *> blocks

11891196

1190−looseItem :: LP Blocks

1197+looseItem :: PandocMonad m => LP m Blocks

11911198looseItem = do

11921199 ctx <- stateParserContext `fmap` getState

11931200 if ctx == ListItemState

11941201 then mzero

11951202 else return mempty

11961203

1197−descItem :: LP (Inlines, [Blocks])

1204+descItem :: PandocMonad m => LP m (Inlines, [Blocks])

11981205descItem = do

11991206 blocks -- skip blocks before item

12001207 controlSeq "item"

@@ -1203,12 +1210,12 @@ descItem = do

12031210 bs <- blocks

12041211 return (ils, [bs])

12051212

1206−env :: String -> LP a -> LP a

1213+env :: PandocMonad m => String -> LP m a -> LP m a

12071214env name p = p <*

12081215 (try (controlSeq "end" *> braced >>= guard . (== name))

12091216 <?> ("\\end{" ++ name ++ "}"))

12101217

1211−listenv :: String -> LP a -> LP a

1218+listenv :: PandocMonad m => String -> LP m a -> LP m a

12121219listenv name p = try $ do

12131220 oldCtx <- stateParserContext `fmap` getState

12141221 updateState $ \st -> st{ stateParserContext = ListItemState }

@@ -1216,14 +1223,14 @@ listenv name p = try $ do

12161223 updateState $ \st -> st{ stateParserContext = oldCtx }

12171224 return res

12181225

1219−mathEnv :: (Inlines -> a) -> Maybe String -> String -> LP a

1226+mathEnv :: PandocMonad m => (Inlines -> a) -> Maybe String -> String -> LP m a

12201227mathEnv f innerEnv name = f <$> mathDisplay (inner <$> verbEnv name)

12211228 where inner x = case innerEnv of

12221229 Nothing -> x

12231230 Just y -> "\\begin{" ++ y ++ "}\n" ++ x ++

12241231 "\\end{" ++ y ++ "}"

12251232

1226−verbEnv :: String -> LP String

1233+verbEnv :: PandocMonad m => String -> LP m String

12271234verbEnv name = do

12281235 skipopts

12291236 optional blankline

@@ -1231,7 +1238,7 @@ verbEnv name = do

12311238 res <- manyTill anyChar endEnv

12321239 return $ stripTrailingNewlines res

12331240

1234−fancyverbEnv :: String -> LP Blocks

1241+fancyverbEnv :: PandocMonad m => String -> LP m Blocks

12351242fancyverbEnv name = do

12361243 options <- option [] keyvals

12371244 let kvs = [ (if k == "firstnumber"

@@ -1242,7 +1249,7 @@ fancyverbEnv name = do

12421249 let attr = ("",classes,kvs)

12431250 codeBlockWith attr <$> verbEnv name

12441251

1245−orderedList' :: LP Blocks

1252+orderedList' :: PandocMonad m => LP m Blocks

12461253orderedList' = do

12471254 optional sp

12481255 (_, style, delim) <- option (1, DefaultStyle, DefaultDelim) $

@@ -1259,14 +1266,14 @@ orderedList' = do

12591266 bs <- listenv "enumerate" (many item)

12601267 return $ orderedListWith (start, style, delim) bs

12611268

1262−paragraph :: LP Blocks

1269+paragraph :: PandocMonad m => LP m Blocks

12631270paragraph = do

12641271 x <- trimInlines . mconcat <$> many1 inline

12651272 if x == mempty

12661273 then return mempty

12671274 else return $ para x

12681275

1269−preamble :: LP Blocks

1276+preamble :: PandocMonad m => LP m Blocks

12701277preamble = mempty <$> manyTill preambleBlock beginDoc

12711278 where beginDoc = lookAhead $ try $ controlSeq "begin" *> string "{document}"

12721279 preambleBlock = void comment

@@ -1292,7 +1299,7 @@ addSuffix s ks@(_:_) =

12921299 in init ks ++ [k {citationSuffix = citationSuffix k ++ s}]

12931300addSuffix _ _ = []

12941301

1295−simpleCiteArgs :: LP [Citation]

1302+simpleCiteArgs :: PandocMonad m => LP m [Citation]

12961303simpleCiteArgs = try $ do

12971304 first <- optionMaybe $ toList <$> opt

12981305 second <- optionMaybe $ toList <$> opt

@@ -1312,7 +1319,7 @@ simpleCiteArgs = try $ do

13121319 }

13131320 return $ addPrefix pre $ addSuffix suf $ map conv keys

13141321

1315−citationLabel :: LP String

1322+citationLabel :: PandocMonad m => LP m String

13161323citationLabel = optional sp *>

13171324 (many1 (satisfy isBibtexKeyChar)

13181325 <* optional sp

@@ -1320,7 +1327,7 @@ citationLabel = optional sp *>

13201327 <* optional sp)

13211328 where isBibtexKeyChar c = isAlphaNum c || c `elem` (".:;?!`'()/*@_+=-[]" :: String)

13221329

1323−cites :: CitationMode -> Bool -> LP [Citation]

1330+cites :: PandocMonad m => CitationMode -> Bool -> LP m [Citation]

13241331cites mode multi = try $ do

13251332 cits <- if multi

13261333 then many1 simpleCiteArgs

@@ -1332,12 +1339,12 @@ cites mode multi = try $ do

13321339 [] -> []

13331340 _ -> map (\a -> a {citationMode = mode}) cs

13341341

1335−citation :: String -> CitationMode -> Bool -> LP Inlines

1342+citation :: PandocMonad m => String -> CitationMode -> Bool -> LP m Inlines

13361343citation name mode multi = do

13371344 (c,raw) <- withRaw $ cites mode multi

13381345 return $ cite c (rawInline "latex" $ "\\" ++ name ++ raw)

13391346

1340−complexNatbibCitation :: CitationMode -> LP Inlines

1347+complexNatbibCitation :: PandocMonad m => CitationMode -> LP m Inlines

13411348complexNatbibCitation mode = try $ do

13421349 let ils = (toList . trimInlines . mconcat) <$>

13431350 many (notFollowedBy (oneOf "\\};") >> inline)

@@ -1359,7 +1366,7 @@ complexNatbibCitation mode = try $ do

13591366

13601367-- tables

13611368

1362−parseAligns :: LP [Alignment]

1369+parseAligns :: PandocMonad m => LP m [Alignment]

13631370parseAligns = try $ do

13641371 char '{'

13651372 let maybeBar = skipMany $ sp <|> () <$ char '|' <|> () <$ (char '@' >> braced)

@@ -1375,7 +1382,7 @@ parseAligns = try $ do

13751382 spaces

13761383 return aligns'

13771384

1378−hline :: LP ()

1385+hline :: PandocMonad m => LP m ()

13791386hline = try $ do

13801387 spaces'

13811388 controlSeq "hline" <|>

@@ -1389,16 +1396,16 @@ hline = try $ do

13891396 optional $ bracketed (many1 (satisfy (/=']')))

13901397 return ()

13911398

1392−lbreak :: LP ()

1399+lbreak :: PandocMonad m => LP m ()

13931400lbreak = () <$ try (spaces' *>

13941401 (controlSeq "\\" <|> controlSeq "tabularnewline") <*

13951402 spaces')

13961403

1397−amp :: LP ()

1404+amp :: PandocMonad m => LP m ()

13981405amp = () <$ try (spaces' *> char '&' <* spaces')

13991406

1400−parseTableRow :: Int -- ^ number of columns

1401− -> LP [Blocks]

1407+parseTableRow :: PandocMonad m => Int -- ^ number of columns

1408+ -> LP m [Blocks]

14021409parseTableRow cols = try $ do

14031410 let tableCellInline = notFollowedBy (amp <|> lbreak) >> inline

14041411 let minipage = try $ controlSeq "begin" *> string "{minipage}" *>

@@ -1415,10 +1422,10 @@ parseTableRow cols = try $ do

14151422 spaces'

14161423 return cells''

14171424

1418−spaces' :: LP ()

1425+spaces' :: PandocMonad m => LP m ()

14191426spaces' = spaces *> skipMany (comment *> spaces)

14201427

1421−simpTable :: Bool -> LP Blocks

1428+simpTable :: PandocMonad m => Bool -> LP m Blocks

14221429simpTable hasWidthParameter = try $ do

14231430 when hasWidthParameter $ () <$ (spaces' >> tok)

14241431 skipopts

@@ -1442,13 +1449,13 @@ simpTable hasWidthParameter = try $ do

14421449 lookAhead $ controlSeq "end" -- make sure we're at end

14431450 return $ table mempty (zip aligns (repeat 0)) header'' rows

14441451

1445−startInclude :: LP Blocks

1452+startInclude :: PandocMonad m => LP m Blocks

14461453startInclude = do

14471454 fn <- braced

14481455 setPosition $ newPos fn 1 1

14491456 return mempty

14501457

1451−endInclude :: LP Blocks

1458+endInclude :: PandocMonad m => LP m Blocks

14521459endInclude = do

14531460 fn <- braced

14541461 ln <- braced

src/Text/Pandoc/Readers/Markdown.hs+257−221

@@ -1,5 +1,6 @@

11{-# LANGUAGE RelaxedPolyRec #-} -- needed for inlinesBetween on GHC < 7

22{-# LANGUAGE ScopedTypeVariables #-}

34{-

@@ -65,24 +66,31 @@ import qualified Data.Set as Set

6566import Text.Printf (printf)

6667import Debug.Trace (trace)

6768import Data.Monoid ((<>))

68−import Text.Pandoc.Error

69+import Control.Monad.Trans (lift)

70+import Control.Monad.Except (throwError, catchError)

71+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))

72+import qualified Text.Pandoc.Class as P

6973

70−type MarkdownParser = Parser [Char] ParserState

74+type MarkdownParser m = ParserT [Char] ParserState m

7175

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

73−readMarkdown :: ReaderOptions -- ^ Reader options

77+readMarkdown :: PandocMonad m

78+ => ReaderOptions -- ^ Reader options

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

75− -> Either PandocError Pandoc

76−readMarkdown opts s =

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

80+ -> m Pandoc

81+readMarkdown opts s = do

82+ parsed <- (readWithM parseMarkdown) def{ stateOptions = opts } (s ++ "\n\n")

83+ case parsed of

84+ Right result -> return result

85+ Left _ -> throwError $ PandocParseError "markdown parse error"

7886

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

8088-- and a list of warnings.

81−readMarkdownWithWarnings :: ReaderOptions -- ^ Reader options

89+readMarkdownWithWarnings :: PandocMonad m

90+ => ReaderOptions -- ^ Reader options

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

83− -> Either PandocError (Pandoc, [String])

84−readMarkdownWithWarnings opts s =

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

92+ -> m Pandoc

93+readMarkdownWithWarnings = readMarkdown

8694

8795trimInlinesF :: F Inlines -> F Inlines

8896trimInlinesF = liftM trimInlines

@@ -117,25 +125,25 @@ isBlank _ = False

117125--

118126

119127-- | Succeeds when we're in list context.

120−inList :: MarkdownParser ()

128+inList :: PandocMonad m => MarkdownParser m ()

121129inList = do

122130 ctx <- stateParserContext <$> getState

123131 guard (ctx == ListItemState)

124132

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

133+spnl :: PandocMonad m => ParserT [Char] st m ()

126134spnl = try $ do

127135 skipSpaces

128136 optional newline

129137 skipSpaces

130138 notFollowedBy (char '\n')

131139

132−indentSpaces :: MarkdownParser String

140+indentSpaces :: PandocMonad m => MarkdownParser m String

133141indentSpaces = try $ do

134142 tabStop <- getOption readerTabStop

135143 count tabStop (char ' ') <|>

136144 string "\t" <?> "indentation"

137145

138−nonindentSpaces :: MarkdownParser String

146+nonindentSpaces :: PandocMonad m => MarkdownParser m String

139147nonindentSpaces = do

140148 tabStop <- getOption readerTabStop

141149 sps <- many (char ' ')

@@ -144,17 +152,17 @@ nonindentSpaces = do

144152 else unexpected "indented line"

145153

146154-- returns number of spaces parsed

147−skipNonindentSpaces :: MarkdownParser Int

155+skipNonindentSpaces :: PandocMonad m => MarkdownParser m Int

148156skipNonindentSpaces = do

149157 tabStop <- getOption readerTabStop

150158 atMostSpaces (tabStop - 1) <* notFollowedBy (char ' ')

151159

152−atMostSpaces :: Int -> MarkdownParser Int

160+atMostSpaces :: PandocMonad m => Int -> MarkdownParser m Int

153161atMostSpaces n

154162 | n > 0 = (char ' ' >> (+1) <$> atMostSpaces (n-1)) <|> return 0

155163 | otherwise = return 0

156164

157−litChar :: MarkdownParser Char

165+litChar :: PandocMonad m => MarkdownParser m Char

158166litChar = escapedChar'

159167 <|> characterReference

160168 <|> noneOf "\n"

@@ -162,14 +170,14 @@ litChar = escapedChar'

162170

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

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

165−inlinesInBalancedBrackets :: MarkdownParser (F Inlines)

173+inlinesInBalancedBrackets :: PandocMonad m => MarkdownParser m (F Inlines)

166174inlinesInBalancedBrackets = do

167175 char '['

168176 (_, raw) <- withRaw $ charsInBalancedBrackets 1

169177 guard $ not $ null raw

170178 parseFromString (trimInlinesF . mconcat <$> many inline) (init raw)

171179

172−charsInBalancedBrackets :: Int -> MarkdownParser ()

180+charsInBalancedBrackets :: PandocMonad m => Int -> MarkdownParser m ()

173181charsInBalancedBrackets 0 = return ()

174182charsInBalancedBrackets openBrackets =

175183 (char '[' >> charsInBalancedBrackets (openBrackets + 1))

@@ -185,7 +193,7 @@ charsInBalancedBrackets openBrackets =

185193-- document structure

186194--

187195

188−rawTitleBlockLine :: MarkdownParser String

196+rawTitleBlockLine :: PandocMonad m => MarkdownParser m String

189197rawTitleBlockLine = do

190198 char '%'

191199 skipSpaces

@@ -196,13 +204,13 @@ rawTitleBlockLine = do

196204 anyLine

197205 return $ trim $ unlines (first:rest)

198206

199−titleLine :: MarkdownParser (F Inlines)

207+titleLine :: PandocMonad m => MarkdownParser m (F Inlines)

200208titleLine = try $ do

201209 raw <- rawTitleBlockLine

202210 res <- parseFromString (many inline) raw

203211 return $ trimInlinesF $ mconcat res

204212

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

213+authorsLine :: PandocMonad m => MarkdownParser m (F [Inlines])

206214authorsLine = try $ do

207215 raw <- rawTitleBlockLine

208216 let sep = (char ';' <* spaces) <|> newline

@@ -212,16 +220,16 @@ authorsLine = try $ do

212220 sep

213221 sequence <$> parseFromString pAuthors raw

214222

215−dateLine :: MarkdownParser (F Inlines)

223+dateLine :: PandocMonad m => MarkdownParser m (F Inlines)

216224dateLine = try $ do

217225 raw <- rawTitleBlockLine

218226 res <- parseFromString (many inline) raw

219227 return $ trimInlinesF $ mconcat res

220228

221−titleBlock :: MarkdownParser ()

229+titleBlock :: PandocMonad m => MarkdownParser m ()

222230titleBlock = pandocTitleBlock <|> mmdTitleBlock

223231

224−pandocTitleBlock :: MarkdownParser ()

232+pandocTitleBlock :: PandocMonad m => MarkdownParser m ()

225233pandocTitleBlock = try $ do

226234 guardEnabled Ext_pandoc_title_block

227235 lookAhead (char '%')

@@ -239,7 +247,15 @@ pandocTitleBlock = try $ do

239247 $ nullMeta

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

241249

242−yamlMetaBlock :: MarkdownParser (F Blocks)

250+

251+-- Adapted from solution at

252+-- http://stackoverflow.com/a/29448764/1901888

253+foldrWithKeyM :: Monad m => (k -> b -> a -> m a) -> a -> H.HashMap k b -> m a

254+foldrWithKeyM f acc = H.foldrWithKey f' (return acc)

255+ where

256+ f' k b ma = ma >>= \a -> f k b a

257+

258+yamlMetaBlock :: PandocMonad m => MarkdownParser m (F Blocks)

243259yamlMetaBlock = try $ do

244260 guardEnabled Ext_yaml_metadata_block

245261 pos <- getPosition

@@ -252,18 +268,20 @@ yamlMetaBlock = try $ do

252268 optional blanklines

253269 opts <- stateOptions <$> getState

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

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

256− H.foldrWithKey (\k v m ->

257− if ignorable k

258− then m

259− else case yamlToMeta opts v of

260− Left _ -> m

261− Right v' -> B.setMeta (T.unpack k) v' m)

262− nullMeta hashmap

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

271+ Right (Yaml.Object hashmap) ->

272+ foldrWithKeyM

273+ (\k v m -> do

274+ if ignorable k

275+ then return m

276+ else (do v' <- lift $ yamlToMeta opts v

277+ return $ B.setMeta (T.unpack k) v' m)

278+ `catchError`

279+ (\_ -> return m)

280+ ) nullMeta hashmap

281+ Right Yaml.Null -> return nullMeta

264282 Right _ -> do

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

266− return $ return nullMeta

283+ P.addWarningWithPos (Just pos) "YAML header is not an object"

284+ return nullMeta

267285 Left err' -> do

268286 case err' of

269287 InvalidYaml (Just YamlParseException{

@@ -273,24 +291,24 @@ yamlMetaBlock = try $ do

273291 yamlLine = yline

274292 , yamlColumn = ycol

275293 }}) ->

276− addWarning (Just $ setSourceLine

294+ P.addWarningWithPos (Just $ setSourceLine

277295 (setSourceColumn pos

278296 (sourceColumn pos + ycol))

279297 (sourceLine pos + 1 + yline))

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

281299 problem

282− _ -> addWarning (Just pos)

300+ _ -> P.addWarningWithPos (Just pos)

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

284302 show err'

285− return $ return nullMeta

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

303+ return nullMeta

304+ updateState $ \st -> st{ stateMeta' = stateMeta' st <> (return meta') }

287305 return mempty

288306

289307-- ignore fields ending with _

290308ignorable :: Text -> Bool

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

292310

293−toMetaValue :: ReaderOptions -> Text -> Either PandocError MetaValue

311+toMetaValue :: PandocMonad m => ReaderOptions -> Text -> m MetaValue

294312toMetaValue opts x = toMeta <$> readMarkdown opts' (T.unpack x)

295313 where

296314 toMeta p =

@@ -307,7 +325,7 @@ toMetaValue opts x = toMeta <$> readMarkdown opts' (T.unpack x)

307325 , Ext_yaml_metadata_block

308326 ]

309327

310−yamlToMeta :: ReaderOptions -> Yaml.Value -> Either PandocError MetaValue

328+yamlToMeta :: PandocMonad m => ReaderOptions -> Yaml.Value -> m MetaValue

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

312330yamlToMeta _ (Yaml.Number n)

313331 -- avoid decimal points for numbers that don't need them:

@@ -327,10 +345,10 @@ yamlToMeta opts (Yaml.Object o) = MetaMap <$> H.foldrWithKey (\k v m ->

327345 (return M.empty) o

328346yamlToMeta _ _ = return $ MetaString ""

329347

330−stopLine :: MarkdownParser ()

348+stopLine :: PandocMonad m => MarkdownParser m ()

331349stopLine = try $ (string "---" <|> string "...") >> blankline >> return ()

332350

333−mmdTitleBlock :: MarkdownParser ()

351+mmdTitleBlock :: PandocMonad m => MarkdownParser m ()

334352mmdTitleBlock = try $ do

335353 guardEnabled Ext_mmd_title_block

336354 firstPair <- kvPair False

@@ -340,7 +358,7 @@ mmdTitleBlock = try $ do

340358 updateState $ \st -> st{ stateMeta' = stateMeta' st <>

341359 return (Meta $ M.fromList kvPairs) }

342360

343−kvPair :: Bool -> MarkdownParser (String, MetaValue)

361+kvPair :: PandocMonad m => Bool -> MarkdownParser m (String, MetaValue)

344362kvPair allowEmpty = try $ do

345363 key <- many1Till (alphaNum <|> oneOf "_- ") (char ':')

346364 val <- trim <$> manyTill anyChar

@@ -350,7 +368,7 @@ kvPair allowEmpty = try $ do

350368 let val' = MetaBlocks $ B.toList $ B.plain $ B.text $ val

351369 return (key',val')

352370

353−parseMarkdown :: MarkdownParser Pandoc

371+parseMarkdown :: PandocMonad m => MarkdownParser m Pandoc

354372parseMarkdown = do

355373 -- markdown allows raw HTML

356374 updateState $ \state -> state { stateOptions =

@@ -375,7 +393,7 @@ softBreakFilter (x:SoftBreak:y:zs) =

375393 _ -> x:SoftBreak:y:zs

376394softBreakFilter xs = xs

377395

378−referenceKey :: MarkdownParser (F Blocks)

396+referenceKey :: PandocMonad m => MarkdownParser m (F Blocks)

379397referenceKey = try $ do

380398 pos <- getPosition

381399 skipNonindentSpaces

@@ -402,18 +420,18 @@ referenceKey = try $ do

402420 let oldkeys = stateKeys st

403421 let key = toKey raw

404422 case M.lookup key oldkeys of

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

423+ Just _ -> P.addWarningWithPos (Just pos) $ "Duplicate link reference `" ++ raw ++ "'"

406424 Nothing -> return ()

407425 updateState $ \s -> s { stateKeys = M.insert key (target, attr') oldkeys }

408426 return $ return mempty

409427

410−referenceTitle :: MarkdownParser String

428+referenceTitle :: PandocMonad m => MarkdownParser m String

411429referenceTitle = try $ do

412430 skipSpaces >> optional newline >> skipSpaces

413431 quotedTitle '"' <|> quotedTitle '\'' <|> charsInBalanced '(' ')' litChar

414432

415433-- A link title in quotes

416−quotedTitle :: Char -> MarkdownParser String

434+quotedTitle :: PandocMonad m => Char -> MarkdownParser m String

417435quotedTitle c = try $ do

418436 char c

419437 notFollowedBy spaces

@@ -425,7 +443,7 @@ quotedTitle c = try $ do

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

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

427445-- an abbreviation.

428−abbrevKey :: MarkdownParser (F Blocks)

446+abbrevKey :: PandocMonad m => MarkdownParser m (F Blocks)

429447abbrevKey = do

430448 guardEnabled Ext_abbreviations

431449 try $ do

@@ -436,23 +454,23 @@ abbrevKey = do

436454 blanklines

437455 return $ return mempty

438456

439−noteMarker :: MarkdownParser String

457+noteMarker :: PandocMonad m => MarkdownParser m String

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

441459

442−rawLine :: MarkdownParser String

460+rawLine :: PandocMonad m => MarkdownParser m String

443461rawLine = try $ do

444462 notFollowedBy blankline

445463 notFollowedBy' $ try $ skipNonindentSpaces >> noteMarker

446464 optional indentSpaces

447465 anyLine

448466

449−rawLines :: MarkdownParser String

467+rawLines :: PandocMonad m => MarkdownParser m String

450468rawLines = do

451469 first <- anyLine

452470 rest <- many rawLine

453471 return $ unlines (first:rest)

454472

455−noteBlock :: MarkdownParser (F Blocks)

473+noteBlock :: PandocMonad m => MarkdownParser m (F Blocks)

456474noteBlock = try $ do

457475 pos <- getPosition

458476 skipNonindentSpaces

@@ -468,7 +486,7 @@ noteBlock = try $ do

468486 let newnote = (ref, parsed)

469487 oldnotes <- stateNotes' <$> getState

470488 case lookup ref oldnotes of

471− Just _ -> addWarning (Just pos) $ "Duplicate note reference `" ++ ref ++ "'"

489+ Just _ -> P.addWarningWithPos (Just pos) $ "Duplicate note reference `" ++ ref ++ "'"

472490 Nothing -> return ()

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

474492 return mempty

@@ -477,10 +495,10 @@ noteBlock = try $ do

477495-- parsing blocks

478496--

479497

480−parseBlocks :: MarkdownParser (F Blocks)

498+parseBlocks :: PandocMonad m => MarkdownParser m (F Blocks)

481499parseBlocks = mconcat <$> manyTill block eof

482500

483−block :: MarkdownParser (F Blocks)

501+block :: PandocMonad m => MarkdownParser m (F Blocks)

484502block = do

485503 tr <- getOption readerTrace

486504 pos <- getPosition

@@ -519,16 +537,16 @@ block = do

519537-- header blocks

520538--

521539

522−header :: MarkdownParser (F Blocks)

540+header :: PandocMonad m => MarkdownParser m (F Blocks)

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

524542

525−atxChar :: MarkdownParser Char

543+atxChar :: PandocMonad m => MarkdownParser m Char

526544atxChar = do

527545 exts <- getOption readerExtensions

528546 return $ if Set.member Ext_literate_haskell exts

529547 then '=' else '#'

530548

531−atxHeader :: MarkdownParser (F Blocks)

549+atxHeader :: PandocMonad m => MarkdownParser m (F Blocks)

532550atxHeader = try $ do

533551 level <- atxChar >>= many1 . char >>= return . length

534552 notFollowedBy $ guardEnabled Ext_fancy_lists >>

@@ -542,7 +560,7 @@ atxHeader = try $ do

542560 <|> registerImplicitHeader raw attr'

543561 return $ B.headerWith attr' level <$> text

544562

545−atxClosing :: MarkdownParser Attr

563+atxClosing :: PandocMonad m => MarkdownParser m Attr

546564atxClosing = try $ do

547565 attr' <- option nullAttr

548566 (guardEnabled Ext_mmd_header_identifiers >> mmdHeaderIdentifier)

@@ -553,7 +571,7 @@ atxClosing = try $ do

553571 blanklines

554572 return attr

555573

556−setextHeaderEnd :: MarkdownParser Attr

574+setextHeaderEnd :: PandocMonad m => MarkdownParser m Attr

557575setextHeaderEnd = try $ do

558576 attr <- option nullAttr

559577 $ (guardEnabled Ext_mmd_header_identifiers >> mmdHeaderIdentifier)

@@ -561,13 +579,13 @@ setextHeaderEnd = try $ do

561579 blanklines

562580 return attr

563581

564−mmdHeaderIdentifier :: MarkdownParser Attr

582+mmdHeaderIdentifier :: PandocMonad m => MarkdownParser m Attr

565583mmdHeaderIdentifier = do

566584 ident <- stripFirstAndLast . snd <$> reference

567585 skipSpaces

568586 return (ident,[],[])

569587

570−setextHeader :: MarkdownParser (F Blocks)

588+setextHeader :: PandocMonad m => MarkdownParser m (F Blocks)

571589setextHeader = try $ do

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

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

@@ -585,7 +603,7 @@ setextHeader = try $ do

585603 <|> registerImplicitHeader raw attr'

586604 return $ B.headerWith attr' level <$> text

587605

588−registerImplicitHeader :: String -> Attr -> MarkdownParser ()

606+registerImplicitHeader :: PandocMonad m => String -> Attr -> MarkdownParser m ()

589607registerImplicitHeader raw attr@(ident, _, _) = do

590608 let key = toKey $ "[" ++ raw ++ "]"

591609 updateState (\s -> s { stateHeaderKeys =

@@ -595,7 +613,7 @@ registerImplicitHeader raw attr@(ident, _, _) = do

595613-- hrule block

596614--

597615

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

616+hrule :: PandocMonad m => ParserT [Char] st m (F Blocks)

599617hrule = try $ do

600618 skipSpaces

601619 start <- satisfy isHruleChar

@@ -609,12 +627,13 @@ hrule = try $ do

609627-- code blocks

610628--

611629

612−indentedLine :: MarkdownParser String

630+indentedLine :: PandocMonad m => MarkdownParser m String

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

614632

615−blockDelimiter :: (Char -> Bool)

633+blockDelimiter :: PandocMonad m

634+ => (Char -> Bool)

616635 -> Maybe Int

617− -> Parser [Char] st Int

636+ -> ParserT [Char] st m Int

618637blockDelimiter f len = try $ do

619638 c <- lookAhead (satisfy f)

620639 case len of

@@ -622,7 +641,7 @@ blockDelimiter f len = try $ do

622641 Nothing -> count 3 (char c) >> many (char c) >>=

623642 return . (+ 3) . length

624643

625−attributes :: MarkdownParser Attr

644+attributes :: PandocMonad m => MarkdownParser m Attr

626645attributes = try $ do

627646 char '{'

628647 spnl

@@ -630,28 +649,28 @@ attributes = try $ do

630649 char '}'

631650 return $ foldl (\x f -> f x) nullAttr attrs

632651

633−attribute :: MarkdownParser (Attr -> Attr)

652+attribute :: PandocMonad m => MarkdownParser m (Attr -> Attr)

634653attribute = identifierAttr <|> classAttr <|> keyValAttr <|> specialAttr

635654

636−identifier :: MarkdownParser String

655+identifier :: PandocMonad m => MarkdownParser m String

637656identifier = do

638657 first <- letter

639658 rest <- many $ alphaNum <|> oneOf "-_:."

640659 return (first:rest)

641660

642−identifierAttr :: MarkdownParser (Attr -> Attr)

661+identifierAttr :: PandocMonad m => MarkdownParser m (Attr -> Attr)

643662identifierAttr = try $ do

644663 char '#'

645664 result <- identifier

646665 return $ \(_,cs,kvs) -> (result,cs,kvs)

647666

648−classAttr :: MarkdownParser (Attr -> Attr)

667+classAttr :: PandocMonad m => MarkdownParser m (Attr -> Attr)

649668classAttr = try $ do

650669 char '.'

651670 result <- identifier

652671 return $ \(id',cs,kvs) -> (id',cs ++ [result],kvs)

653672

654−keyValAttr :: MarkdownParser (Attr -> Attr)

673+keyValAttr :: PandocMonad m => MarkdownParser m (Attr -> Attr)

655674keyValAttr = try $ do

656675 key <- identifier

657676 char '='

@@ -664,12 +683,12 @@ keyValAttr = try $ do

664683 "class" -> (id',cs ++ words val,kvs)

665684 _ -> (id',cs,kvs ++ [(key,val)])

666685

667−specialAttr :: MarkdownParser (Attr -> Attr)

686+specialAttr :: PandocMonad m => MarkdownParser m (Attr -> Attr)

668687specialAttr = do

669688 char '-'

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

671690

672−codeBlockFenced :: MarkdownParser (F Blocks)

691+codeBlockFenced :: PandocMonad m => MarkdownParser m (F Blocks)

673692codeBlockFenced = try $ do

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

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

@@ -690,7 +709,7 @@ toLanguageId = map toLower . go

690709 go "objective-c" = "objectivec"

691710 go x = x

692711

693−codeBlockIndented :: MarkdownParser (F Blocks)

712+codeBlockIndented :: PandocMonad m => MarkdownParser m (F Blocks)

694713codeBlockIndented = do

695714 contents <- many1 (indentedLine <|>

696715 try (do b <- blanklines

@@ -701,7 +720,7 @@ codeBlockIndented = do

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

702721 stripTrailingNewlines $ concat contents

703722

704−lhsCodeBlock :: MarkdownParser (F Blocks)

723+lhsCodeBlock :: PandocMonad m => MarkdownParser m (F Blocks)

705724lhsCodeBlock = do

706725 guardEnabled Ext_literate_haskell

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

@@ -709,7 +728,7 @@ lhsCodeBlock = do

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

710729 lhsCodeBlockInverseBird)

711730

712−lhsCodeBlockLaTeX :: MarkdownParser String

731+lhsCodeBlockLaTeX :: PandocMonad m => MarkdownParser m String

713732lhsCodeBlockLaTeX = try $ do

714733 string "\\begin{code}"

715734 manyTill spaceChar newline

@@ -717,13 +736,13 @@ lhsCodeBlockLaTeX = try $ do

717736 blanklines

718737 return $ stripTrailingNewlines contents

719738

720−lhsCodeBlockBird :: MarkdownParser String

739+lhsCodeBlockBird :: PandocMonad m => MarkdownParser m String

721740lhsCodeBlockBird = lhsCodeBlockBirdWith '>'

722741

723−lhsCodeBlockInverseBird :: MarkdownParser String

742+lhsCodeBlockInverseBird :: PandocMonad m => MarkdownParser m String

724743lhsCodeBlockInverseBird = lhsCodeBlockBirdWith '<'

725744

726−lhsCodeBlockBirdWith :: Char -> MarkdownParser String

745+lhsCodeBlockBirdWith :: PandocMonad m => Char -> MarkdownParser m String

727746lhsCodeBlockBirdWith c = try $ do

728747 pos <- getPosition

729748 when (sourceColumn pos /= 1) $ fail "Not in first column"

@@ -735,7 +754,7 @@ lhsCodeBlockBirdWith c = try $ do

735754 blanklines

736755 return $ intercalate "\n" lns'

737756

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

757+birdTrackLine :: PandocMonad m => Char -> ParserT [Char] st m String

739758birdTrackLine c = try $ do

740759 char c

741760 -- allow html tags on left margin:

@@ -746,10 +765,10 @@ birdTrackLine c = try $ do

746765-- block quotes

747766--

748767

749−emailBlockQuoteStart :: MarkdownParser Char

768+emailBlockQuoteStart :: PandocMonad m => MarkdownParser m Char

750769emailBlockQuoteStart = try $ skipNonindentSpaces >> char '>' <* optional (char ' ')

751770

752−emailBlockQuote :: MarkdownParser [String]

771+emailBlockQuote :: PandocMonad m => MarkdownParser m [String]

753772emailBlockQuote = try $ do

754773 emailBlockQuoteStart

755774 let emailLine = many $ nonEndline <|> try

@@ -763,7 +782,7 @@ emailBlockQuote = try $ do

763782 optional blanklines

764783 return raw

765784

766−blockQuote :: MarkdownParser (F Blocks)

785+blockQuote :: PandocMonad m => MarkdownParser m (F Blocks)

767786blockQuote = do

768787 raw <- emailBlockQuote

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

@@ -774,7 +793,7 @@ blockQuote = do

774793-- list blocks

775794--

776795

777−bulletListStart :: MarkdownParser ()

796+bulletListStart :: PandocMonad m => MarkdownParser m ()

778797bulletListStart = try $ do

779798 optional newline -- if preceded by a Plain block in a list context

780799 startpos <- sourceColumn <$> getPosition

@@ -786,7 +805,7 @@ bulletListStart = try $ do

786805 lookAhead (newline <|> spaceChar)

787806 () <$ atMostSpaces (tabStop - (endpos - startpos))

788807

789−anyOrderedListStart :: MarkdownParser (Int, ListNumberStyle, ListNumberDelim)

808+anyOrderedListStart :: PandocMonad m => MarkdownParser m (Int, ListNumberStyle, ListNumberDelim)

790809anyOrderedListStart = try $ do

791810 optional newline -- if preceded by a Plain block in a list context

792811 startpos <- sourceColumn <$> getPosition

@@ -810,10 +829,10 @@ anyOrderedListStart = try $ do

810829 atMostSpaces (tabStop - (endpos - startpos))

811830 return res

812831

813−listStart :: MarkdownParser ()

832+listStart :: PandocMonad m => MarkdownParser m ()

814833listStart = bulletListStart <|> (anyOrderedListStart >> return ())

815834

816−listLine :: MarkdownParser String

835+listLine :: PandocMonad m => MarkdownParser m String

817836listLine = try $ do

818837 notFollowedBy' (do indentSpaces

819838 many spaceChar

@@ -822,7 +841,7 @@ listLine = try $ do

822841 optional (() <$ indentSpaces)

823842 listLineCommon

824843

825−listLineCommon :: MarkdownParser String

844+listLineCommon :: PandocMonad m => MarkdownParser m String

826845listLineCommon = concat <$> manyTill

827846 ( many1 (satisfy $ \c -> c /= '\n' && c /= '<')

828847 <|> liftM snd (htmlTag isCommentTag)

@@ -830,8 +849,9 @@ listLineCommon = concat <$> manyTill

830849 ) newline

831850

832851-- parse raw text for one list item, excluding start marker and continuations

833−rawListItem :: MarkdownParser a

834− -> MarkdownParser String

852+rawListItem :: PandocMonad m

853+ => MarkdownParser m a

854+ -> MarkdownParser m String

835855rawListItem start = try $ do

836856 start

837857 first <- listLineCommon

@@ -842,21 +862,21 @@ rawListItem start = try $ do

842862-- continuation of a list item - indented and separated by blankline

843863-- or (in compact lists) endline.

844864-- note: nested lists are parsed as continuations

845−listContinuation :: MarkdownParser String

865+listContinuation :: PandocMonad m => MarkdownParser m String

846866listContinuation = try $ do

847867 lookAhead indentSpaces

848868 result <- many1 listContinuationLine

849869 blanks <- many blankline

850870 return $ concat result ++ blanks

851871

852−notFollowedByHtmlCloser :: MarkdownParser ()

872+notFollowedByHtmlCloser :: PandocMonad m => MarkdownParser m ()

853873notFollowedByHtmlCloser = do

854874 inHtmlBlock <- stateInHtmlBlock <$> getState

855875 case inHtmlBlock of

856876 Just t -> notFollowedBy' $ htmlTag (~== TagClose t)

857877 Nothing -> return ()

858878

859−listContinuationLine :: MarkdownParser String

879+listContinuationLine :: PandocMonad m => MarkdownParser m String

860880listContinuationLine = try $ do

861881 notFollowedBy blankline

862882 notFollowedBy' listStart

@@ -865,8 +885,9 @@ listContinuationLine = try $ do

865885 result <- anyLine

866886 return $ result ++ "\n"

867887

868−listItem :: MarkdownParser a

869− -> MarkdownParser (F Blocks)

888+listItem :: PandocMonad m

889+ => MarkdownParser m a

890+ -> MarkdownParser m (F Blocks)

870891listItem start = try $ do

871892 first <- rawListItem start

872893 continuations <- many listContinuation

@@ -882,7 +903,7 @@ listItem start = try $ do

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

883904 return contents

884905

885−orderedList :: MarkdownParser (F Blocks)

906+orderedList :: PandocMonad m => MarkdownParser m (F Blocks)

886907orderedList = try $ do

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

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

@@ -903,14 +924,14 @@ orderedList = try $ do

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

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

905926

906−bulletList :: MarkdownParser (F Blocks)

927+bulletList :: PandocMonad m => MarkdownParser m (F Blocks)

907928bulletList = do

908929 items <- fmap sequence $ many1 $ listItem bulletListStart

909930 return $ B.bulletList <$> fmap compactify' items

910931

911932-- definition lists

912933

913−defListMarker :: MarkdownParser ()

934+defListMarker :: PandocMonad m => MarkdownParser m ()

914935defListMarker = do

915936 sps <- nonindentSpaces

916937 char ':' <|> char '~'

@@ -921,7 +942,7 @@ defListMarker = do

921942 else mzero

922943 return ()

923944

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

945+definitionListItem :: PandocMonad m => Bool -> MarkdownParser m (F (Inlines, [Blocks]))

925946definitionListItem compact = try $ do

926947 rawLine' <- anyLine

927948 raw <- many1 $ defRawBlock compact

@@ -930,7 +951,7 @@ definitionListItem compact = try $ do

930951 optional blanklines

931952 return $ liftM2 (,) term (sequence contents)

932953

933−defRawBlock :: Bool -> MarkdownParser String

954+defRawBlock :: PandocMonad m => Bool -> MarkdownParser m String

934955defRawBlock compact = try $ do

935956 hasBlank <- option False $ blankline >> return True

936957 defListMarker

@@ -952,7 +973,7 @@ defRawBlock compact = try $ do

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

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

954975

955−definitionList :: MarkdownParser (F Blocks)

976+definitionList :: PandocMonad m => MarkdownParser m (F Blocks)

956977definitionList = try $ do

957978 lookAhead (anyLine >>

958979 optional (blankline >> notFollowedBy (table >> return ())) >>

@@ -960,13 +981,13 @@ definitionList = try $ do

960981 defListMarker)

961982 compactDefinitionList <|> normalDefinitionList

962983

963−compactDefinitionList :: MarkdownParser (F Blocks)

984+compactDefinitionList :: PandocMonad m => MarkdownParser m (F Blocks)

964985compactDefinitionList = do

965986 guardEnabled Ext_compact_definition_lists

966987 items <- fmap sequence $ many1 $ definitionListItem True

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

968989

969−normalDefinitionList :: MarkdownParser (F Blocks)

990+normalDefinitionList :: PandocMonad m => MarkdownParser m (F Blocks)

970991normalDefinitionList = do

971992 guardEnabled Ext_definition_lists

972993 items <- fmap sequence $ many1 $ definitionListItem False

@@ -976,7 +997,7 @@ normalDefinitionList = do

976997-- paragraph block

977998--

978999

979−para :: MarkdownParser (F Blocks)

1000+para :: PandocMonad m => MarkdownParser m (F Blocks)

9801001para = try $ do

9811002 exts <- getOption readerExtensions

9821003 result <- trimInlinesF . mconcat <$> many1 inline

@@ -1007,19 +1028,19 @@ para = try $ do

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

10081029 _ -> return $ B.para result'

10091030

1010−plain :: MarkdownParser (F Blocks)

1031+plain :: PandocMonad m => MarkdownParser m (F Blocks)

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

10121033

10131034--

10141035-- raw html

10151036--

10161037

1017−htmlElement :: MarkdownParser String

1038+htmlElement :: PandocMonad m => MarkdownParser m String

10181039htmlElement = rawVerbatimBlock

10191040 <|> strictHtmlBlock

10201041 <|> liftM snd (htmlTag isBlockTag)

10211042

1022−htmlBlock :: MarkdownParser (F Blocks)

1043+htmlBlock :: PandocMonad m => MarkdownParser m (F Blocks)

10231044htmlBlock = do

10241045 guardEnabled Ext_raw_html

10251046 try (do

@@ -1044,24 +1065,24 @@ htmlBlock = do

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

10451066 <|> htmlBlock'

10461067

1047−htmlBlock' :: MarkdownParser (F Blocks)

1068+htmlBlock' :: PandocMonad m => MarkdownParser m (F Blocks)

10481069htmlBlock' = try $ do

10491070 first <- htmlElement

10501071 skipMany spaceChar

10511072 optional blanklines

10521073 return $ return $ B.rawBlock "html" first

10531074

1054−strictHtmlBlock :: MarkdownParser String

1075+strictHtmlBlock :: PandocMonad m => MarkdownParser m String

10551076strictHtmlBlock = htmlInBalanced (not . isInlineTag)

10561077

1057−rawVerbatimBlock :: MarkdownParser String

1078+rawVerbatimBlock :: PandocMonad m => MarkdownParser m String

10581079rawVerbatimBlock = htmlInBalanced isVerbTag

10591080 where isVerbTag (TagOpen "pre" _) = True

10601081 isVerbTag (TagOpen "style" _) = True

10611082 isVerbTag (TagOpen "script" _) = True

10621083 isVerbTag _ = False

10631084

1064−rawTeXBlock :: MarkdownParser (F Blocks)

1085+rawTeXBlock :: PandocMonad m => MarkdownParser m (F Blocks)

10651086rawTeXBlock = do

10661087 guardEnabled Ext_raw_tex

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

@@ -1071,7 +1092,7 @@ rawTeXBlock = do

10711092 spaces

10721093 return $ return result

10731094

1074−rawHtmlBlocks :: MarkdownParser (F Blocks)

1095+rawHtmlBlocks :: PandocMonad m => MarkdownParser m (F Blocks)

10751096rawHtmlBlocks = do

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

10771098 -- try to find closing tag

@@ -1101,7 +1122,7 @@ stripMarkdownAttribute s = renderTags' $ map filterAttrib $ parseTags s

11011122-- line block

11021123--

11031124

1104−lineBlock :: MarkdownParser (F Blocks)

1125+lineBlock :: PandocMonad m => MarkdownParser m (F Blocks)

11051126lineBlock = try $ do

11061127 guardEnabled Ext_line_blocks

11071128 lines' <- lineBlockLines >>=

@@ -1114,8 +1135,9 @@ lineBlock = try $ do

11141135

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

11161137-- and the length including trailing space.

1117−dashedLine :: Char

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

1138+dashedLine :: PandocMonad m

1139+ => Char

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

11191141dashedLine ch = do

11201142 dashes <- many1 (char ch)

11211143 sp <- many spaceChar

@@ -1125,8 +1147,9 @@ dashedLine ch = do

11251147

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

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

1128−simpleTableHeader :: Bool -- ^ Headerless table

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

1150+simpleTableHeader :: PandocMonad m

1151+ => Bool -- ^ Headerless table

1152+ -> MarkdownParser m (F [Blocks], [Alignment], [Int])

11301153simpleTableHeader headless = try $ do

11311154 rawContent <- if headless

11321155 then return ""

@@ -1170,16 +1193,17 @@ alignType strLst len =

11701193 (False, False) -> AlignDefault

11711194

11721195-- Parse a table footer - dashed lines followed by blank line.

1173−tableFooter :: MarkdownParser String

1196+tableFooter :: PandocMonad m => MarkdownParser m String

11741197tableFooter = try $ skipNonindentSpaces >> many1 (dashedLine '-') >> blanklines

11751198

11761199-- Parse a table separator - dashed line.

1177−tableSep :: MarkdownParser Char

1200+tableSep :: PandocMonad m => MarkdownParser m Char

11781201tableSep = try $ skipNonindentSpaces >> many1 (dashedLine '-') >> char '\n'

11791202

11801203-- Parse a raw line and split it into chunks by indices.

1181−rawTableLine :: [Int]

1182− -> MarkdownParser [String]

1204+rawTableLine :: PandocMonad m

1205+ => [Int]

1206+ -> MarkdownParser m [String]

11831207rawTableLine indices = do

11841208 notFollowedBy' (blanklines <|> tableFooter)

11851209 line <- many1Till anyChar newline

@@ -1187,14 +1211,16 @@ rawTableLine indices = do

11871211 splitStringByIndices (init indices) line

11881212

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

1190−tableLine :: [Int]

1191− -> MarkdownParser (F [Blocks])

1214+tableLine :: PandocMonad m

1215+ => [Int]

1216+ -> MarkdownParser m (F [Blocks])

11921217tableLine indices = rawTableLine indices >>=

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

11941219

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

1196−multilineRow :: [Int]

1197− -> MarkdownParser (F [Blocks])

1221+multilineRow :: PandocMonad m

1222+ => [Int]

1223+ -> MarkdownParser m (F [Blocks])

11981224multilineRow indices = do

11991225 colLines <- many1 (rawTableLine indices)

12001226 let cols = map unlines $ transpose colLines

@@ -1202,7 +1228,7 @@ multilineRow indices = do

12021228

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

12041230-- and followed by blank lines.

1205−tableCaption :: MarkdownParser (F Inlines)

1231+tableCaption :: PandocMonad m => MarkdownParser m (F Inlines)

12061232tableCaption = try $ do

12071233 guardEnabled Ext_table_captions

12081234 skipNonindentSpaces

@@ -1210,8 +1236,9 @@ tableCaption = try $ do

12101236 trimInlinesF . mconcat <$> many1 inline <* blanklines

12111237

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

1213−simpleTable :: Bool -- ^ Headerless table

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

1239+simpleTable :: PandocMonad m

1240+ => Bool -- ^ Headerless table

1241+ -> MarkdownParser m ([Alignment], [Double], F [Blocks], F [[Blocks]])

12151242simpleTable headless = do

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

12171244 tableWith (simpleTableHeader headless) tableLine

@@ -1224,13 +1251,15 @@ simpleTable headless = do

12241251-- (which may be multiline), then the rows,

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

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

1227−multilineTable :: Bool -- ^ Headerless table

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

1254+multilineTable :: PandocMonad m

1255+ => Bool -- ^ Headerless table

1256+ -> MarkdownParser m ([Alignment], [Double], F [Blocks], F [[Blocks]])

12291257multilineTable headless =

12301258 tableWith (multilineTableHeader headless) multilineRow blanklines tableFooter

12311259

1232−multilineTableHeader :: Bool -- ^ Headerless table

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

1260+multilineTableHeader :: PandocMonad m

1261+ => Bool -- ^ Headerless table

1262+ -> MarkdownParser m (F [Blocks], [Alignment], [Int])

12341263multilineTableHeader headless = try $ do

12351264 unless headless $

12361265 tableSep >> notFollowedBy blankline

@@ -1261,8 +1290,8 @@ multilineTableHeader headless = try $ do

12611290-- (which may be grid), then the rows,

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

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

1264−gridTable :: Bool -- ^ Headerless table

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

1293+gridTable :: PandocMonad m => Bool -- ^ Headerless table

1294+ -> MarkdownParser m ([Alignment], [Double], F [Blocks], F [[Blocks]])

12661295gridTable headless =

12671296 tableWith (gridTableHeader headless) gridTableRow

12681297 (gridTableSep '-') gridTableFooter

@@ -1271,7 +1300,7 @@ gridTableSplitLine :: [Int] -> String -> [String]

12711300gridTableSplitLine indices line = map removeFinalBar $ tail $

12721301 splitStringByIndices (init indices) $ trimr line

12731302

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

1303+gridPart :: PandocMonad m => Char -> ParserT [Char] st m ((Int, Int), Alignment)

12751304gridPart ch = do

12761305 leftColon <- option False (True <$ char ':')

12771306 dashes <- many1 (char ch)

@@ -1286,7 +1315,7 @@ gridPart ch = do

12861315 (False, False) -> AlignDefault

12871316 return ((lengthDashes, lengthDashes + 1), alignment)

12881317

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

1318+gridDashedLines :: PandocMonad m => Char -> ParserT [Char] st m [((Int, Int), Alignment)]

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

12911320

12921321removeFinalBar :: String -> String

@@ -1294,12 +1323,12 @@ removeFinalBar =

12941323 reverse . dropWhile (`elem` " \t") . dropWhile (=='|') . reverse

12951324

12961325-- | Separator between rows of grid table.

1297−gridTableSep :: Char -> MarkdownParser Char

1326+gridTableSep :: PandocMonad m => Char -> MarkdownParser m Char

12981327gridTableSep ch = try $ gridDashedLines ch >> return '\n'

12991328

13001329-- | Parse header for a grid table.

1301−gridTableHeader :: Bool -- ^ Headerless table

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

1330+gridTableHeader :: PandocMonad m => Bool -- ^ Headerless table

1331+ -> MarkdownParser m (F [Blocks], [Alignment], [Int])

13031332gridTableHeader headless = try $ do

13041333 optional blanklines

13051334 dashes <- gridDashedLines '-'

@@ -1320,15 +1349,15 @@ gridTableHeader headless = try $ do

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

13211350 return (heads, aligns, indices)

13221351

1323−gridTableRawLine :: [Int] -> MarkdownParser [String]

1352+gridTableRawLine :: PandocMonad m => [Int] -> MarkdownParser m [String]

13241353gridTableRawLine indices = do

13251354 char '|'

13261355 line <- anyLine

13271356 return (gridTableSplitLine indices line)

13281357

13291358-- | Parse row of grid table.

1330−gridTableRow :: [Int]

1331− -> MarkdownParser (F [Blocks])

1359+gridTableRow :: PandocMonad m => [Int]

1360+ -> MarkdownParser m (F [Blocks])

13321361gridTableRow indices = do

13331362 colLines <- many1 (gridTableRawLine indices)

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

@@ -1344,10 +1373,10 @@ removeOneLeadingSpace xs =

13441373 startsWithSpace (y:_) = y == ' '

13451374

13461375-- | Parse footer for a grid table.

1347−gridTableFooter :: MarkdownParser [Char]

1376+gridTableFooter :: PandocMonad m => MarkdownParser m [Char]

13481377gridTableFooter = blanklines

13491378

1350−pipeBreak :: MarkdownParser ([Alignment], [Int])

1379+pipeBreak :: PandocMonad m => MarkdownParser m ([Alignment], [Int])

13511380pipeBreak = try $ do

13521381 nonindentSpaces

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

@@ -1359,7 +1388,7 @@ pipeBreak = try $ do

13591388 blankline

13601389 return $ unzip (first:rest)

13611390

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

1391+pipeTable :: PandocMonad m => MarkdownParser m ([Alignment], [Double], F [Blocks], F [[Blocks]])

13631392pipeTable = try $ do

13641393 nonindentSpaces

13651394 lookAhead nonspaceChar

@@ -1377,13 +1406,13 @@ pipeTable = try $ do

13771406 else replicate (length aligns) 0.0

13781407 return $ (aligns, widths, heads', sequence lines'')

13791408

1380−sepPipe :: MarkdownParser ()

1409+sepPipe :: PandocMonad m => MarkdownParser m ()

13811410sepPipe = try $ do

13821411 char '|' <|> char '+'

13831412 notFollowedBy blankline

13841413

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

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

1415+pipeTableRow :: PandocMonad m => MarkdownParser m (F [Blocks])

13871416pipeTableRow = try $ do

13881417 scanForPipe

13891418 skipMany spaceChar

@@ -1399,14 +1428,14 @@ pipeTableRow = try $ do

13991428 blankline

14001429 return $ sequence cells

14011430

1402−pipeTableCell :: MarkdownParser (F Blocks)

1431+pipeTableCell :: PandocMonad m => MarkdownParser m (F Blocks)

14031432pipeTableCell = do

14041433 result <- many inline

14051434 if null result

14061435 then return mempty

14071436 else return $ B.plain . mconcat <$> sequence result

14081437

1409−pipeTableHeaderPart :: Parser [Char] st (Alignment, Int)

1438+pipeTableHeaderPart :: PandocMonad m => ParserT [Char] st m (Alignment, Int)

14101439pipeTableHeaderPart = try $ do

14111440 skipMany spaceChar

14121441 left <- optionMaybe (char ':')

@@ -1422,7 +1451,7 @@ pipeTableHeaderPart = try $ do

14221451 (Just _,Just _) -> AlignCenter), len)

14231452

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

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

1454+scanForPipe :: PandocMonad m => ParserT [Char] st m ()

14261455scanForPipe = do

14271456 inp <- getInput

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

@@ -1432,11 +1461,12 @@ scanForPipe = do

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

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

14341463-- Text.Pandoc.Parsing.

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

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

1437− -> MarkdownParser sep

1438− -> MarkdownParser end

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

1464+tableWith :: PandocMonad m

1465+ => MarkdownParser m (F [Blocks], [Alignment], [Int])

1466+ -> ([Int] -> MarkdownParser m (F [Blocks]))

1467+ -> MarkdownParser m sep

1468+ -> MarkdownParser m end

1469+ -> MarkdownParser m ([Alignment], [Double], F [Blocks], F [[Blocks]])

14401470tableWith headerParser rowParser lineParser footerParser = try $ do

14411471 (heads, aligns, indices) <- headerParser

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

@@ -1447,7 +1477,7 @@ tableWith headerParser rowParser lineParser footerParser = try $ do

14471477 else widthsFromIndices numColumns indices

14481478 return $ (aligns, widths, heads, lines')

14491479

1450−table :: MarkdownParser (F Blocks)

1480+table :: PandocMonad m => MarkdownParser m (F Blocks)

14511481table = try $ do

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

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

@@ -1479,7 +1509,7 @@ table = try $ do

14791509-- inline

14801510--

14811511

1482−inline :: MarkdownParser (F Inlines)

1512+inline :: PandocMonad m => MarkdownParser m (F Inlines)

14831513inline = choice [ whitespace

14841514 , bareURL

14851515 , str

@@ -1509,7 +1539,7 @@ inline = choice [ whitespace

15091539 , ltSign

15101540 ] <?> "inline"

15111541

1512−escapedChar' :: MarkdownParser Char

1542+escapedChar' :: PandocMonad m => MarkdownParser m Char

15131543escapedChar' = try $ do

15141544 char '\\'

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

@@ -1518,7 +1548,7 @@ escapedChar' = try $ do

15181548 <|> (guardEnabled Ext_escaped_line_breaks >> char '\n')

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

15201550

1521−escapedChar :: MarkdownParser (F Inlines)

1551+escapedChar :: PandocMonad m => MarkdownParser m (F Inlines)

15221552escapedChar = do

15231553 result <- escapedChar'

15241554 case result of

@@ -1527,14 +1557,14 @@ escapedChar = do

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

15281558 _ -> return $ return $ B.str [result]

15291559

1530−ltSign :: MarkdownParser (F Inlines)

1560+ltSign :: PandocMonad m => MarkdownParser m (F Inlines)

15311561ltSign = do

15321562 guardDisabled Ext_raw_html

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

15341564 char '<'

15351565 return $ return $ B.str "<"

15361566

1537−exampleRef :: MarkdownParser (F Inlines)

1567+exampleRef :: PandocMonad m => MarkdownParser m (F Inlines)

15381568exampleRef = try $ do

15391569 guardEnabled Ext_example_lists

15401570 char '@'

@@ -1545,7 +1575,7 @@ exampleRef = try $ do

15451575 Just n -> B.str (show n)

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

15471577

1548−symbol :: MarkdownParser (F Inlines)

1578+symbol :: PandocMonad m => MarkdownParser m (F Inlines)

15491579symbol = do

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

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

@@ -1554,7 +1584,7 @@ symbol = do

15541584 return $ return $ B.str [result]

15551585

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

1557−code :: MarkdownParser (F Inlines)

1587+code :: PandocMonad m => MarkdownParser m (F Inlines)

15581588code = try $ do

15591589 starts <- many1 (char '`')

15601590 skipSpaces

@@ -1566,7 +1596,7 @@ code = try $ do

15661596 >> attributes)

15671597 return $ return $ B.codeWith attr $ trim $ concat result

15681598

1569−math :: MarkdownParser (F Inlines)

1599+math :: PandocMonad m => MarkdownParser m (F Inlines)

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

15711601 <|> (return . B.math <$> (mathInline >>= applyMacros')) <+?>

15721602 ((getOption readerSmart >>= guard) *> (return <$> apostrophe)

@@ -1574,8 +1604,9 @@ math = (return . B.displayMath <$> (mathDisplay >>= applyMacros'))

15741604

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

15761606-- Designed to avoid backtracking.

1577−enclosure :: Char

1578− -> MarkdownParser (F Inlines)

1607+enclosure :: PandocMonad m

1608+ => Char

1609+ -> MarkdownParser m (F Inlines)

15791610enclosure c = do

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

15811612 -- the intraword_underscores extension is enabled:

@@ -1591,7 +1622,7 @@ enclosure c = do

15911622 1 -> one c mempty

15921623 _ -> return (return $ B.str cs)

15931624

1594−ender :: Char -> Int -> MarkdownParser ()

1625+ender :: PandocMonad m => Char -> Int -> MarkdownParser m ()

15951626ender c n = try $ do

15961627 count n (char c)

15971628 guard (c == '*')

@@ -1602,7 +1633,7 @@ ender c n = try $ do

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

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

16041635-- Otherwise, emit ccc then the results.

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

1636+three :: PandocMonad m => Char -> MarkdownParser m (F Inlines)

16061637three c = do

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

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

@@ -1612,7 +1643,7 @@ three c = do

16121643

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

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

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

1646+two :: PandocMonad m => Char -> F Inlines -> MarkdownParser m (F Inlines)

16161647two c prefix' = do

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

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

@@ -1620,7 +1651,7 @@ two c prefix' = do

16201651

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

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

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

1654+one :: PandocMonad m => Char -> F Inlines -> MarkdownParser m (F Inlines)

16241655one c prefix' = do

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

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

@@ -1629,47 +1660,48 @@ one c prefix' = do

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

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

16311662

1632−strongOrEmph :: MarkdownParser (F Inlines)

1663+strongOrEmph :: PandocMonad m => MarkdownParser m (F Inlines)

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

16341665

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

1636−inlinesBetween :: (Show b)

1637− => MarkdownParser a

1638− -> MarkdownParser b

1639− -> MarkdownParser (F Inlines)

1667+inlinesBetween :: PandocMonad m

1668+ => (Show b)

1669+ => MarkdownParser m a

1670+ -> MarkdownParser m b

1671+ -> MarkdownParser m (F Inlines)

16401672inlinesBetween start end =

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

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

16431675 innerSpace = try $ whitespace <* notFollowedBy' end

16441676

1645−strikeout :: MarkdownParser (F Inlines)

1677+strikeout :: PandocMonad m => MarkdownParser m (F Inlines)

16461678strikeout = fmap B.strikeout <$>

16471679 (guardEnabled Ext_strikeout >> inlinesBetween strikeStart strikeEnd)

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

16491681 >> notFollowedBy (char '~')

16501682 strikeEnd = try $ string "~~"

16511683

1652−superscript :: MarkdownParser (F Inlines)

1684+superscript :: PandocMonad m => MarkdownParser m (F Inlines)

16531685superscript = fmap B.superscript <$> try (do

16541686 guardEnabled Ext_superscript

16551687 char '^'

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

16571689

1658−subscript :: MarkdownParser (F Inlines)

1690+subscript :: PandocMonad m => MarkdownParser m (F Inlines)

16591691subscript = fmap B.subscript <$> try (do

16601692 guardEnabled Ext_subscript

16611693 char '~'

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

16631695

1664−whitespace :: MarkdownParser (F Inlines)

1696+whitespace :: PandocMonad m => MarkdownParser m (F Inlines)

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

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

16671699 regsp = skipMany spaceChar >> return B.space

16681700

1669−nonEndline :: Parser [Char] st Char

1701+nonEndline :: PandocMonad m => ParserT [Char] st m Char

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

16711703

1672−str :: MarkdownParser (F Inlines)

1704+str :: PandocMonad m => MarkdownParser m (F Inlines)

16731705str = do

16741706 result <- many1 alphaNum

16751707 updateLastStrPos

@@ -1699,7 +1731,7 @@ likelyAbbrev x =

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

17001732

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

1702−endline :: MarkdownParser (F Inlines)

1734+endline :: PandocMonad m => MarkdownParser m (F Inlines)

17031735endline = try $ do

17041736 newline

17051737 notFollowedBy blankline

@@ -1721,17 +1753,17 @@ endline = try $ do

17211753--

17221754

17231755-- a reference label for a link

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

1756+reference :: PandocMonad m => MarkdownParser m (F Inlines, String)

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

17261758 withRaw $ trimInlinesF <$> inlinesInBalancedBrackets

17271759

1728−parenthesizedChars :: MarkdownParser [Char]

1760+parenthesizedChars :: PandocMonad m => MarkdownParser m [Char]

17291761parenthesizedChars = do

17301762 result <- charsInBalanced '(' ')' litChar

17311763 return $ '(' : result ++ ")"

17321764

17331765-- source for a link, with optional title

1734−source :: MarkdownParser (String, String)

1766+source :: PandocMonad m => MarkdownParser m (String, String)

17351767source = do

17361768 char '('

17371769 skipSpaces

@@ -1748,10 +1780,10 @@ source = do

17481780 char ')'

17491781 return (escapeURI $ trimr src, tit)

17501782

1751−linkTitle :: MarkdownParser String

1783+linkTitle :: PandocMonad m => MarkdownParser m String

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

17531785

1754−link :: MarkdownParser (F Inlines)

1786+link :: PandocMonad m => MarkdownParser m (F Inlines)

17551787link = try $ do

17561788 st <- getState

17571789 guard $ stateAllowLinks st

@@ -1760,7 +1792,7 @@ link = try $ do

17601792 setState $ st{ stateAllowLinks = True }

17611793 regLink B.linkWith lab <|> referenceLink B.linkWith (lab,raw)

17621794

1763−bracketedSpan :: MarkdownParser (F Inlines)

1795+bracketedSpan :: PandocMonad m => MarkdownParser m (F Inlines)

17641796bracketedSpan = try $ do

17651797 guardEnabled Ext_bracketed_spans

17661798 (lab,_) <- reference

@@ -1773,8 +1805,10 @@ bracketedSpan = try $ do

17731805 -> return $ B.smallcaps <$> lab

17741806 _ -> return $ B.spanWith attr <$> lab

17751807

1776−regLink :: (Attr -> String -> String -> Inlines -> Inlines)

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

1808+regLink :: PandocMonad m

1809+ => (Attr -> String -> String -> Inlines -> Inlines)

1810+ -> F Inlines

1811+ -> MarkdownParser m (F Inlines)

17781812regLink constructor lab = try $ do

17791813 (src, tit) <- source

17801814 attr <- option nullAttr $

@@ -1782,8 +1816,10 @@ regLink constructor lab = try $ do

17821816 return $ constructor attr src tit <$> lab

17831817

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

1785−referenceLink :: (Attr -> String -> String -> Inlines -> Inlines)

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

1819+referenceLink :: PandocMonad m

1820+ => (Attr -> String -> String -> Inlines -> Inlines)

1821+ -> (F Inlines, String)

1822+ -> MarkdownParser m (F Inlines)

17871823referenceLink constructor (lab, raw) = do

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

17891825 (_,raw') <- option (mempty, "") $

@@ -1824,7 +1860,7 @@ dropBrackets = reverse . dropRB . reverse . dropLB

18241860 dropLB ('[':xs) = xs

18251861 dropLB xs = xs

18261862

1827−bareURL :: MarkdownParser (F Inlines)

1863+bareURL :: PandocMonad m => MarkdownParser m (F Inlines)

18281864bareURL = try $ do

18291865 guardEnabled Ext_autolink_bare_uris

18301866 getState >>= guard . stateAllowLinks

@@ -1832,7 +1868,7 @@ bareURL = try $ do

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

18331869 return $ return $ B.link src "" (B.str orig)

18341870

1835−autoLink :: MarkdownParser (F Inlines)

1871+autoLink :: PandocMonad m => MarkdownParser m (F Inlines)

18361872autoLink = try $ do

18371873 getState >>= guard . stateAllowLinks

18381874 char '<'

@@ -1846,7 +1882,7 @@ autoLink = try $ do

18461882 guardEnabled Ext_link_attributes >> attributes

18471883 return $ return $ B.linkWith attr (src ++ escapeURI extra) "" (B.str $ orig ++ extra)

18481884

1849−image :: MarkdownParser (F Inlines)

1885+image :: PandocMonad m => MarkdownParser m (F Inlines)

18501886image = try $ do

18511887 char '!'

18521888 (lab,raw) <- reference

@@ -1856,7 +1892,7 @@ image = try $ do

18561892 _ -> B.imageWith attr' src

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

18581894

1859−note :: MarkdownParser (F Inlines)

1895+note :: PandocMonad m => MarkdownParser m (F Inlines)

18601896note = try $ do

18611897 guardEnabled Ext_footnotes

18621898 ref <- noteMarker

@@ -1872,14 +1908,14 @@ note = try $ do

18721908 let contents' = runF contents st{ stateNotes' = [] }

18731909 return $ B.note contents'

18741910

1875−inlineNote :: MarkdownParser (F Inlines)

1911+inlineNote :: PandocMonad m => MarkdownParser m (F Inlines)

18761912inlineNote = try $ do

18771913 guardEnabled Ext_inline_notes

18781914 char '^'

18791915 contents <- inlinesInBalancedBrackets

18801916 return $ B.note . B.para <$> contents

18811917

1882−rawLaTeXInline' :: MarkdownParser (F Inlines)

1918+rawLaTeXInline' :: PandocMonad m => MarkdownParser m (F Inlines)

18831919rawLaTeXInline' = try $ do

18841920 guardEnabled Ext_raw_tex

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

@@ -1887,7 +1923,7 @@ rawLaTeXInline' = try $ do

18871923 return $ return $ B.rawInline "tex" s

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

18891925

1890−rawConTeXtEnvironment :: Parser [Char] st String

1926+rawConTeXtEnvironment :: PandocMonad m => ParserT [Char] st m String

18911927rawConTeXtEnvironment = try $ do

18921928 string "\\start"

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

@@ -1896,14 +1932,14 @@ rawConTeXtEnvironment = try $ do

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

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

18981934

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

1935+inBrackets :: PandocMonad m => (ParserT [Char] st m Char) -> ParserT [Char] st m String

19001936inBrackets parser = do

19011937 char '['

19021938 contents <- many parser

19031939 char ']'

19041940 return $ "[" ++ contents ++ "]"

19051941

1906−spanHtml :: MarkdownParser (F Inlines)

1942+spanHtml :: PandocMonad m => MarkdownParser m (F Inlines)

19071943spanHtml = try $ do

19081944 guardEnabled Ext_native_spans

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

@@ -1918,7 +1954,7 @@ spanHtml = try $ do

19181954 -> return $ B.smallcaps <$> contents

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

19201956

1921−divHtml :: MarkdownParser (F Blocks)

1957+divHtml :: PandocMonad m => MarkdownParser m (F Blocks)

19221958divHtml = try $ do

19231959 guardEnabled Ext_native_divs

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

@@ -1940,7 +1976,7 @@ divHtml = try $ do

19401976 else -- avoid backtracing

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

19421978

1943−rawHtmlInline :: MarkdownParser (F Inlines)

1979+rawHtmlInline :: PandocMonad m => MarkdownParser m (F Inlines)

19441980rawHtmlInline = do

19451981 guardEnabled Ext_raw_html

19461982 inHtmlBlock <- stateInHtmlBlock <$> getState

@@ -1962,7 +1998,7 @@ rawHtmlInline = do

19621998emojiChars :: [Char]

19631999emojiChars = ['a'..'z'] ++ ['0'..'9'] ++ ['_','+','-']

19642000

1965−emoji :: MarkdownParser (F Inlines)

2001+emoji :: PandocMonad m => MarkdownParser m (F Inlines)

19662002emoji = try $ do

19672003 guardEnabled Ext_emoji

19682004 char ':'

@@ -1974,7 +2010,7 @@ emoji = try $ do

19742010

19752011-- Citations

19762012

1977−cite :: MarkdownParser (F Inlines)

2013+cite :: PandocMonad m => MarkdownParser m (F Inlines)

19782014cite = do

19792015 guardEnabled Ext_citations

19802016 citations <- textualCite

@@ -1982,7 +2018,7 @@ cite = do

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

19832019 return citations

19842020

1985−textualCite :: MarkdownParser (F Inlines)

2021+textualCite :: PandocMonad m => MarkdownParser m (F Inlines)

19862022textualCite = try $ do

19872023 (_, key) <- citeKey

19882024 let first = Citation{ citationId = key

@@ -2017,7 +2053,7 @@ textualCite = try $ do

20172053 Just n -> B.str (show n)

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

20192055

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

2056+bareloc :: PandocMonad m => Citation -> MarkdownParser m (F [Citation])

20212057bareloc c = try $ do

20222058 spnl

20232059 char '['

@@ -2032,7 +2068,7 @@ bareloc c = try $ do

20322068 rest' <- rest

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

20342070

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

2071+normalCite :: PandocMonad m => MarkdownParser m (F [Citation])

20362072normalCite = try $ do

20372073 char '['

20382074 spnl

@@ -2041,7 +2077,7 @@ normalCite = try $ do

20412077 char ']'

20422078 return citations

20432079

2044−suffix :: MarkdownParser (F Inlines)

2080+suffix :: PandocMonad m => MarkdownParser m (F Inlines)

20452081suffix = try $ do

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

20472083 spnl

@@ -2050,14 +2086,14 @@ suffix = try $ do

20502086 then (B.space <>) <$> rest

20512087 else rest

20522088

2053−prefix :: MarkdownParser (F Inlines)

2089+prefix :: PandocMonad m => MarkdownParser m (F Inlines)

20542090prefix = trimInlinesF . mconcat <$>

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

20562092

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

2093+citeList :: PandocMonad m => MarkdownParser m (F [Citation])

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

20592095

2060−citation :: MarkdownParser (F Citation)

2096+citation :: PandocMonad m => MarkdownParser m (F Citation)

20612097citation = try $ do

20622098 pref <- prefix

20632099 (suppress_author, key) <- citeKey

@@ -2075,13 +2111,13 @@ citation = try $ do

20752111 , citationHash = 0

20762112 }

20772113

2078−smart :: MarkdownParser (F Inlines)

2114+smart :: PandocMonad m => MarkdownParser m (F Inlines)

20792115smart = do

20802116 getOption readerSmart >>= guard

20812117 doubleQuoted <|> singleQuoted <|>

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

20832119

2084−singleQuoted :: MarkdownParser (F Inlines)

2120+singleQuoted :: PandocMonad m => MarkdownParser m (F Inlines)

20852121singleQuoted = try $ do

20862122 singleQuoteStart

20872123 withQuoteContext InSingleQuote $

@@ -2091,7 +2127,7 @@ singleQuoted = try $ do

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

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

20932129-- in the same paragraph.

2094−doubleQuoted :: MarkdownParser (F Inlines)

2130+doubleQuoted :: PandocMonad m => MarkdownParser m (F Inlines)

20952131doubleQuoted = try $ do

20962132 doubleQuoteStart

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

src/Text/Pandoc/Readers/MediaWiki.hs+75−71

@@ -57,22 +57,26 @@ import Data.Char (isDigit, isSpace)

5757import Data.Maybe (fromMaybe)

5858import Text.Printf (printf)

5959import Debug.Trace (trace)

60−

61−import Text.Pandoc.Error

60+import Control.Monad.Except (throwError)

61+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))

6262

6363-- | Read mediawiki from an input string and return a Pandoc document.

64−readMediaWiki :: ReaderOptions -- ^ Reader options

64+readMediaWiki :: PandocMonad m

65+ => ReaderOptions -- ^ Reader options

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

66− -> Either PandocError Pandoc

67−readMediaWiki opts s =

68− readWith parseMediaWiki MWState{ mwOptions = opts

69− , mwMaxNestingLevel = 4

70− , mwNextLinkNumber = 1

71− , mwCategoryLinks = []

72− , mwHeaderMap = M.empty

73− , mwIdentifierList = Set.empty

74− }

75− (s ++ "\n")

67+ -> m Pandoc

68+readMediaWiki opts s = do

69+ parsed <- readWithM parseMediaWiki MWState{ mwOptions = opts

70+ , mwMaxNestingLevel = 4

71+ , mwNextLinkNumber = 1

72+ , mwCategoryLinks = []

73+ , mwHeaderMap = M.empty

74+ , mwIdentifierList = Set.empty

75+ }

76+ (s ++ "\n")

77+ case parsed of

78+ Right result -> return result

79+ Left _ -> throwError $ PandocParseError "problem parsing mediawiki"

7680

7781data MWState = MWState { mwOptions :: ReaderOptions

7882 , mwMaxNestingLevel :: Int

@@ -82,7 +86,7 @@ data MWState = MWState { mwOptions :: ReaderOptions

8286 , mwIdentifierList :: Set.Set String

8387 }

8488

85−type MWParser = Parser [Char] MWState

89+type MWParser m = ParserT [Char] MWState m

8690

8791instance HasReaderOptions MWState where

8892 extractReaderOptions = mwOptions

@@ -101,7 +105,7 @@ instance HasIdentifierList MWState where

101105

102106-- This is used to prevent exponential blowups for things like:

103107-- ''a'''a''a'''a''a'''a''a'''a

104−nested :: MWParser a -> MWParser a

108+nested :: PandocMonad m => MWParser m a -> MWParser m a

105109nested p = do

106110 nestlevel <- mwMaxNestingLevel `fmap` getState

107111 guard $ nestlevel > 0

@@ -116,7 +120,7 @@ specialChars = "'[]<=&*{}|\":\\"

116120spaceChars :: [Char]

117121spaceChars = " \n\t"

118122

119−sym :: String -> MWParser ()

123+sym :: PandocMonad m => String -> MWParser m ()

120124sym s = () <$ try (string s)

121125

122126newBlockTags :: [String]

@@ -137,10 +141,10 @@ eitherBlockOrInline :: [String]

137141eitherBlockOrInline = ["applet", "button", "del", "iframe", "ins",

138142 "map", "area", "object"]

139143

140−htmlComment :: MWParser ()

144+htmlComment :: PandocMonad m => MWParser m ()

141145htmlComment = () <$ htmlTag isCommentTag

142146

143−inlinesInTags :: String -> MWParser Inlines

147+inlinesInTags :: PandocMonad m => String -> MWParser m Inlines

144148inlinesInTags tag = try $ do

145149 (_,raw) <- htmlTag (~== TagOpen tag [])

146150 if '/' `elem` raw -- self-closing tag

@@ -148,7 +152,7 @@ inlinesInTags tag = try $ do

148152 else trimInlines . mconcat <$>

149153 manyTill inline (htmlTag (~== TagClose tag))

150154

151−blocksInTags :: String -> MWParser Blocks

155+blocksInTags :: PandocMonad m => String -> MWParser m Blocks

152156blocksInTags tag = try $ do

153157 (_,raw) <- htmlTag (~== TagOpen tag [])

154158 let closer = if tag == "li"

@@ -162,7 +166,7 @@ blocksInTags tag = try $ do

162166 then return mempty

163167 else mconcat <$> manyTill block closer

164168

165−charsInTags :: String -> MWParser [Char]

169+charsInTags :: PandocMonad m => String -> MWParser m [Char]

166170charsInTags tag = try $ do

167171 (_,raw) <- htmlTag (~== TagOpen tag [])

168172 if '/' `elem` raw -- self-closing tag

@@ -173,7 +177,7 @@ charsInTags tag = try $ do

173177-- main parser

174178--

175179

176−parseMediaWiki :: MWParser Pandoc

180+parseMediaWiki :: PandocMonad m => MWParser m Pandoc

177181parseMediaWiki = do

178182 bs <- mconcat <$> many block

179183 spaces

@@ -188,7 +192,7 @@ parseMediaWiki = do

188192-- block parsers

189193--

190194

191−block :: MWParser Blocks

195+block :: PandocMonad m => MWParser m Blocks

192196block = do

193197 tr <- getOption readerTrace

194198 pos <- getPosition

@@ -209,14 +213,14 @@ block = do

209213 (take 60 $ show $ B.toList res)) (return ())

210214 return res

211215

212−para :: MWParser Blocks

216+para :: PandocMonad m => MWParser m Blocks

213217para = do

214218 contents <- trimInlines . mconcat <$> many1 inline

215219 if F.all (==Space) contents

216220 then return mempty

217221 else return $ B.para contents

218222

219−table :: MWParser Blocks

223+table :: PandocMonad m => MWParser m Blocks

220224table = do

221225 tableStart

222226 styles <- option [] parseAttrs <* blankline

@@ -244,10 +248,10 @@ table = do

244248 else (replicate cols mempty, hdr:rows')

245249 return $ B.table caption cellspecs headers rows

246250

247−parseAttrs :: MWParser [(String,String)]

251+parseAttrs :: PandocMonad m => MWParser m [(String,String)]

248252parseAttrs = many1 parseAttr

249253

250−parseAttr :: MWParser (String, String)

254+parseAttr :: PandocMonad m => MWParser m (String, String)

251255parseAttr = try $ do

252256 skipMany spaceChar

253257 k <- many1 letter

@@ -256,17 +260,17 @@ parseAttr = try $ do

256260 <|> many1 (satisfy $ \c -> not (isSpace c) && c /= '|')

257261 return (k,v)

258262

259−tableStart :: MWParser ()

263+tableStart :: PandocMonad m => MWParser m ()

260264tableStart = try $ guardColumnOne *> skipSpaces *> sym "{|"

261265

262−tableEnd :: MWParser ()

266+tableEnd :: PandocMonad m => MWParser m ()

263267tableEnd = try $ guardColumnOne *> skipSpaces *> sym "|}"

264268

265−rowsep :: MWParser ()

269+rowsep :: PandocMonad m => MWParser m ()

266270rowsep = try $ guardColumnOne *> skipSpaces *> sym "|-" <*

267271 optional parseAttr <* blanklines

268272

269−cellsep :: MWParser ()

273+cellsep :: PandocMonad m => MWParser m ()

270274cellsep = try $

271275 (guardColumnOne *> skipSpaces <*

272276 ( (char '|' <* notFollowedBy (oneOf "-}+"))

@@ -276,7 +280,7 @@ cellsep = try $

276280 <|> (() <$ try (string "||"))

277281 <|> (() <$ try (string "!!"))

278282

279−tableCaption :: MWParser Inlines

283+tableCaption :: PandocMonad m => MWParser m Inlines

280284tableCaption = try $ do

281285 guardColumnOne

282286 skipSpaces

@@ -284,10 +288,10 @@ tableCaption = try $ do

284288 optional (try $ parseAttr *> skipSpaces *> char '|' *> skipSpaces)

285289 (trimInlines . mconcat) <$> many (notFollowedBy (cellsep <|> rowsep) *> inline)

286290

287−tableRow :: MWParser [((Alignment, Double), Blocks)]

291+tableRow :: PandocMonad m => MWParser m [((Alignment, Double), Blocks)]

288292tableRow = try $ skipMany htmlComment *> many tableCell

289293

290−tableCell :: MWParser ((Alignment, Double), Blocks)

294+tableCell :: PandocMonad m => MWParser m ((Alignment, Double), Blocks)

291295tableCell = try $ do

292296 cellsep

293297 skipMany spaceChar

@@ -313,7 +317,7 @@ parseWidth s =

313317 ('%':ds) | all isDigit ds -> safeRead ('0':'.':reverse ds)

314318 _ -> Nothing

315319

316−template :: MWParser String

320+template :: PandocMonad m => MWParser m String

317321template = try $ do

318322 string "{{"

319323 notFollowedBy (char '{')

@@ -322,7 +326,7 @@ template = try $ do

322326 contents <- manyTill chunk (try $ string "}}")

323327 return $ "{{" ++ concat contents ++ "}}"

324328

325−blockTag :: MWParser Blocks

329+blockTag :: PandocMonad m => MWParser m Blocks

326330blockTag = do

327331 (tag, _) <- lookAhead $ htmlTag isBlockTag'

328332 case tag of

@@ -341,7 +345,7 @@ trimCode :: String -> String

341345trimCode ('\n':xs) = stripTrailingNewlines xs

342346trimCode xs = stripTrailingNewlines xs

343347

344−syntaxhighlight :: String -> [Attribute String] -> MWParser Blocks

348+syntaxhighlight :: PandocMonad m => String -> [Attribute String] -> MWParser m Blocks

345349syntaxhighlight tag attrs = try $ do

346350 let mblang = lookup "lang" attrs

347351 let mbstart = lookup "start" attrs

@@ -351,13 +355,13 @@ syntaxhighlight tag attrs = try $ do

351355 contents <- charsInTags tag

352356 return $ B.codeBlockWith ("",classes,kvs) $ trimCode contents

353357

354−hrule :: MWParser Blocks

358+hrule :: PandocMonad m => MWParser m Blocks

355359hrule = B.horizontalRule <$ try (string "----" *> many (char '-') *> newline)

356360

357−guardColumnOne :: MWParser ()

361+guardColumnOne :: PandocMonad m => MWParser m ()

358362guardColumnOne = getPosition >>= \pos -> guard (sourceColumn pos == 1)

359363

360−preformatted :: MWParser Blocks

364+preformatted :: PandocMonad m => MWParser m Blocks

361365preformatted = try $ do

362366 guardColumnOne

363367 char ' '

@@ -388,7 +392,7 @@ encode = B.fromList . normalizeCode . B.toList . walk strToCode

388392 normalizeCode $ (Code a1 (x ++ y)) : zs

389393 normalizeCode (x:xs) = x : normalizeCode xs

390394

391−header :: MWParser Blocks

395+header :: PandocMonad m => MWParser m Blocks

392396header = try $ do

393397 guardColumnOne

394398 eqs <- many1 (char '=')

@@ -398,13 +402,13 @@ header = try $ do

398402 attr <- registerHeader nullAttr contents

399403 return $ B.headerWith attr lev contents

400404

401−bulletList :: MWParser Blocks

405+bulletList :: PandocMonad m => MWParser m Blocks

402406bulletList = B.bulletList <$>

403407 ( many1 (listItem '*')

404408 <|> (htmlTag (~== TagOpen "ul" []) *> spaces *> many (listItem '*' <|> li) <*

405409 optional (htmlTag (~== TagClose "ul"))) )

406410

407−orderedList :: MWParser Blocks

411+orderedList :: PandocMonad m => MWParser m Blocks

408412orderedList =

409413 (B.orderedList <$> many1 (listItem '#'))

410414 <|> try

@@ -415,10 +419,10 @@ orderedList =

415419 let start = fromMaybe 1 $ safeRead $ fromAttrib "start" tag

416420 return $ B.orderedListWith (start, DefaultStyle, DefaultDelim) items)

417421

418−definitionList :: MWParser Blocks

422+definitionList :: PandocMonad m => MWParser m Blocks

419423definitionList = B.definitionList <$> many1 defListItem

420424

421−defListItem :: MWParser (Inlines, [Blocks])

425+defListItem :: PandocMonad m => MWParser m (Inlines, [Blocks])

422426defListItem = try $ do

423427 terms <- mconcat . intersperse B.linebreak <$> many defListTerm

424428 -- we allow dd with no dt, or dt with no dd

@@ -429,27 +433,27 @@ defListItem = try $ do

429433 else many (listItem ':')

430434 return (terms, defs)

431435

432−defListTerm :: MWParser Inlines

436+defListTerm :: PandocMonad m => MWParser m Inlines

433437defListTerm = char ';' >> skipMany spaceChar >> anyLine >>=

434438 parseFromString (trimInlines . mconcat <$> many inline)

435439

436−listStart :: Char -> MWParser ()

440+listStart :: PandocMonad m => Char -> MWParser m ()

437441listStart c = char c *> notFollowedBy listStartChar

438442

439−listStartChar :: MWParser Char

443+listStartChar :: PandocMonad m => MWParser m Char

440444listStartChar = oneOf "*#;:"

441445

442−anyListStart :: MWParser Char

446+anyListStart :: PandocMonad m => MWParser m Char

443447anyListStart = char '*'

444448 <|> char '#'

445449 <|> char ':'

446450 <|> char ';'

447451

448−li :: MWParser Blocks

452+li :: PandocMonad m => MWParser m Blocks

449453li = lookAhead (htmlTag (~== TagOpen "li" [])) *>

450454 (firstParaToPlain <$> blocksInTags "li") <* spaces

451455

452−listItem :: Char -> MWParser Blocks

456+listItem :: PandocMonad m => Char -> MWParser m Blocks

453457listItem c = try $ do

454458 extras <- many (try $ char c <* lookAhead listStartChar)

455459 if null extras

@@ -475,10 +479,10 @@ listItem c = try $ do

475479-- }}

476480-- * next list item

477481-- which seems to be valid mediawiki.

478−listChunk :: MWParser String

482+listChunk :: PandocMonad m => MWParser m String

479483listChunk = template <|> count 1 anyChar

480484

481−listItem' :: Char -> MWParser Blocks

485+listItem' :: PandocMonad m => Char -> MWParser m Blocks

482486listItem' c = try $ do

483487 listStart c

484488 skipMany spaceChar

@@ -498,7 +502,7 @@ firstParaToPlain contents =

498502-- inline parsers

499503--

500504

501−inline :: MWParser Inlines

505+inline :: PandocMonad m => MWParser m Inlines

502506inline = whitespace

503507 <|> url

504508 <|> str

@@ -516,10 +520,10 @@ inline = whitespace

516520 <|> (B.rawInline "mediawiki" <$> template)

517521 <|> special

518522

519−str :: MWParser Inlines

523+str :: PandocMonad m => MWParser m Inlines

520524str = B.str <$> many1 (noneOf $ specialChars ++ spaceChars)

521525

522−math :: MWParser Inlines

526+math :: PandocMonad m => MWParser m Inlines

523527math = (B.displayMath . trim <$> try (many1 (char ':') >> charsInTags "math"))

524528 <|> (B.math . trim <$> charsInTags "math")

525529 <|> (B.displayMath . trim <$> try (dmStart *> manyTill anyChar dmEnd))

@@ -529,13 +533,13 @@ math = (B.displayMath . trim <$> try (many1 (char ':') >> charsInTags "math"))

529533 mStart = string "\\("

530534 mEnd = try (string "\\)")

531535

532−variable :: MWParser String

536+variable :: PandocMonad m => MWParser m String

533537variable = try $ do

534538 string "{{{"

535539 contents <- manyTill anyChar (try $ string "}}}")

536540 return $ "{{{" ++ contents ++ "}}}"

537541

538−inlineTag :: MWParser Inlines

542+inlineTag :: PandocMonad m => MWParser m Inlines

539543inlineTag = do

540544 (tag, _) <- lookAhead $ htmlTag isInlineTag'

541545 case tag of

@@ -557,18 +561,18 @@ inlineTag = do

557561 TagOpen "hask" _ -> B.codeWith ("",["haskell"],[]) <$> charsInTags "hask"

558562 _ -> B.rawInline "html" . snd <$> htmlTag (~== tag)

559563

560−special :: MWParser Inlines

564+special :: PandocMonad m => MWParser m Inlines

561565special = B.str <$> count 1 (notFollowedBy' (htmlTag isBlockTag') *>

562566 oneOf specialChars)

563567

564−inlineHtml :: MWParser Inlines

568+inlineHtml :: PandocMonad m => MWParser m Inlines

565569inlineHtml = B.rawInline "html" . snd <$> htmlTag isInlineTag'

566570

567−whitespace :: MWParser Inlines

571+whitespace :: PandocMonad m => MWParser m Inlines

568572whitespace = B.space <$ (skipMany1 spaceChar <|> htmlComment)

569573 <|> B.softbreak <$ endline

570574

571−endline :: MWParser ()

575+endline :: PandocMonad m => MWParser m ()

572576endline = () <$ try (newline <*

573577 notFollowedBy spaceChar <*

574578 notFollowedBy newline <*

@@ -577,12 +581,12 @@ endline = () <$ try (newline <*

577581 notFollowedBy' header <*

578582 notFollowedBy anyListStart)

579583

580−imageIdentifiers :: [MWParser ()]

584+imageIdentifiers :: PandocMonad m => [MWParser m ()]

581585imageIdentifiers = [sym (identifier ++ ":") | identifier <- identifiers]

582586 where identifiers = ["File", "Image", "Archivo", "Datei", "Fichier",

583587 "Bild"]

584588

585−image :: MWParser Inlines

589+image :: PandocMonad m => MWParser m Inlines

586590image = try $ do

587591 sym "[["

588592 choice imageIdentifiers

@@ -600,7 +604,7 @@ image = try $ do

600604 <|> try (char '|' *> (mconcat <$> manyTill inline (sym "]]")))

601605 return $ B.imageWith attr fname ("fig:" ++ stringify caption) caption

602606

603−imageOption :: MWParser String

607+imageOption :: PandocMonad m => MWParser m String

604608imageOption = try $ char '|' *> opt

605609 where

606610 opt = try (oneOfStrings [ "border", "thumbnail", "frameless"

@@ -619,7 +623,7 @@ collapseUnderscores (x:xs) = x : collapseUnderscores xs

619623addUnderscores :: String -> String

620624addUnderscores = collapseUnderscores . intercalate "_" . words

621625

622−internalLink :: MWParser Inlines

626+internalLink :: PandocMonad m => MWParser m Inlines

623627internalLink = try $ do

624628 sym "[["

625629 pagename <- unwords . words <$> many (noneOf "|]")

@@ -637,7 +641,7 @@ internalLink = try $ do

637641 return mempty

638642 else return link

639643

640−externalLink :: MWParser Inlines

644+externalLink :: PandocMonad m => MWParser m Inlines

641645externalLink = try $ do

642646 char '['

643647 (_, src) <- uri

@@ -649,29 +653,29 @@ externalLink = try $ do

649653 return $ B.str $ show num

650654 return $ B.link src "" lab

651655

652−url :: MWParser Inlines

656+url :: PandocMonad m => MWParser m Inlines

653657url = do

654658 (orig, src) <- uri

655659 return $ B.link src "" (B.str orig)

656660

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

658−inlinesBetween :: (Show b) => MWParser a -> MWParser b -> MWParser Inlines

662+inlinesBetween :: (PandocMonad m, Show b) => MWParser m a -> MWParser m b -> MWParser m Inlines

659663inlinesBetween start end =

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

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

662666 innerSpace = try $ whitespace <* notFollowedBy' end

663667

664−emph :: MWParser Inlines

668+emph :: PandocMonad m => MWParser m Inlines

665669emph = B.emph <$> nested (inlinesBetween start end)

666670 where start = sym "''" >> lookAhead nonspaceChar

667671 end = try $ notFollowedBy' (() <$ strong) >> sym "''"

668672

669−strong :: MWParser Inlines

673+strong :: PandocMonad m => MWParser m Inlines

670674strong = B.strong <$> nested (inlinesBetween start end)

671675 where start = sym "'''" >> lookAhead nonspaceChar

672676 end = try $ sym "'''"

673677

674−doubleQuotes :: MWParser Inlines

678+doubleQuotes :: PandocMonad m => MWParser m Inlines

675679doubleQuotes = B.doubleQuoted <$> nested (inlinesBetween openDoubleQuote closeDoubleQuote)

676680 where openDoubleQuote = sym "\"" >> lookAhead nonspaceChar

677681 closeDoubleQuote = try $ sym "\""

src/Text/Pandoc/Readers/Native.hs+5−2

@@ -33,6 +33,7 @@ module Text.Pandoc.Readers.Native ( readNative ) where

3333import Text.Pandoc.Definition

3434import Text.Pandoc.Shared (safeRead)

3535

36+import Control.Monad.Except (throwError)

3637import Text.Pandoc.Error

3738import Text.Pandoc.Class

3839

@@ -48,9 +49,11 @@ import Text.Pandoc.Class

4849--

4950readNative :: PandocMonad m

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

51− -> m (Either PandocError Pandoc)

52+ -> m Pandoc

5253readNative s =

53− return $ maybe (Pandoc nullMeta <$> readBlocks s) Right (safeRead s)

54+ case maybe (Pandoc nullMeta <$> readBlocks s) Right (safeRead s) of

55+ Right doc -> return doc

56+ Left _ -> throwError $ PandocParseError "couldn't read native"

5457

5558readBlocks :: String -> Either PandocError [Block]

5659readBlocks s = maybe ((:[]) <$> readBlock s) Right (safeRead s)

src/Text/Pandoc/Readers/OPML.hs+20−16

@@ -13,8 +13,9 @@ import Control.Monad.State

1313import Data.Default

1414import Control.Monad.Except

1515import Text.Pandoc.Error

16+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))

1617

17−type OPML = ExceptT PandocError (State OPMLState)

18+type OPML m = StateT OPMLState m

1819

1920data OPMLState = OPMLState{

2021 opmlSectionLevel :: Int

@@ -30,12 +31,14 @@ instance Default OPMLState where

3031 , opmlDocDate = mempty

3132 }

3233

33−readOPML :: ReaderOptions -> String -> Either PandocError Pandoc

34−readOPML _ inp = setTitle (opmlDocTitle st')

35− . setAuthors (opmlDocAuthors st')

36− . setDate (opmlDocDate st')

37− . doc . mconcat <$> bs

38− where (bs, st') = flip runState def . runExceptT $ (mapM parseBlock $ normalizeTree $ parseXML inp)

34+readOPML :: PandocMonad m => ReaderOptions -> String -> m Pandoc

35+readOPML _ inp = do

36+ (bs, st') <- flip runStateT def (mapM parseBlock $ normalizeTree $ parseXML inp)

37+ return $

38+ setTitle (opmlDocTitle st') $

39+ setAuthors (opmlDocAuthors st') $

40+ setDate (opmlDocDate st') $

41+ doc $ mconcat bs

3942

4043-- normalize input, consolidating adjacent Text and CRef elements

4144normalizeTree :: [Content] -> [Content]

@@ -62,21 +65,22 @@ attrValue attr elt =

6265 Just z -> z

6366 Nothing -> ""

6467

65−exceptT :: Either PandocError a -> OPML a

66−exceptT = either throwError return

68+-- exceptT :: PandocMonad m => Either PandocExecutionError a -> OPML m a

69+-- exceptT = either throwError return

6770

68−asHtml :: String -> OPML Inlines

69−asHtml s = (\(Pandoc _ bs) -> case bs of

71+asHtml :: PandocMonad m => String -> OPML m Inlines

72+asHtml s =

73+ (\(Pandoc _ bs) -> case bs of

7074 [Plain ils] -> fromList ils

71− _ -> mempty) <$> exceptT (readHtml def s)

75+ _ -> mempty) <$> (lift $ readHtml def s)

7276

73−asMarkdown :: String -> OPML Blocks

74−asMarkdown s = (\(Pandoc _ bs) -> fromList bs) <$> exceptT (readMarkdown def s)

77+asMarkdown :: PandocMonad m => String -> OPML m Blocks

78+asMarkdown s = (\(Pandoc _ bs) -> fromList bs) <$> (lift $ readMarkdown def s)

7579

76−getBlocks :: Element -> OPML Blocks

80+getBlocks :: PandocMonad m => Element -> OPML m Blocks

7781getBlocks e = mconcat <$> (mapM parseBlock $ elContent e)

7882

79−parseBlock :: Content -> OPML Blocks

83+parseBlock :: PandocMonad m => Content -> OPML m Blocks

8084parseBlock (Elem e) =

8185 case qName (elName e) of

8286 "ownerName" -> mempty <$ modify (\st ->

src/Text/Pandoc/Readers/Odt.hs+18−4

@@ -39,6 +39,10 @@ import qualified Data.ByteString.Lazy as B

3939

4040import System.FilePath

4141

42+import Control.Monad.Except (throwError)

43+

44+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))

45+import qualified Text.Pandoc.Class as P

4246import Text.Pandoc.Definition

4347import Text.Pandoc.Error

4448import Text.Pandoc.Options

@@ -52,11 +56,21 @@ import Text.Pandoc.Readers.Odt.Generic.XMLConverter

5256import Text.Pandoc.Readers.Odt.Generic.Fallible

5357import Text.Pandoc.Shared (filteredFilesFromArchive)

5458

55−--

56−readOdt :: ReaderOptions

59+readOdt :: PandocMonad m

60+ => ReaderOptions

5761 -> B.ByteString

58− -> Either PandocError (Pandoc, MediaBag)

59−readOdt _ bytes = bytesToOdt bytes-- of

62+ -> m Pandoc

63+readOdt opts bytes = case readOdt' opts bytes of

64+ Right (doc, mb) -> do

65+ P.setMediaBag mb

66+ return doc

67+ Left _ -> throwError $ PandocParseError "couldn't parse odt"

68+

69+--

70+readOdt' :: ReaderOptions

71+ -> B.ByteString

72+ -> Either PandocError (Pandoc, MediaBag)

73+readOdt' _ bytes = bytesToOdt bytes-- of

6074-- Right (pandoc, mediaBag) -> Right (pandoc , mediaBag)

6175-- Left err -> Left err

6276

src/Text/Pandoc/Readers/Org.hs+13−7

@@ -31,24 +31,30 @@ import Text.Pandoc.Readers.Org.Blocks ( blockList, meta )

3131import Text.Pandoc.Readers.Org.Parsing ( OrgParser, readWithM )

3232import Text.Pandoc.Readers.Org.ParserState ( optionsToParserState )

3333

34+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))

3435import Text.Pandoc.Definition

35−import Text.Pandoc.Error

3636import Text.Pandoc.Options

3737

38−import Control.Monad.Reader ( runReader )

38+import Control.Monad.Except ( throwError )

39+import Control.Monad.Reader ( runReaderT )

3940

4041

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

42−readOrg :: ReaderOptions -- ^ Reader options

43+readOrg :: PandocMonad m

44+ => ReaderOptions -- ^ Reader options

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

44− -> Either PandocError Pandoc

45−readOrg opts s = flip runReader def $

46− readWithM parseOrg (optionsToParserState opts) (s ++ "\n\n")

46+ -> m Pandoc

47+readOrg opts s = do

48+ parsed <- flip runReaderT def $

49+ readWithM parseOrg (optionsToParserState opts) (s ++ "\n\n")

50+ case parsed of

51+ Right result -> return result

52+ Left _ -> throwError $ PandocParseError "problem parsing org"

4753

4854--

4955-- Parser

5056--

51−parseOrg :: OrgParser Pandoc

57+parseOrg :: PandocMonad m => OrgParser m Pandoc

5258parseOrg = do

5359 blocks' <- blockList

5460 meta' <- meta

src/Text/Pandoc/Readers/Org/BlockStarts.hs+17−16

@@ -44,7 +44,7 @@ import Control.Monad ( void )

4444import Text.Pandoc.Readers.Org.Parsing

4545

4646-- | Horizontal Line (five -- dashes or more)

47−hline :: OrgParser ()

47+hline :: Monad m => OrgParser m ()

4848hline = try $ do

4949 skipSpaces

5050 string "-----"

@@ -54,58 +54,59 @@ hline = try $ do

5454 return ()

5555

5656-- | Read the start of a header line, return the header level

57−headerStart :: OrgParser Int

57+headerStart :: Monad m => OrgParser m Int

5858headerStart = try $

5959 (length <$> many1 (char '*')) <* many1 (char ' ') <* updateLastPreCharPos

6060

61−tableStart :: OrgParser Char

61+tableStart :: Monad m => OrgParser m Char

6262tableStart = try $ skipSpaces *> char '|'

6363

64−latexEnvStart :: OrgParser String

64+latexEnvStart :: Monad m => OrgParser m String

6565latexEnvStart = try $ do

6666 skipSpaces *> string "\\begin{"

6767 *> latexEnvName

6868 <* string "}"

6969 <* blankline

7070 where

71− latexEnvName :: OrgParser String

71+ latexEnvName :: Monad m => OrgParser m String

7272 latexEnvName = try $ mappend <$> many1 alphaNum <*> option "" (string "*")

7373

7474

7575-- | Parses bullet list marker.

76−bulletListStart :: OrgParser ()

76+bulletListStart :: Monad m => OrgParser m ()

7777bulletListStart = try $

7878 choice

7979 [ () <$ skipSpaces <* oneOf "+-" <* skipSpaces1

8080 , () <$ skipSpaces1 <* char '*' <* skipSpaces1

8181 ]

8282

83−genericListStart :: OrgParser String

84− -> OrgParser Int

83+genericListStart :: Monad m

84+ => OrgParser m String

85+ -> OrgParser m Int

8586genericListStart listMarker = try $

8687 (+) <$> (length <$> many spaceChar)

8788 <*> (length <$> listMarker <* many1 spaceChar)

8889

89−orderedListStart :: OrgParser Int

90+orderedListStart :: Monad m => OrgParser m Int

9091orderedListStart = genericListStart orderedListMarker

9192 -- Ordered list markers allowed in org-mode

9293 where orderedListMarker = mappend <$> many1 digit <*> (pure <$> oneOf ".)")

9394

94−drawerStart :: OrgParser String

95+drawerStart :: Monad m => OrgParser m String

9596drawerStart = try $

9697 skipSpaces *> drawerName <* skipSpaces <* newline

9798 where drawerName = char ':' *> manyTill nonspaceChar (char ':')

9899

99−metaLineStart :: OrgParser ()

100+metaLineStart :: Monad m => OrgParser m ()

100101metaLineStart = try $ skipSpaces <* string "#+"

101102

102−commentLineStart :: OrgParser ()

103+commentLineStart :: Monad m => OrgParser m ()

103104commentLineStart = try $ skipSpaces <* string "# "

104105

105−exampleLineStart :: OrgParser ()

106+exampleLineStart :: Monad m => OrgParser m ()

106107exampleLineStart = () <$ try (skipSpaces *> string ": ")

107108

108−noteMarker :: OrgParser String

109+noteMarker :: Monad m => OrgParser m String

109110noteMarker = try $ do

110111 char '['

111112 choice [ many1Till digit (char ']')

@@ -114,12 +115,12 @@ noteMarker = try $ do

114115 ]

115116

116117-- | Succeeds if the parser is at the end of a block.

117−endOfBlock :: OrgParser ()

118+endOfBlock :: Monad m => OrgParser m ()

118119endOfBlock = lookAhead . try $ do

119120 void blankline <|> anyBlockStart

120121 where

121122 -- Succeeds if there is a new block starting at this position.

122− anyBlockStart :: OrgParser ()

123+ anyBlockStart :: Monad m => OrgParser m ()

123124 anyBlockStart = try . choice $

124125 [ exampleLineStart

125126 , hline

src/Text/Pandoc/Readers/Org/Blocks.hs+83−80

@@ -44,6 +44,7 @@ import Text.Pandoc.Readers.Org.Shared

4444

4545import qualified Text.Pandoc.Builder as B

4646import Text.Pandoc.Builder ( Inlines, Blocks )

47+import Text.Pandoc.Class (PandocMonad)

4748import Text.Pandoc.Definition

4849import Text.Pandoc.Options

4950import Text.Pandoc.Shared ( compactify', compactify'DL, safeRead )

@@ -105,7 +106,7 @@ data Headline = Headline

105106

106107-- | Read an Org mode headline and its contents (i.e. a document subtree).

107108-- @lvl@ gives the minimum acceptable level of the tree.

108−headline :: Int -> OrgParser (F Headline)

109+headline :: PandocMonad m => Int -> OrgParser m (F Headline)

109110headline lvl = try $ do

110111 level <- headerStart

111112 guard (lvl <= level)

@@ -130,16 +131,16 @@ headline lvl = try $ do

130131 , headlineChildren = children'

131132 }

132133 where

133− endOfTitle :: OrgParser ()

134+ endOfTitle :: Monad m => OrgParser m ()

134135 endOfTitle = void . lookAhead $ optional headerTags *> newline

135136

136− headerTags :: OrgParser [Tag]

137+ headerTags :: Monad m => OrgParser m [Tag]

137138 headerTags = try $

138139 let tag = many1 (alphaNum <|> oneOf "@%#_") <* char ':'

139140 in map toTag <$> (skipSpaces *> char ':' *> many1 tag <* skipSpaces)

140141

141142-- | Convert an Org mode headline (i.e. a document tree) into pandoc's Blocks

142−headlineToBlocks :: Headline -> OrgParser Blocks

143+headlineToBlocks :: Monad m => Headline -> OrgParser m Blocks

143144headlineToBlocks hdln@(Headline {..}) = do

144145 maxHeadlineLevels <- getExportSetting exportHeadlineLevels

145146 case () of

@@ -162,7 +163,7 @@ isCommentTitle :: Inlines -> Bool

162163isCommentTitle (B.toList -> (Str "COMMENT":_)) = True

163164isCommentTitle _ = False

164165

165−archivedHeadlineToBlocks :: Headline -> OrgParser Blocks

166+archivedHeadlineToBlocks :: Monad m => Headline -> OrgParser m Blocks

166167archivedHeadlineToBlocks hdln = do

167168 archivedTreesOption <- getExportSetting exportArchivedTrees

168169 case archivedTreesOption of

@@ -170,7 +171,7 @@ archivedHeadlineToBlocks hdln = do

170171 ArchivedTreesExport -> headlineToHeaderWithContents hdln

171172 ArchivedTreesHeadlineOnly -> headlineToHeader hdln

172173

173−headlineToHeaderWithList :: Headline -> OrgParser Blocks

174+headlineToHeaderWithList :: Monad m => Headline -> OrgParser m Blocks

174175headlineToHeaderWithList hdln@(Headline {..}) = do

175176 maxHeadlineLevels <- getExportSetting exportHeadlineLevels

176177 header <- headlineToHeader hdln

@@ -189,13 +190,13 @@ headlineToHeaderWithList hdln@(Headline {..}) = do

189190 (Header _ _ inlns:_) -> B.para (B.fromList inlns)

190191 _ -> mempty

191192

192−headlineToHeaderWithContents :: Headline -> OrgParser Blocks

193+headlineToHeaderWithContents :: Monad m => Headline -> OrgParser m Blocks

193194headlineToHeaderWithContents hdln@(Headline {..}) = do

194195 header <- headlineToHeader hdln

195196 childrenBlocks <- mconcat <$> sequence (map headlineToBlocks headlineChildren)

196197 return $ header <> headlineContents <> childrenBlocks

197198

198−headlineToHeader :: Headline -> OrgParser Blocks

199+headlineToHeader :: Monad m => Headline -> OrgParser m Blocks

199200headlineToHeader (Headline {..}) = do

200201 exportTodoKeyword <- getExportSetting exportWithTodoKeywords

201202 let todoText = if exportTodoKeyword

@@ -208,7 +209,7 @@ headlineToHeader (Headline {..}) = do

208209 attr <- registerHeader propAttr headlineText

209210 return $ B.headerWith attr headlineLevel text

210211

211−todoKeyword :: OrgParser TodoMarker

212+todoKeyword :: Monad m => OrgParser m TodoMarker

212213todoKeyword = try $ do

213214 taskStates <- activeTodoMarkers <$> getState

214215 let kwParser tdm = try $ (tdm <$ string (todoMarkerName tdm) <* spaceChar)

@@ -250,7 +251,7 @@ tagToInline t = B.spanWith ("", ["tag"], [("data-tag-name", fromTag t)]) mempty

250251--

251252

252253-- | Get a list of blocks.

253−blockList :: OrgParser [Block]

254+blockList :: PandocMonad m => OrgParser m [Block]

254255blockList = do

255256 initialBlocks <- blocks

256257 headlines <- sequence <$> manyTill (headline 1) eof

@@ -259,15 +260,15 @@ blockList = do

259260 return . B.toList $ (runF initialBlocks st) <> headlineBlocks

260261

261262-- | Get the meta information safed in the state.

262−meta :: OrgParser Meta

263+meta :: Monad m => OrgParser m Meta

263264meta = do

264265 meta' <- metaExport

265266 runF meta' <$> getState

266267

267−blocks :: OrgParser (F Blocks)

268+blocks :: PandocMonad m => OrgParser m (F Blocks)

268269blocks = mconcat <$> manyTill block (void (lookAhead headerStart) <|> eof)

269270

270−block :: OrgParser (F Blocks)

271+block :: PandocMonad m => OrgParser m (F Blocks)

271272block = choice [ mempty <$ blanklines

272273 , table

273274 , orgBlock

@@ -306,7 +307,7 @@ attrFromBlockAttributes (BlockAttributes{..}) =

306307 kv = filter ((`notElem` ["id", "class"]) . fst) blockAttrKeyValues

307308 in (ident, classes, kv)

308309

309−stringyMetaAttribute :: (String -> Bool) -> OrgParser (String, String)

310+stringyMetaAttribute :: Monad m => (String -> Bool) -> OrgParser m (String, String)

310311stringyMetaAttribute attrCheck = try $ do

311312 metaLineStart

312313 attrName <- map toUpper <$> many1Till nonspaceChar (char ':')

@@ -315,7 +316,7 @@ stringyMetaAttribute attrCheck = try $ do

315316 attrValue <- anyLine

316317 return (attrName, attrValue)

317318

318−blockAttributes :: OrgParser BlockAttributes

319+blockAttributes :: PandocMonad m => OrgParser m BlockAttributes

319320blockAttributes = try $ do

320321 kv <- many (stringyMetaAttribute attrCheck)

321322 let caption = foldl' (appendValues "CAPTION") Nothing kv

@@ -350,17 +351,17 @@ blockAttributes = try $ do

350351 Just acc -> Just $ acc ++ ' ':value

351352 Nothing -> Just value

352353

353−keyValues :: OrgParser [(String, String)]

354+keyValues :: Monad m => OrgParser m [(String, String)]

354355keyValues = try $

355356 manyTill ((,) <$> key <*> value) newline

356357 where

357− key :: OrgParser String

358+ key :: Monad m => OrgParser m String

358359 key = try $ skipSpaces *> char ':' *> many1 nonspaceChar

359360

360− value :: OrgParser String

361+ value :: Monad m => OrgParser m String

361362 value = skipSpaces *> manyTill anyChar endOfValue

362363

363− endOfValue :: OrgParser ()

364+ endOfValue :: Monad m => OrgParser m ()

364365 endOfValue =

365366 lookAhead $ (() <$ try (many1 spaceChar <* key))

366367 <|> () <$ newline

@@ -371,7 +372,7 @@ keyValues = try $

371372--

372373

373374-- | Read an org-mode block delimited by #+BEGIN_TYPE and #+END_TYPE.

374−orgBlock :: OrgParser (F Blocks)

375+orgBlock :: PandocMonad m => OrgParser m (F Blocks)

375376orgBlock = try $ do

376377 blockAttrs <- blockAttributes

377378 blkType <- blockHeaderStart

@@ -390,25 +391,25 @@ orgBlock = try $ do

390391 let (ident, classes, kv) = attrFromBlockAttributes blockAttrs

391392 in fmap $ B.divWith (ident, classes ++ [blkType], kv)

392393 where

393− blockHeaderStart :: OrgParser String

394+ blockHeaderStart :: Monad m => OrgParser m String

394395 blockHeaderStart = try $ skipSpaces *> stringAnyCase "#+begin_" *> orgArgWord

395396

396397 lowercase :: String -> String

397398 lowercase = map toLower

398399

399−rawBlockLines :: (String -> F Blocks) -> String -> OrgParser (F Blocks)

400+rawBlockLines :: Monad m => (String -> F Blocks) -> String -> OrgParser m (F Blocks)

400401rawBlockLines f blockType = (ignHeaders *> (f <$> rawBlockContent blockType))

401402

402−parseBlockLines :: (F Blocks -> F Blocks) -> String -> OrgParser (F Blocks)

403+parseBlockLines :: PandocMonad m => (F Blocks -> F Blocks) -> String -> OrgParser m (F Blocks)

403404parseBlockLines f blockType = (ignHeaders *> (f <$> parsedBlockContent))

404405 where

405− parsedBlockContent :: OrgParser (F Blocks)

406+ parsedBlockContent :: PandocMonad m => OrgParser m (F Blocks)

406407 parsedBlockContent = try $ do

407408 raw <- rawBlockContent blockType

408409 parseFromString blocks (raw ++ "\n")

409410

410411-- | Read the raw string content of a block

411−rawBlockContent :: String -> OrgParser String

412+rawBlockContent :: Monad m => String -> OrgParser m String

412413rawBlockContent blockType = try $ do

413414 blkLines <- manyTill rawLine blockEnder

414415 tabLen <- getOption readerTabStop

@@ -418,10 +419,10 @@ rawBlockContent blockType = try $ do

418419 . map (tabsToSpaces tabLen . commaEscaped)

419420 $ blkLines

420421 where

421− rawLine :: OrgParser String

422+ rawLine :: Monad m => OrgParser m String

422423 rawLine = try $ ("" <$ blankline) <|> anyLine

423424

424− blockEnder :: OrgParser ()

425+ blockEnder :: Monad m => OrgParser m ()

425426 blockEnder = try $ skipSpaces <* stringAnyCase ("#+end_" <> blockType)

426427

427428 stripIndent :: [String] -> [String]

@@ -448,18 +449,18 @@ rawBlockContent blockType = try $ do

448449 commaEscaped cs = cs

449450

450451-- | Read but ignore all remaining block headers.

451−ignHeaders :: OrgParser ()

452+ignHeaders :: Monad m => OrgParser m ()

452453ignHeaders = (() <$ newline) <|> (() <$ anyLine)

453454

454455-- | Read a block containing code intended for export in specific backends

455456-- only.

456−exportBlock :: String -> OrgParser (F Blocks)

457+exportBlock :: Monad m => String -> OrgParser m (F Blocks)

457458exportBlock blockType = try $ do

458459 exportType <- skipSpaces *> orgArgWord <* ignHeaders

459460 contents <- rawBlockContent blockType

460461 returnF (B.rawBlock (map toLower exportType) contents)

461462

462−verseBlock :: String -> OrgParser (F Blocks)

463+verseBlock :: PandocMonad m => String -> OrgParser m (F Blocks)

463464verseBlock blockType = try $ do

464465 ignHeaders

465466 content <- rawBlockContent blockType

@@ -468,7 +469,7 @@ verseBlock blockType = try $ do

468469 where

469470 -- replace initial spaces with nonbreaking spaces to preserve

470471 -- indentation, parse the rest as normal inline

471− parseVerseLine :: String -> OrgParser (F Inlines)

472+ parseVerseLine :: PandocMonad m => String -> OrgParser m (F Inlines)

472473 parseVerseLine cs = do

473474 let (initialSpaces, indentedLine) = span isSpace cs

474475 let nbspIndent = if null initialSpaces

@@ -480,7 +481,7 @@ verseBlock blockType = try $ do

480481-- | Read a code block and the associated results block if present. Which of

481482-- boths blocks is included in the output is determined using the "exports"

482483-- argument in the block header.

483−codeBlock :: BlockAttributes -> String -> OrgParser (F Blocks)

484+codeBlock :: PandocMonad m => BlockAttributes -> String -> OrgParser m (F Blocks)

484485codeBlock blockAttrs blockType = do

485486 skipSpaces

486487 (classes, kv) <- codeHeaderArgs <|> (mempty <$ ignHeaders)

@@ -513,7 +514,7 @@ exportsResults :: [(String, String)] -> Bool

513514exportsResults attrs = ("rundoc-exports", "results") `elem` attrs

514515 || ("rundoc-exports", "both") `elem` attrs

515516

516−trailingResultsBlock :: OrgParser (Maybe (F Blocks))

517+trailingResultsBlock :: PandocMonad m => OrgParser m (Maybe (F Blocks))

517518trailingResultsBlock = optionMaybe . try $ do

518519 blanklines

519520 stringAnyCase "#+RESULTS:"

@@ -522,7 +523,7 @@ trailingResultsBlock = optionMaybe . try $ do

522523

523524-- | Parse code block arguments

524525-- TODO: We currently don't handle switches.

525−codeHeaderArgs :: OrgParser ([String], [(String, String)])

526+codeHeaderArgs :: Monad m => OrgParser m ([String], [(String, String)])

526527codeHeaderArgs = try $ do

527528 language <- skipSpaces *> orgArgWord

528529 _ <- skipSpaces *> (try $ switch `sepBy` (many1 spaceChar))

@@ -537,27 +538,27 @@ codeHeaderArgs = try $ do

537538 where

538539 hasRundocParameters = not . null

539540

540−switch :: OrgParser (Char, Maybe String)

541+switch :: Monad m => OrgParser m (Char, Maybe String)

541542switch = try $ simpleSwitch <|> lineNumbersSwitch

542543 where

543544 simpleSwitch = (\c -> (c, Nothing)) <$> (oneOf "-+" *> letter)

544545 lineNumbersSwitch = (\ls -> ('l', Just ls)) <$>

545546 (string "-l \"" *> many1Till nonspaceChar (char '"'))

546547

547−blockOption :: OrgParser (String, String)

548+blockOption :: Monad m => OrgParser m (String, String)

548549blockOption = try $ do

549550 argKey <- orgArgKey

550551 paramValue <- option "yes" orgParamValue

551552 return (argKey, paramValue)

552553

553−orgParamValue :: OrgParser String

554+orgParamValue :: Monad m => OrgParser m String

554555orgParamValue = try $

555556 skipSpaces

556557 *> notFollowedBy (char ':' )

557558 *> many1 nonspaceChar

558559 <* skipSpaces

559560

560−horizontalRule :: OrgParser (F Blocks)

561+horizontalRule :: Monad m => OrgParser m (F Blocks)

561562horizontalRule = return B.horizontalRule <$ try hline

562563

563564

@@ -568,7 +569,7 @@ horizontalRule = return B.horizontalRule <$ try hline

568569-- | A generic drawer which has no special meaning for org-mode.

569570-- Whether or not this drawer is included in the output depends on the drawers

570571-- export setting.

571−genericDrawer :: OrgParser (F Blocks)

572+genericDrawer :: PandocMonad m => OrgParser m (F Blocks)

572573genericDrawer = try $ do

573574 name <- map toUpper <$> drawerStart

574575 content <- manyTill drawerLine (try drawerEnd)

@@ -582,35 +583,35 @@ genericDrawer = try $ do

582583 Right names | name `notElem` names -> return mempty

583584 _ -> drawerDiv name <$> parseLines content

584585 where

585− parseLines :: [String] -> OrgParser (F Blocks)

586+ parseLines :: PandocMonad m => [String] -> OrgParser m (F Blocks)

586587 parseLines = parseFromString blocks . (++ "\n") . unlines

587588

588589 drawerDiv :: String -> F Blocks -> F Blocks

589590 drawerDiv drawerName = fmap $ B.divWith (mempty, [drawerName, "drawer"], mempty)

590591

591−drawerLine :: OrgParser String

592+drawerLine :: Monad m => OrgParser m String

592593drawerLine = anyLine

593594

594−drawerEnd :: OrgParser String

595+drawerEnd :: Monad m => OrgParser m String

595596drawerEnd = try $

596597 skipSpaces *> stringAnyCase ":END:" <* skipSpaces <* newline

597598

598599-- | Read a :PROPERTIES: drawer and return the key/value pairs contained

599600-- within.

600−propertiesDrawer :: OrgParser Properties

601+propertiesDrawer :: Monad m => OrgParser m Properties

601602propertiesDrawer = try $ do

602603 drawerType <- drawerStart

603604 guard $ map toUpper drawerType == "PROPERTIES"

604605 manyTill property (try drawerEnd)

605606 where

606− property :: OrgParser (PropertyKey, PropertyValue)

607+ property :: Monad m => OrgParser m (PropertyKey, PropertyValue)

607608 property = try $ (,) <$> key <*> value

608609

609− key :: OrgParser PropertyKey

610+ key :: Monad m => OrgParser m PropertyKey

610611 key = fmap toPropertyKey . try $

611612 skipSpaces *> char ':' *> many1Till nonspaceChar (char ':')

612613

613− value :: OrgParser PropertyValue

614+ value :: Monad m => OrgParser m PropertyValue

614615 value = fmap toPropertyValue . try $

615616 skipSpaces *> manyTill anyChar (try $ skipSpaces *> newline)

616617

@@ -621,7 +622,7 @@ propertiesDrawer = try $ do

621622

622623-- | Figures or an image paragraph (i.e. an image on a line by itself). Only

623624-- images with a caption attribute are interpreted as figures.

624−figure :: OrgParser (F Blocks)

625+figure :: PandocMonad m => OrgParser m (F Blocks)

625626figure = try $ do

626627 figAttrs <- blockAttributes

627628 src <- skipSpaces *> selfTarget <* skipSpaces <* endOfParagraph

@@ -632,7 +633,7 @@ figure = try $ do

632633 let isFigure = not . isNothing $ blockAttrCaption figAttrs

633634 return $ imageBlock isFigure figAttrs imgSrc

634635 where

635− selfTarget :: OrgParser String

636+ selfTarget :: PandocMonad m => OrgParser m String

636637 selfTarget = try $ char '[' *> linkTarget <* char ']'

637638

638639 imageBlock :: Bool -> BlockAttributes -> String -> F Blocks

@@ -654,7 +655,7 @@ figure = try $ do

654655 else "fig:" ++ cs

655656

656657-- | Succeeds if looking at the end of the current paragraph

657−endOfParagraph :: OrgParser ()

658+endOfParagraph :: Monad m => OrgParser m ()

658659endOfParagraph = try $ skipSpaces *> newline *> endOfBlock

659660

660661

@@ -663,11 +664,11 @@ endOfParagraph = try $ skipSpaces *> newline *> endOfBlock

663664--

664665

665666-- | Example code marked up by a leading colon.

666−example :: OrgParser (F Blocks)

667+example :: Monad m => OrgParser m (F Blocks)

667668example = try $ do

668669 return . return . exampleCode =<< unlines <$> many1 exampleLine

669670 where

670− exampleLine :: OrgParser String

671+ exampleLine :: Monad m => OrgParser m String

671672 exampleLine = try $ exampleLineStart *> anyLine

672673

673674exampleCode :: String -> Blocks

@@ -678,10 +679,10 @@ exampleCode = B.codeBlockWith ("", ["example"], [])

678679-- Comments, Options and Metadata

679680--

680681

681−specialLine :: OrgParser (F Blocks)

682+specialLine :: PandocMonad m => OrgParser m (F Blocks)

682683specialLine = fmap return . try $ rawExportLine <|> metaLine <|> commentLine

683684

684−rawExportLine :: OrgParser Blocks

685+rawExportLine :: PnadocMonad m => OrgParser m Blocks

685686rawExportLine = try $ do

686687 metaLineStart

687688 key <- metaKey

@@ -689,7 +690,7 @@ rawExportLine = try $ do

689690 then B.rawBlock key <$> anyLine

690691 else mzero

691692

692−commentLine :: OrgParser Blocks

693+commentLine :: Monad m => OrgParser m Blocks

693694commentLine = commentLineStart *> anyLine *> pure mempty

694695

695696

@@ -718,7 +719,7 @@ data OrgTable = OrgTable

718719 , orgTableRows :: [[Blocks]]

719720 }

720721

721−table :: OrgParser (F Blocks)

722+table :: PandocMonad m => OrgParser m (F Blocks)

722723table = try $ do

723724 blockAttrs <- blockAttributes

724725 lookAhead tableStart

@@ -745,18 +746,18 @@ orgToPandocTable (OrgTable colProps heads lns) caption =

745746 <*> totalWidth

746747 in (align', width')

747748

748−tableRows :: OrgParser [OrgTableRow]

749+tableRows :: PandocMonad m => OrgParser m [OrgTableRow]

749750tableRows = try $ many (tableAlignRow <|> tableHline <|> tableContentRow)

750751

751−tableContentRow :: OrgParser OrgTableRow

752+tableContentRow :: PandocMonad m => OrgParser m OrgTableRow

752753tableContentRow = try $

753754 OrgContentRow . sequence <$> (tableStart *> many1Till tableContentCell newline)

754755

755−tableContentCell :: OrgParser (F Blocks)

756+tableContentCell :: PandocMonad m => OrgParser m (F Blocks)

756757tableContentCell = try $

757758 fmap B.plain . trimInlinesF . mconcat <$> manyTill inline endOfCell

758759

759−tableAlignRow :: OrgParser OrgTableRow

760+tableAlignRow :: Monad m => OrgParser m OrgTableRow

760761tableAlignRow = try $ do

761762 tableStart

762763 colProps <- many1Till columnPropertyCell newline

@@ -764,7 +765,7 @@ tableAlignRow = try $ do

764765 guard $ any (/= def) colProps

765766 return $ OrgAlignRow colProps

766767

767−columnPropertyCell :: OrgParser ColumnProperty

768+columnPropertyCell :: Monad m => OrgParser m ColumnProperty

768769columnPropertyCell = emptyCell <|> propCell <?> "alignment info"

769770 where

770771 emptyCell = ColumnProperty Nothing Nothing <$ (try $ skipSpaces *> endOfCell)

@@ -776,18 +777,18 @@ columnPropertyCell = emptyCell <|> propCell <?> "alignment info"

776777 <* char '>'

777778 <* emptyCell)

778779

779−tableAlignFromChar :: OrgParser Alignment

780+tableAlignFromChar :: Monad m => OrgParser m Alignment

780781tableAlignFromChar = try $

781782 choice [ char 'l' *> return AlignLeft

782783 , char 'c' *> return AlignCenter

783784 , char 'r' *> return AlignRight

784785 ]

785786

786−tableHline :: OrgParser OrgTableRow

787+tableHline :: Monad m => OrgParser m OrgTableRow

787788tableHline = try $

788789 OrgHlineRow <$ (tableStart *> char '-' *> anyLine)

789790

790−endOfCell :: OrgParser Char

791+endOfCell :: Monad m => OrgParser m Char

791792endOfCell = try $ char '|' <|> lookAhead newline

792793

793794rowsToTable :: [OrgTableRow]

@@ -840,7 +841,7 @@ rowToContent orgTable row =

840841--

841842-- LaTeX fragments

842843--

843−latexFragment :: OrgParser (F Blocks)

844+latexFragment :: Monad m => OrgParser m (F Blocks)

844845latexFragment = try $ do

845846 envName <- latexEnvStart

846847 content <- mconcat <$> manyTill anyLineNewline (latexEnd envName)

@@ -851,7 +852,7 @@ latexFragment = try $ do

851852 , "\\end{", e, "}\n"

852853 ]

853854

854−latexEnd :: String -> OrgParser ()

855+latexEnd :: Monad m => String -> OrgParser m ()

855856latexEnd envName = try $

856857 () <$ skipSpaces

857858 <* string ("\\end{" ++ envName ++ "}")

@@ -861,7 +862,7 @@ latexEnd envName = try $

861862--

862863-- Footnote defintions

863864--

864−noteBlock :: OrgParser (F Blocks)

865+noteBlock :: PandocMonad m => OrgParser m (F Blocks)

865866noteBlock = try $ do

866867 ref <- noteMarker <* skipSpaces

867868 content <- mconcat <$> blocksTillHeaderOrNote

@@ -873,7 +874,7 @@ noteBlock = try $ do

873874 <|> () <$ lookAhead headerStart)

874875

875876-- Paragraphs or Plain text

876−paraOrPlain :: OrgParser (F Blocks)

877+paraOrPlain :: PandocMonad m => OrgParser m (F Blocks)

877878paraOrPlain = try $ do

878879 -- Make sure we are not looking at a headline

879880 notFollowedBy' (char '*' *> (oneOf " *"))

@@ -892,24 +893,24 @@ paraOrPlain = try $ do

892893-- list blocks

893894--

894895

895−list :: OrgParser (F Blocks)

896+list :: PandocMonad m => OrgParser m (F Blocks)

896897list = choice [ definitionList, bulletList, orderedList ] <?> "list"

897898

898−definitionList :: OrgParser (F Blocks)

899+definitionList :: PandocMonad m => OrgParser m (F Blocks)

899900definitionList = try $ do n <- lookAhead (bulletListStart' Nothing)

900901 fmap B.definitionList . fmap compactify'DL . sequence

901902 <$> many1 (definitionListItem $ bulletListStart' (Just n))

902903

903−bulletList :: OrgParser (F Blocks)

904+bulletList :: PandocMonad m => OrgParser m (F Blocks)

904905bulletList = try $ do n <- lookAhead (bulletListStart' Nothing)

905906 fmap B.bulletList . fmap compactify' . sequence

906907 <$> many1 (listItem (bulletListStart' $ Just n))

907908

908−orderedList :: OrgParser (F Blocks)

909+orderedList :: PandocMonad m => OrgParser m (F Blocks)

909910orderedList = fmap B.orderedList . fmap compactify' . sequence

910911 <$> many1 (listItem orderedListStart)

911912

912−bulletListStart' :: Maybe Int -> OrgParser Int

913+bulletListStart' :: Monad m => Maybe Int -> OrgParser m Int

913914-- returns length of bulletList prefix, inclusive of marker

914915bulletListStart' Nothing = do ind <- length <$> many spaceChar

915916 oneOf (bullets $ ind == 0)

@@ -925,8 +926,9 @@ bulletListStart' (Just n) = do count (n-1) spaceChar

925926bullets :: Bool -> String

926927bullets unindented = if unindented then "+-" else "*+-"

927928

928−definitionListItem :: OrgParser Int

929− -> OrgParser (F (Inlines, [Blocks]))

929+definitionListItem :: PandocMonad m

930+ => OrgParser m Int

931+ -> OrgParser m (F (Inlines, [Blocks]))

930932definitionListItem parseMarkerGetLength = try $ do

931933 markerLength <- parseMarkerGetLength

932934 term <- manyTill (noneOf "\n\r") (try definitionMarker)

@@ -942,8 +944,9 @@ definitionListItem parseMarkerGetLength = try $ do

942944

943945

944946-- parse raw text for one list item, excluding start marker and continuations

945−listItem :: OrgParser Int

946− -> OrgParser (F Blocks)

947+listItem :: PandocMonad m

948+ => OrgParser m Int

949+ -> OrgParser m (F Blocks)

947950listItem start = try . withContext ListItemState $ do

948951 markerLength <- try start

949952 firstLine <- anyLineNewline

@@ -953,8 +956,8 @@ listItem start = try . withContext ListItemState $ do

953956

954957-- continuation of a list item - indented and separated by blankline or endline.

955958-- Note: nested lists are parsed as continuations.

956−listContinuation :: Int

957− -> OrgParser String

959+listContinuation :: Monad m => Int

960+ -> OrgParser m String

958961listContinuation markerLength = try $

959962 notFollowedBy' blankline

960963 *> (mappend <$> (concat <$> many1 listLine)

@@ -963,7 +966,7 @@ listContinuation markerLength = try $

963966 listLine = try $ indentWith markerLength *> anyLineNewline

964967

965968 -- indent by specified number of spaces (or equiv. tabs)

966− indentWith :: Int -> OrgParser String

969+ indentWith :: Monad m => Int -> OrgParser m String

967970 indentWith num = do

968971 tabStop <- getOption readerTabStop

969972 if num < tabStop

@@ -972,5 +975,5 @@ listContinuation markerLength = try $

972975 , try (char '\t' >> count (num - tabStop) (char ' ')) ]

973976

974977-- | Parse any line, include the final newline in the output.

975−anyLineNewline :: OrgParser String

978+anyLineNewline :: Monad m => OrgParser m String

976979anyLineNewline = (++ "\n") <$> anyLine

src/Text/Pandoc/Readers/Org/ExportSettings.hs+18−15

@@ -37,14 +37,14 @@ import Data.Char ( toLower )

3737import Data.Maybe ( listToMaybe )

3838

3939-- | Read and handle space separated org-mode export settings.

40−exportSettings :: OrgParser ()

40+exportSettings :: Monad m => OrgParser m ()

4141exportSettings = void $ sepBy spaces exportSetting

4242

4343-- | Setter function for export settings.

4444type ExportSettingSetter a = a -> ExportSettings -> ExportSettings

4545

4646-- | Read and process a single org-mode export option.

47−exportSetting :: OrgParser ()

47+exportSetting :: Monad m => OrgParser m ()

4848exportSetting = choice

4949 [ booleanSetting "^" (\val es -> es { exportSubSuperscripts = val })

5050 , booleanSetting "'" (\val es -> es { exportSmartQuotes = val })

@@ -81,10 +81,11 @@ exportSetting = choice

8181 , ignoredSetting "|"

8282 ] <?> "export setting"

8383

84−genericExportSetting :: OrgParser a

84+genericExportSetting :: Monad m

85+ => OrgParser m a

8586 -> String

8687 -> ExportSettingSetter a

87− -> OrgParser ()

88+ -> OrgParser m ()

8889genericExportSetting optionParser settingIdentifier setter = try $ do

8990 _ <- string settingIdentifier *> char ':'

9091 value <- optionParser

@@ -94,11 +95,11 @@ genericExportSetting optionParser settingIdentifier setter = try $ do

9495 st { orgStateExportSettings = setter val . orgStateExportSettings $ st }

9596

9697-- | A boolean option, either nil (False) or non-nil (True).

97−booleanSetting :: String -> ExportSettingSetter Bool -> OrgParser ()

98+booleanSetting :: Monad m => String -> ExportSettingSetter Bool -> OrgParser m ()

9899booleanSetting = genericExportSetting elispBoolean

99100

100101-- | An integer-valued option.

101−integerSetting :: String -> ExportSettingSetter Int -> OrgParser ()

102+integerSetting :: Monad m => String -> ExportSettingSetter Int -> OrgParser m ()

102103integerSetting = genericExportSetting parseInt

103104 where

104105 parseInt = try $

@@ -106,9 +107,10 @@ integerSetting = genericExportSetting parseInt

106107

107108-- | Either the string "headline" or an elisp boolean and treated as an

108109-- @ArchivedTreesOption@.

109−archivedTreeSetting :: String

110+archivedTreeSetting :: Monad m

111+ => String

110112 -> ExportSettingSetter ArchivedTreesOption

111− -> OrgParser ()

113+ -> OrgParser m ()

112114archivedTreeSetting =

113115 genericExportSetting $ archivedTreesHeadlineSetting <|> archivedTreesBoolean

114116 where

@@ -125,9 +127,10 @@ archivedTreeSetting =

125127 else ArchivedTreesNoExport

126128

127129-- | A list or a complement list (i.e. a list starting with `not`).

128−complementableListSetting :: String

130+complementableListSetting :: Monad m

131+ => String

129132 -> ExportSettingSetter (Either [String] [String])

130− -> OrgParser ()

133+ -> OrgParser m ()

131134complementableListSetting = genericExportSetting $ choice

132135 [ Left <$> complementStringList

133136 , Right <$> stringList

@@ -135,31 +138,31 @@ complementableListSetting = genericExportSetting $ choice

135138 ]

136139 where

137140 -- Read a plain list of strings.

138− stringList :: OrgParser [String]

141+ stringList :: Monad m => OrgParser m [String]

139142 stringList = try $

140143 char '('

141144 *> sepBy elispString spaces

142145 <* char ')'

143146

144147 -- Read an emacs lisp list specifying a complement set.

145− complementStringList :: OrgParser [String]

148+ complementStringList :: Monad m => OrgParser m [String]

146149 complementStringList = try $

147150 string "(not "

148151 *> sepBy elispString spaces

149152 <* char ')'

150153

151− elispString :: OrgParser String

154+ elispString :: Monad m => OrgParser m String

152155 elispString = try $

153156 char '"'

154157 *> manyTill alphaNum (char '"')

155158

156159-- | Read but ignore the export setting.

157−ignoredSetting :: String -> OrgParser ()

160+ignoredSetting :: Monad m => String -> OrgParser m ()

158161ignoredSetting s = try (() <$ string s <* char ':' <* many1 nonspaceChar)

159162

160163-- | Read an elisp boolean. Only NIL is treated as false, non-NIL values are

161164-- interpreted as true.

162−elispBoolean :: OrgParser Bool

165+elispBoolean :: Monad m => OrgParser m Bool

163166elispBoolean = try $ do

164167 value <- many1 nonspaceChar

165168 return $ case map toLower value of

src/Text/Pandoc/Readers/Org/Inlines.hs+129−117

@@ -47,9 +47,11 @@ import Text.Pandoc.Options

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

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

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

50+import Text.Pandoc.Class (PandocMonad)

5051

5152import Prelude hiding (sequence)

5253import Control.Monad ( guard, mplus, mzero, when, void )

54+import Control.Monad.Trans ( lift )

5355import Data.Char ( isAlphaNum, isSpace )

5456import Data.List ( intersperse )

5557import Data.Maybe ( fromMaybe )

@@ -60,46 +62,46 @@ import Data.Traversable (sequence)

6062--

6163-- Functions acting on the parser state

6264--

63−recordAnchorId :: String -> OrgParser ()

65+recordAnchorId :: PandocMonad m => String -> OrgParser m ()

6466recordAnchorId i = updateState $ \s ->

6567 s{ orgStateAnchorIds = i : (orgStateAnchorIds s) }

6668

67−pushToInlineCharStack :: Char -> OrgParser ()

69+pushToInlineCharStack :: PandocMonad m => Char -> OrgParser m ()

6870pushToInlineCharStack c = updateState $ \s ->

6971 s{ orgStateEmphasisCharStack = c:orgStateEmphasisCharStack s }

7072

71−popInlineCharStack :: OrgParser ()

73+popInlineCharStack :: PandocMonad m => OrgParser m ()

7274popInlineCharStack = updateState $ \s ->

7375 s{ orgStateEmphasisCharStack = drop 1 . orgStateEmphasisCharStack $ s }

7476

75−surroundingEmphasisChar :: OrgParser [Char]

77+surroundingEmphasisChar :: PandocMonad m => OrgParser m [Char]

7678surroundingEmphasisChar =

7779 take 1 . drop 1 . orgStateEmphasisCharStack <$> getState

7880

79−startEmphasisNewlinesCounting :: Int -> OrgParser ()

81+startEmphasisNewlinesCounting :: PandocMonad m => Int -> OrgParser m ()

8082startEmphasisNewlinesCounting maxNewlines = updateState $ \s ->

8183 s{ orgStateEmphasisNewlines = Just maxNewlines }

8284

83−decEmphasisNewlinesCount :: OrgParser ()

85+decEmphasisNewlinesCount :: PandocMonad m => OrgParser m ()

8486decEmphasisNewlinesCount = updateState $ \s ->

8587 s{ orgStateEmphasisNewlines = (\n -> n - 1) <$> orgStateEmphasisNewlines s }

8688

87−newlinesCountWithinLimits :: OrgParser Bool

89+newlinesCountWithinLimits :: PandocMonad m => OrgParser m Bool

8890newlinesCountWithinLimits = do

8991 st <- getState

9092 return $ ((< 0) <$> orgStateEmphasisNewlines st) /= Just True

9193

92−resetEmphasisNewlines :: OrgParser ()

94+resetEmphasisNewlines :: PandocMonad m => OrgParser m ()

9395resetEmphasisNewlines = updateState $ \s ->

9496 s{ orgStateEmphasisNewlines = Nothing }

9597

96−addToNotesTable :: OrgNoteRecord -> OrgParser ()

98+addToNotesTable :: PandocMonad m => OrgNoteRecord -> OrgParser m ()

9799addToNotesTable note = do

98100 oldnotes <- orgStateNotes' <$> getState

99101 updateState $ \s -> s{ orgStateNotes' = note:oldnotes }

100102

101103-- | Parse a single Org-mode inline element

102−inline :: OrgParser (F Inlines)

104+inline :: PandocMonad m => OrgParser m (F Inlines)

103105inline =

104106 choice [ whitespace

105107 , linebreak

@@ -125,7 +127,7 @@ inline =

125127 <?> "inline"

126128

127129-- | Read the rest of the input as inlines.

128−inlines :: OrgParser (F Inlines)

130+inlines :: PandocMonad m => OrgParser m (F Inlines)

129131inlines = trimInlinesF . mconcat <$> many1 inline

130132

131133-- treat these as potentially non-text when parsing inline:

@@ -133,23 +135,23 @@ specialChars :: [Char]

133135specialChars = "\"$'()*+-,./:;<=>@[\\]^_{|}~"

134136

135137

136−whitespace :: OrgParser (F Inlines)

138+whitespace :: PandocMonad m => OrgParser m (F Inlines)

137139whitespace = pure B.space <$ skipMany1 spaceChar

138140 <* updateLastPreCharPos

139141 <* updateLastForbiddenCharPos

140142 <?> "whitespace"

141143

142−linebreak :: OrgParser (F Inlines)

144+linebreak :: PandocMonad m => OrgParser m (F Inlines)

143145linebreak = try $ pure B.linebreak <$ string "\\\\" <* skipSpaces <* newline

144146

145−str :: OrgParser (F Inlines)

147+str :: PandocMonad m => OrgParser m (F Inlines)

146148str = return . B.str <$> many1 (noneOf $ specialChars ++ "\n\r ")

147149 <* updateLastStrPos

148150

149151-- | An endline character that can be treated as a space, not a structural

150152-- break. This should reflect the values of the Emacs variable

151153-- @org-element-pagaraph-separate@.

152−endline :: OrgParser (F Inlines)

154+endline :: PandocMonad m => OrgParser m (F Inlines)

153155endline = try $ do

154156 newline

155157 notFollowedBy' endOfBlock

@@ -174,7 +176,7 @@ endline = try $ do

174176-- contributors. All this should be consolidated once an official Org-mode

175177-- citation syntax has emerged.

176178

177−cite :: OrgParser (F Inlines)

179+cite :: PandocMonad m => OrgParser m (F Inlines)

178180cite = try $ berkeleyCite <|> do

179181 guardEnabled Ext_citations

180182 (cs, raw) <- withRaw $ choice

@@ -185,40 +187,41 @@ cite = try $ berkeleyCite <|> do

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

186188

187189-- | A citation in Pandoc Org-mode style (@[prefix \@citekey suffix]@).

188−pandocOrgCite :: OrgParser (F [Citation])

190+pandocOrgCite :: PandocMonad m => OrgParser m (F [Citation])

189191pandocOrgCite = try $

190192 char '[' *> skipSpaces *> citeList <* skipSpaces <* char ']'

191193

192−orgRefCite :: OrgParser (F [Citation])

194+orgRefCite :: PandocMonad m => OrgParser m (F [Citation])

193195orgRefCite = try $ choice

194196 [ normalOrgRefCite

195197 , fmap (:[]) <$> linkLikeOrgRefCite

196198 ]

197199

198−normalOrgRefCite :: OrgParser (F [Citation])

200+normalOrgRefCite :: PandocMonad m => OrgParser m (F [Citation])

199201normalOrgRefCite = try $ do

200202 mode <- orgRefCiteMode

201− -- org-ref style citation key, parsed into a citation of the given mode

202− let orgRefCiteItem :: OrgParser (F Citation)

203− orgRefCiteItem = try $ do

204− key <- orgRefCiteKey

205− returnF $ Citation

206− { citationId = key

207− , citationPrefix = mempty

208− , citationSuffix = mempty

209− , citationMode = mode

210− , citationNoteNum = 0

211− , citationHash = 0

212− }

213− firstCitation <- orgRefCiteItem

214− moreCitations <- many (try $ char ',' *> orgRefCiteItem)

203+ firstCitation <- orgRefCiteList mode

204+ moreCitations <- many (try $ char ',' *> orgRefCiteList mode)

215205 return . sequence $ firstCitation : moreCitations

216− where

206+ where

207+ -- | A list of org-ref style citation keys, parsed as citation of the given

208+ -- citation mode.

209+ orgRefCiteList :: PandocMonad m => CitationMode -> OrgParser m (F Citation)

210+ orgRefCiteList citeMode = try $ do

211+ key <- orgRefCiteKey

212+ returnF $ Citation

213+ { citationId = key

214+ , citationPrefix = mempty

215+ , citationSuffix = mempty

216+ , citationMode = citeMode

217+ , citationNoteNum = 0

218+ , citationHash = 0

219+ }

217220

218221-- | Read an Berkeley-style Org-mode citation. Berkeley citation style was

219222-- develop and adjusted to Org-mode style by John MacFarlane and Richard

220223-- Lawrence, respectively, both philosophers at UC Berkeley.

221−berkeleyCite :: OrgParser (F Inlines)

224+berkeleyCite :: PandocMonad m => OrgParser m (F Inlines)

222225berkeleyCite = try $ do

223226 bcl <- berkeleyCitationList

224227 return $ do

@@ -260,7 +263,7 @@ data BerkeleyCitationList = BerkeleyCitationList

260263 , berkeleyCiteCommonSuffix :: Maybe Inlines

261264 , berkeleyCiteCitations :: [Citation]

262265 }

263−berkeleyCitationList :: OrgParser (F BerkeleyCitationList)

266+berkeleyCitationList :: PandocMonad m => OrgParser m (F BerkeleyCitationList)

264267berkeleyCitationList = try $ do

265268 char '['

266269 parens <- choice [ False <$ berkeleyBareTag, True <$ berkeleyParensTag ]

@@ -275,22 +278,22 @@ berkeleyCitationList = try $ do

275278 <*> sequence commonSuffix

276279 <*> citations)

277280 where

278− citationListPart :: OrgParser (F Inlines)

281+ citationListPart :: PandocMonad m => OrgParser m (F Inlines)

279282 citationListPart = fmap (trimInlinesF . mconcat) . try . many1 $ do

280283 notFollowedBy' citeKey

281284 notFollowedBy (oneOf ";]")

282285 inline

283286

284−berkeleyBareTag :: OrgParser ()

287+berkeleyBareTag :: PandocMonad m => OrgParser m ()

285288berkeleyBareTag = try $ void berkeleyBareTag'

286289

287−berkeleyParensTag :: OrgParser ()

290+berkeleyParensTag :: PandocMonad m => OrgParser m ()

288291berkeleyParensTag = try . void $ enclosedByPair '(' ')' berkeleyBareTag'

289292

290−berkeleyBareTag' :: OrgParser ()

293+berkeleyBareTag' :: PandocMonad m => OrgParser m ()

291294berkeleyBareTag' = try $ void (string "cite")

292295

293−berkeleyTextualCite :: OrgParser (F [Citation])

296+berkeleyTextualCite :: PandocMonad m => OrgParser m (F [Citation])

294297berkeleyTextualCite = try $ do

295298 (suppressAuthor, key) <- citeKey

296299 returnF . return $ Citation

@@ -305,14 +308,14 @@ berkeleyTextualCite = try $ do

305308-- The following is what a Berkeley-style bracketed textual citation parser

306309-- would look like. However, as these citations are a subset of Pandoc's Org

307310-- citation style, this isn't used.

308−-- berkeleyBracketedTextualCite :: OrgParser (F [Citation])

311+-- berkeleyBracketedTextualCite :: PandocMonad m => OrgParser m (F [Citation])

309312-- berkeleyBracketedTextualCite = try . (fmap head) $

310313-- enclosedByPair '[' ']' berkeleyTextualCite

311314

312315-- | Read a link-like org-ref style citation. The citation includes pre and

313316-- post text. However, multiple citations are not possible due to limitations

314317-- in the syntax.

315−linkLikeOrgRefCite :: OrgParser (F Citation)

318+linkLikeOrgRefCite :: PandocMonad m => OrgParser m (F Citation)

316319linkLikeOrgRefCite = try $ do

317320 _ <- string "[["

318321 mode <- orgRefCiteMode

@@ -335,13 +338,13 @@ linkLikeOrgRefCite = try $ do

335338

336339-- | Read a citation key. The characters allowed in citation keys are taken

337340-- from the `org-ref-cite-re` variable in `org-ref.el`.

338−orgRefCiteKey :: OrgParser String

341+orgRefCiteKey :: PandocMonad m => OrgParser m String

339342orgRefCiteKey = try . many1 . satisfy $ \c ->

340343 isAlphaNum c || c `elem` ("-_:\\./"::String)

341344

342345-- | Supported citation types. Only a small subset of org-ref types is

343346-- supported for now. TODO: rewrite this, use LaTeX reader as template.

344−orgRefCiteMode :: OrgParser CitationMode

347+orgRefCiteMode :: PandocMonad m => OrgParser m CitationMode

345348orgRefCiteMode =

346349 choice $ map (\(s, mode) -> mode <$ try (string s <* char ':'))

347350 [ ("cite", AuthorInText)

@@ -352,10 +355,10 @@ orgRefCiteMode =

352355 , ("citeyear", SuppressAuthor)

353356 ]

354357

355−citeList :: OrgParser (F [Citation])

358+citeList :: PandocMonad m => OrgParser m (F [Citation])

356359citeList = sequence <$> sepEndBy1 citation (try $ char ';' *> skipSpaces)

357360

358−citation :: OrgParser (F Citation)

361+citation :: PandocMonad m => OrgParser m (F Citation)

359362citation = try $ do

360363 pref <- prefix

361364 (suppress_author, key) <- citeKey

@@ -384,10 +387,10 @@ citation = try $ do

384387 then (B.space <>) <$> rest

385388 else rest

386389

387−footnote :: OrgParser (F Inlines)

390+footnote :: PandocMonad m => OrgParser m (F Inlines)

388391footnote = try $ inlineNote <|> referencedNote

389392

390−inlineNote :: OrgParser (F Inlines)

393+inlineNote :: PandocMonad m => OrgParser m (F Inlines)

391394inlineNote = try $ do

392395 string "[fn:"

393396 ref <- many alphaNum

@@ -397,7 +400,7 @@ inlineNote = try $ do

397400 addToNotesTable ("fn:" ++ ref, note)

398401 return $ B.note <$> note

399402

400−referencedNote :: OrgParser (F Inlines)

403+referencedNote :: PandocMonad m => OrgParser m (F Inlines)

401404referencedNote = try $ do

402405 ref <- noteMarker

403406 return $ do

@@ -409,14 +412,14 @@ referencedNote = try $ do

409412 let contents' = runF contents st{ orgStateNotes' = [] }

410413 return $ B.note contents'

411414

412−linkOrImage :: OrgParser (F Inlines)

415+linkOrImage :: PandocMonad m => OrgParser m (F Inlines)

413416linkOrImage = explicitOrImageLink

414417 <|> selflinkOrImage

415418 <|> angleLink

416419 <|> plainLink

417420 <?> "link or image"

418421

419−explicitOrImageLink :: OrgParser (F Inlines)

422+explicitOrImageLink :: PandocMonad m => OrgParser m (F Inlines)

420423explicitOrImageLink = try $ do

421424 char '['

422425 srcF <- applyCustomLinkFormat =<< possiblyEmptyLinkTarget

@@ -431,30 +434,30 @@ explicitOrImageLink = try $ do

431434 _ ->

432435 linkToInlinesF src =<< title'

433436

434−selflinkOrImage :: OrgParser (F Inlines)

437+selflinkOrImage :: PandocMonad m => OrgParser m (F Inlines)

435438selflinkOrImage = try $ do

436439 src <- char '[' *> linkTarget <* char ']'

437440 return $ linkToInlinesF src (B.str src)

438441

439−plainLink :: OrgParser (F Inlines)

442+plainLink :: PandocMonad m => OrgParser m (F Inlines)

440443plainLink = try $ do

441444 (orig, src) <- uri

442445 returnF $ B.link src "" (B.str orig)

443446

444−angleLink :: OrgParser (F Inlines)

447+angleLink :: PandocMonad m => OrgParser m (F Inlines)

445448angleLink = try $ do

446449 char '<'

447450 link <- plainLink

448451 char '>'

449452 return link

450453

451−linkTarget :: OrgParser String

454+linkTarget :: PandocMonad m => OrgParser m String

452455linkTarget = enclosedByPair '[' ']' (noneOf "\n\r[]")

453456

454−possiblyEmptyLinkTarget :: OrgParser String

457+possiblyEmptyLinkTarget :: PandocMonad m => OrgParser m String

455458possiblyEmptyLinkTarget = try linkTarget <|> ("" <$ string "[]")

456459

457−applyCustomLinkFormat :: String -> OrgParser (F String)

460+applyCustomLinkFormat :: String -> OrgParser m (F String)

458461applyCustomLinkFormat link = do

459462 let (linkType, rest) = break (== ':') link

460463 return $ do

@@ -487,7 +490,7 @@ internalLink link title = do

487490-- @anchor-id@ contains spaces, we are more restrictive in what is accepted as

488491-- an anchor.

489492

490−anchor :: OrgParser (F Inlines)

493+anchor :: PandocMonad m => OrgParser m (F Inlines)

491494anchor = try $ do

492495 anchorId <- parseAnchor

493496 recordAnchorId anchorId

@@ -509,7 +512,7 @@ solidify = map replaceSpecialChar

509512 | otherwise = '-'

510513

511514-- | Parses an inline code block and marks it as an babel block.

512−inlineCodeBlock :: OrgParser (F Inlines)

515+inlineCodeBlock :: PandocMonad m => OrgParser m (F Inlines)

513516inlineCodeBlock = try $ do

514517 string "src_"

515518 lang <- many1 orgArgWordChar

@@ -519,13 +522,13 @@ inlineCodeBlock = try $ do

519522 let attrKeyVal = map toRundocAttrib (("language", lang) : opts)

520523 returnF $ B.codeWith ("", attrClasses, attrKeyVal) inlineCode

521524 where

522− inlineBlockOption :: OrgParser (String, String)

525+ inlineBlockOption :: PandocMonad m => OrgParser m (String, String)

523526 inlineBlockOption = try $ do

524527 argKey <- orgArgKey

525528 paramValue <- option "yes" orgInlineParamValue

526529 return (argKey, paramValue)

527530

528− orgInlineParamValue :: OrgParser String

531+ orgInlineParamValue :: PandocMonad m => OrgParser m String

529532 orgInlineParamValue = try $

530533 skipSpaces

531534 *> notFollowedBy (char ':')

@@ -533,7 +536,7 @@ inlineCodeBlock = try $ do

533536 <* skipSpaces

534537

535538

536−emphasizedText :: OrgParser (F Inlines)

539+emphasizedText :: PandocMonad m => OrgParser m (F Inlines)

537540emphasizedText = do

538541 state <- getState

539542 guard . exportEmphasizedText . orgStateExportSettings $ state

@@ -544,60 +547,63 @@ emphasizedText = do

544547 , underline

545548 ]

546549

547−enclosedByPair :: Char -- ^ opening char

550+enclosedByPair :: PandocMonad m

551+ => Char -- ^ opening char

548552 -> Char -- ^ closing char

549− -> OrgParser a -- ^ parser

550− -> OrgParser [a]

553+ -> OrgParser m a -- ^ parser

554+ -> OrgParser m [a]

551555enclosedByPair s e p = char s *> many1Till p (char e)

552556

553−emph :: OrgParser (F Inlines)

557+emph :: PandocMonad m => OrgParser m (F Inlines)

554558emph = fmap B.emph <$> emphasisBetween '/'

555559

556−strong :: OrgParser (F Inlines)

560+strong :: PandocMonad m => OrgParser m (F Inlines)

557561strong = fmap B.strong <$> emphasisBetween '*'

558562

559−strikeout :: OrgParser (F Inlines)

563+strikeout :: PandocMonad m => OrgParser m (F Inlines)

560564strikeout = fmap B.strikeout <$> emphasisBetween '+'

561565

562566-- There is no underline, so we use strong instead.

563−underline :: OrgParser (F Inlines)

567+underline :: PandocMonad m => OrgParser m (F Inlines)

564568underline = fmap B.strong <$> emphasisBetween '_'

565569

566−verbatim :: OrgParser (F Inlines)

570+verbatim :: PandocMonad m => OrgParser m (F Inlines)

567571verbatim = return . B.code <$> verbatimBetween '='

568572

569−code :: OrgParser (F Inlines)

573+code :: PandocMonad m => OrgParser m (F Inlines)

570574code = return . B.code <$> verbatimBetween '~'

571575

572−subscript :: OrgParser (F Inlines)

576+subscript :: PandocMonad m => OrgParser m (F Inlines)

573577subscript = fmap B.subscript <$> try (char '_' *> subOrSuperExpr)

574578

575−superscript :: OrgParser (F Inlines)

579+superscript :: PandocMonad m => OrgParser m (F Inlines)

576580superscript = fmap B.superscript <$> try (char '^' *> subOrSuperExpr)

577581

578−math :: OrgParser (F Inlines)

582+math :: PandocMonad m => OrgParser m (F Inlines)

579583math = return . B.math <$> choice [ math1CharBetween '$'

580584 , mathStringBetween '$'

581585 , rawMathBetween "\$" "\$"

582586 ]

583587

584−displayMath :: OrgParser (F Inlines)

588+displayMath :: PandocMonad m => OrgParser m (F Inlines)

585589displayMath = return . B.displayMath <$> choice [ rawMathBetween "\\[" "\\]"

586590 , rawMathBetween "$$" "$$"

587591 ]

588592

589−updatePositions :: Char

590− -> OrgParser Char

593+updatePositions :: PandocMonad m

594+ => Char

595+ -> OrgParser m Char

591596updatePositions c = do

592597 when (c `elem` emphasisPreChars) updateLastPreCharPos

593598 when (c `elem` emphasisForbiddenBorderChars) updateLastForbiddenCharPos

594599 return c

595600

596−symbol :: OrgParser (F Inlines)

601+symbol :: PandocMonad m => OrgParser m (F Inlines)

597602symbol = return . B.str . (: "") <$> (oneOf specialChars >>= updatePositions)

598603

599−emphasisBetween :: Char

600− -> OrgParser (F Inlines)

604+emphasisBetween :: PandocMonad m

605+ => Char

606+ -> OrgParser m (F Inlines)

601607emphasisBetween c = try $ do

602608 startEmphasisNewlinesCounting emphasisAllowedNewlines

603609 res <- enclosedInlines (emphasisStart c) (emphasisEnd c)

@@ -606,8 +612,9 @@ emphasisBetween c = try $ do

606612 resetEmphasisNewlines

607613 return res

608614

609−verbatimBetween :: Char

610− -> OrgParser String

615+verbatimBetween :: PandocMonad m

616+ => Char

617+ -> OrgParser m String

611618verbatimBetween c = try $

612619 emphasisStart c *>

613620 many1TillNOrLessNewlines 1 verbatimChar (emphasisEnd c)

@@ -615,8 +622,9 @@ verbatimBetween c = try $

615622 verbatimChar = noneOf "\n\r" >>= updatePositions

616623

617624-- | Parses a raw string delimited by @c@ using Org's math rules

618−mathStringBetween :: Char

619− -> OrgParser String

625+mathStringBetween :: PandocMonad m

626+ => Char

627+ -> OrgParser m String

620628mathStringBetween c = try $ do

621629 mathStart c

622630 body <- many1TillNOrLessNewlines mathAllowedNewlines

@@ -626,8 +634,9 @@ mathStringBetween c = try $ do

626634 return $ body ++ [final]

627635

628636-- | Parse a single character between @c@ using math rules

629−math1CharBetween :: Char

630− -> OrgParser String

637+math1CharBetween :: PandocMonad m

638+ => Char

639+ -> OrgParser m String

631640math1CharBetween c = try $ do

632641 char c

633642 res <- noneOf $ c:mathForbiddenBorderChars

@@ -635,13 +644,14 @@ math1CharBetween c = try $ do

635644 eof <|> () <$ lookAhead (oneOf mathPostChars)

636645 return [res]

637646

638−rawMathBetween :: String

647+rawMathBetween :: PandocMonad m

648+ => String

639649 -> String

640− -> OrgParser String

650+ -> OrgParser m String

641651rawMathBetween s e = try $ string s *> manyTill anyChar (try $ string e)

642652

643653-- | Parses the start (opening character) of emphasis

644−emphasisStart :: Char -> OrgParser Char

654+emphasisStart :: PandocMonad m => Char -> OrgParser m Char

645655emphasisStart c = try $ do

646656 guard =<< afterEmphasisPreChar

647657 guard =<< notAfterString

@@ -654,7 +664,7 @@ emphasisStart c = try $ do

654664 return c

655665

656666-- | Parses the closing character of emphasis

657−emphasisEnd :: Char -> OrgParser Char

667+emphasisEnd :: PandocMonad m => Char -> OrgParser m Char

658668emphasisEnd c = try $ do

659669 guard =<< notAfterForbiddenBorderChar

660670 char c

@@ -665,11 +675,11 @@ emphasisEnd c = try $ do

665675 where acceptablePostChars =

666676 surroundingEmphasisChar >>= \x -> oneOf (x ++ emphasisPostChars)

667677

668−mathStart :: Char -> OrgParser Char

678+mathStart :: PandocMonad m => Char -> OrgParser m Char

669679mathStart c = try $

670680 char c <* notFollowedBy' (oneOf (c:mathForbiddenBorderChars))

671681

672−mathEnd :: Char -> OrgParser Char

682+mathEnd :: PandocMonad m => Char -> OrgParser m Char

673683mathEnd c = try $ do

674684 res <- noneOf (c:mathForbiddenBorderChars)

675685 char c

@@ -677,15 +687,15 @@ mathEnd c = try $ do

677687 return res

678688

679689

680−enclosedInlines :: OrgParser a

681− -> OrgParser b

682− -> OrgParser (F Inlines)

690+enclosedInlines :: PandocMonad m => OrgParser m a

691+ -> OrgParser m b

692+ -> OrgParser m (F Inlines)

683693enclosedInlines start end = try $

684694 trimInlinesF . mconcat <$> enclosed start end inline

685695

686−enclosedRaw :: OrgParser a

687− -> OrgParser b

688− -> OrgParser String

696+enclosedRaw :: PandocMonad m => OrgParser m a

697+ -> OrgParser m b

698+ -> OrgParser m String

689699enclosedRaw start end = try $

690700 start *> (onSingleLine <|> spanningTwoLines)

691701 where onSingleLine = try $ many1Till (noneOf "\n\r") end

@@ -694,10 +704,10 @@ enclosedRaw start end = try $

694704

695705-- | Like many1Till, but parses at most @n+1@ lines. @p@ must not consume

696706-- newlines.

697−many1TillNOrLessNewlines :: Int

698− -> OrgParser Char

699− -> OrgParser a

700− -> OrgParser String

707+many1TillNOrLessNewlines :: PandocMonad m => Int

708+ -> OrgParser m Char

709+ -> OrgParser m a

710+ -> OrgParser m String

701711many1TillNOrLessNewlines n p end = try $

702712 nMoreLines (Just n) mempty >>= oneOrMore

703713 where

@@ -746,21 +756,21 @@ mathAllowedNewlines :: Int

746756mathAllowedNewlines = 2

747757

748758-- | Whether we are right behind a char allowed before emphasis

749−afterEmphasisPreChar :: OrgParser Bool

759+afterEmphasisPreChar :: PandocMonad m => OrgParser m Bool

750760afterEmphasisPreChar = do

751761 pos <- getPosition

752762 lastPrePos <- orgStateLastPreCharPos <$> getState

753763 return . fromMaybe True $ (== pos) <$> lastPrePos

754764

755765-- | Whether the parser is right after a forbidden border char

756−notAfterForbiddenBorderChar :: OrgParser Bool

766+notAfterForbiddenBorderChar :: PandocMonad m => OrgParser m Bool

757767notAfterForbiddenBorderChar = do

758768 pos <- getPosition

759769 lastFBCPos <- orgStateLastForbiddenCharPos <$> getState

760770 return $ lastFBCPos /= Just pos

761771

762772-- | Read a sub- or superscript expression

763−subOrSuperExpr :: OrgParser (F Inlines)

773+subOrSuperExpr :: PandocMonad m => OrgParser m (F Inlines)

764774subOrSuperExpr = try $

765775 choice [ id <$> charsInBalanced '{' '}' (noneOf "\n\r")

766776 , enclosing ('(', ')') <$> charsInBalanced '(' ')' (noneOf "\n\r")

@@ -768,7 +778,7 @@ subOrSuperExpr = try $

768778 ] >>= parseFromString (mconcat <$> many inline)

769779 where enclosing (left, right) s = left : s ++ [right]

770780

771−simpleSubOrSuperString :: OrgParser String

781+simpleSubOrSuperString :: PandocMonad m => OrgParser m String

772782simpleSubOrSuperString = try $ do

773783 state <- getState

774784 guard . exportSubSuperscripts . orgStateExportSettings $ state

@@ -777,17 +787,18 @@ simpleSubOrSuperString = try $ do

777787 <*> many1 alphaNum

778788 ]

779789

780−inlineLaTeX :: OrgParser (F Inlines)

790+inlineLaTeX :: PandocMonad m => OrgParser m (F Inlines)

781791inlineLaTeX = try $ do

782792 cmd <- inlineLaTeXCommand

793+ ils <- (lift . lift) $ parseAsInlineLaTeX cmd

783794 maybe mzero returnF $

784− parseAsMath cmd `mplus` parseAsMathMLSym cmd `mplus` parseAsInlineLaTeX cmd

795+ parseAsMath cmd `mplus` parseAsMathMLSym cmd `mplus` ils

785796 where

786797 parseAsMath :: String -> Maybe Inlines

787798 parseAsMath cs = B.fromList <$> texMathToPandoc cs

788799

789− parseAsInlineLaTeX :: String -> Maybe Inlines

790− parseAsInlineLaTeX cs = maybeRight $ runParser inlineCommand state "" cs

800+ parseAsInlineLaTeX :: PandocMonad m => String -> m (Maybe Inlines)

801+ parseAsInlineLaTeX cs = maybeRight <$> runParserT inlineCommand state "" cs

791802

792803 parseAsMathMLSym :: String -> Maybe Inlines

793804 parseAsMathMLSym cs = B.str <$> MathMLEntityMap.getUnicode (clean cs)

@@ -803,10 +814,11 @@ inlineLaTeX = try $ do

803814maybeRight :: Either a b -> Maybe b

804815maybeRight = either (const Nothing) Just

805816

806−inlineLaTeXCommand :: OrgParser String

817+inlineLaTeXCommand :: PandocMonad m => OrgParser m String

807818inlineLaTeXCommand = try $ do

808819 rest <- getInput

809− case runParser rawLaTeXInline def "source" rest of

820+ parsed <- (lift . lift) $ runParserT rawLaTeXInline def "source" rest

821+ case parsed of

810822 Right (RawInline _ cs) -> do

811823 -- drop any trailing whitespace, those are not be part of the command as

812824 -- far as org mode is concerned.

@@ -820,14 +832,14 @@ inlineLaTeXCommand = try $ do

820832dropWhileEnd :: (a -> Bool) -> [a] -> [a]

821833dropWhileEnd p = foldr (\x xs -> if p x && null xs then [] else x : xs) []

822834

823−exportSnippet :: OrgParser (F Inlines)

835+exportSnippet :: PandocMonad m => OrgParser m (F Inlines)

824836exportSnippet = try $ do

825837 string "@@"

826838 format <- many1Till (alphaNum <|> char '-') (char ':')

827839 snippet <- manyTill anyChar (try $ string "@@")

828840 returnF $ B.rawInline format snippet

829841

830−smart :: OrgParser (F Inlines)

842+smart :: PandocMonad m => OrgParser m (F Inlines)

831843smart = do

832844 getOption readerSmart >>= guard

833845 doubleQuoted <|> singleQuoted <|>

@@ -844,7 +856,7 @@ smart = do

844856 <* updateLastForbiddenCharPos

845857 *> return (B.str "\x2019")

846858

847−singleQuoted :: OrgParser (F Inlines)

859+singleQuoted :: PandocMonad m => OrgParser m (F Inlines)

848860singleQuoted = try $ do

849861 guard =<< getExportSetting exportSmartQuotes

850862 singleQuoteStart

@@ -856,7 +868,7 @@ singleQuoted = try $ do

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

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

858870-- in the same paragraph.

859−doubleQuoted :: OrgParser (F Inlines)

871+doubleQuoted :: PandocMonad m => OrgParser m (F Inlines)

860872doubleQuoted = try $ do

861873 guard =<< getExportSetting exportSmartQuotes

862874 doubleQuoteStart

src/Text/Pandoc/Readers/Org/Meta.hs+23−22

@@ -41,6 +41,7 @@ import Text.Pandoc.Readers.Org.Parsing

4141

4242import qualified Text.Pandoc.Builder as B

4343import Text.Pandoc.Builder ( Blocks, Inlines )

44+import Text.Pandoc.Class ( PandocMonad )

4445import Text.Pandoc.Definition

4546

4647import Control.Monad ( mzero, void )

@@ -51,7 +52,7 @@ import Data.Monoid ( (<>) )

5152import Network.HTTP ( urlEncode )

5253

5354-- | Returns the current meta, respecting export options.

54−metaExport :: OrgParser (F Meta)

55+metaExport :: Monad m => OrgParser m (F Meta)

5556metaExport = do

5657 st <- getState

5758 let settings = orgStateExportSettings st

@@ -68,10 +69,10 @@ removeMeta key meta' =

6869-- | Parse and handle a single line containing meta information

6970-- The order, in which blocks are tried, makes sure that we're not looking at

7071-- the beginning of a block, so we don't need to check for it

71−metaLine :: OrgParser Blocks

72+metaLine :: PandocMonad m => OrgParser m Blocks

7273metaLine = mempty <$ metaLineStart <* (optionLine <|> declarationLine)

7374

74−declarationLine :: OrgParser ()

75+declarationLine :: PandocMonad m => OrgParser m ()

7576declarationLine = try $ do

7677 key <- map toLower <$> metaKey

7778 (key', value) <- metaValue key

@@ -79,12 +80,12 @@ declarationLine = try $ do

7980 let meta' = B.setMeta key' <$> value <*> pure nullMeta

8081 in st { orgStateMeta = meta' <> orgStateMeta st }

8182

82−metaKey :: OrgParser String

83+metaKey :: Monad m => OrgParser m String

8384metaKey = map toLower <$> many1 (noneOf ": \n\r")

8485 <* char ':'

8586 <* skipSpaces

8687

87−metaValue :: String -> OrgParser (String, (F MetaValue))

88+metaValue :: PandocMonad m => String -> OrgParser m (String, (F MetaValue))

8889metaValue key =

8990 let inclKey = "header-includes"

9091 in case key of

@@ -103,10 +104,10 @@ metaValue key =

103104 accumulatingList inclKey (metaExportSnippet "html")

104105 _ -> (key,) <$> metaString

105106

106−metaInlines :: OrgParser (F MetaValue)

107+metaInlines :: PandocMonad m => OrgParser m (F MetaValue)

107108metaInlines = fmap (MetaInlines . B.toList) <$> inlinesTillNewline

108109

109−metaInlinesCommaSeparated :: OrgParser (F MetaValue)

110+metaInlinesCommaSeparated :: PandocMonad m => OrgParser m (F MetaValue)

110111metaInlinesCommaSeparated = do

111112 authStrs <- (many1 (noneOf ",\n")) `sepBy1` (char ',')

112113 newline

@@ -114,21 +115,21 @@ metaInlinesCommaSeparated = do

114115 let toMetaInlines = MetaInlines . B.toList

115116 return $ MetaList . map toMetaInlines <$> sequence authors

116117

117−metaString :: OrgParser (F MetaValue)

118+metaString :: Monad m => OrgParser m (F MetaValue)

118119metaString = metaModifiedString id

119120

120−metaModifiedString :: (String -> String) -> OrgParser (F MetaValue)

121+metaModifiedString :: Monad m => (String -> String) -> OrgParser m (F MetaValue)

121122metaModifiedString f = return . MetaString . f <$> anyLine

122123

123124-- | Read an format specific meta definition

124−metaExportSnippet :: String -> OrgParser (F MetaValue)

125+metaExportSnippet :: Monad m => String -> OrgParser m (F MetaValue)

125126metaExportSnippet format =

126127 return . MetaInlines . B.toList . B.rawInline format <$> anyLine

127128

128129-- | Accumulate the result of the @parser@ in a list under @key@.

129−accumulatingList :: String

130− -> OrgParser (F MetaValue)

131− -> OrgParser (F MetaValue)

130+accumulatingList :: Monad m => String

131+ -> OrgParser m (F MetaValue)

132+ -> OrgParser m (F MetaValue)

132133accumulatingList key p = do

133134 value <- p

134135 meta' <- orgStateMeta <$> getState

@@ -141,7 +142,7 @@ accumulatingList key p = do

141142--

142143-- export options

143144--

144−optionLine :: OrgParser ()

145+optionLine :: Monad m => OrgParser m ()

145146optionLine = try $ do

146147 key <- metaKey

147148 case key of

@@ -152,14 +153,14 @@ optionLine = try $ do

152153 "typ_todo" -> todoSequence >>= updateState . registerTodoSequence

153154 _ -> mzero

154155

155−addLinkFormat :: String

156+addLinkFormat :: Monad m => String

156157 -> (String -> String)

157− -> OrgParser ()

158+ -> OrgParser m ()

158159addLinkFormat key formatter = updateState $ \s ->

159160 let fs = orgStateLinkFormatters s

160161 in s{ orgStateLinkFormatters = M.insert key formatter fs }

161162

162−parseLinkFormat :: OrgParser ((String, String -> String))

163+parseLinkFormat :: Monad m => OrgParser m ((String, String -> String))

163164parseLinkFormat = try $ do

164165 linkType <- (:) <$> letter <*> many (alphaNum <|> oneOf "-_") <* skipSpaces

165166 linkSubst <- parseFormat

@@ -167,7 +168,7 @@ parseLinkFormat = try $ do

167168

168169-- | An ad-hoc, single-argument-only implementation of a printf-style format

169170-- parser.

170−parseFormat :: OrgParser (String -> String)

171+parseFormat :: Monad m => OrgParser m (String -> String)

171172parseFormat = try $ do

172173 replacePlain <|> replaceUrl <|> justAppend

173174 where

@@ -181,13 +182,13 @@ parseFormat = try $ do

181182 rest = manyTill anyChar (eof <|> () <$ oneOf "\n\r")

182183 tillSpecifier c = manyTill (noneOf "\n\r") (try $ string ('%':c:""))

183184

184−inlinesTillNewline :: OrgParser (F Inlines)

185+inlinesTillNewline :: PandocMonad m => OrgParser m (F Inlines)

185186inlinesTillNewline = trimInlinesF . mconcat <$> manyTill inline newline

186187

187188--

188189-- ToDo Sequences and Keywords

189190--

190−todoSequence :: OrgParser TodoSequence

191+todoSequence :: Monad m => OrgParser m TodoSequence

191192todoSequence = try $ do

192193 todoKws <- todoKeywords

193194 doneKws <- optionMaybe $ todoDoneSep *> todoKeywords

@@ -201,13 +202,13 @@ todoSequence = try $ do

201202 (x:xs) -> return $ keywordsToSequence (reverse xs) [x]

202203

203204 where

204− todoKeywords :: OrgParser [String]

205+ todoKeywords :: Monad m => OrgParser m [String]

205206 todoKeywords = try $

206207 let keyword = many1 nonspaceChar <* skipSpaces

207208 endOfKeywords = todoDoneSep <|> void newline

208209 in manyTill keyword (lookAhead endOfKeywords)

209210

210− todoDoneSep :: OrgParser ()

211+ todoDoneSep :: Monad m => OrgParser m ()

211212 todoDoneSep = void . try $ skipSpaces *> char '|' <* skipSpaces1

212213

213214 keywordsToSequence :: [String] -> [String] -> TodoSequence

src/Text/Pandoc/Readers/Org/ParserState.hs+2−2

@@ -51,7 +51,7 @@ module Text.Pandoc.Readers.Org.ParserState

5151 ) where

5252

5353import Control.Monad (liftM, liftM2)

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

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

5555

5656import Data.Default (Default(..))

5757import qualified Data.Map as M

@@ -122,7 +122,7 @@ instance HasLastStrPosition OrgParserState where

122122 getLastStrPos = orgStateLastStrPos

123123 setLastStrPos pos st = st{ orgStateLastStrPos = Just pos }

124124

125−instance HasQuoteContext st (Reader OrgParserLocal) where

125+instance Monad m => HasQuoteContext st (ReaderT OrgParserLocal m) where

126126 getQuoteContext = asks orgLocalQuoteContext

127127 withQuoteContext q = local (\s -> s{orgLocalQuoteContext = q})

128128

src/Text/Pandoc/Readers/Org/Parsing.hs+19−17

@@ -72,6 +72,7 @@ module Text.Pandoc.Readers.Org.Parsing

7272 , citeKey

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

7474 , runParser

75+ , runParserT

7576 , getInput

7677 , char

7778 , letter

@@ -114,17 +115,17 @@ import Text.Pandoc.Parsing hiding ( anyLine, blanklines, newline

114115 , parseFromString )

115116

116117import Control.Monad ( guard )

117−import Control.Monad.Reader ( Reader )

118+import Control.Monad.Reader ( ReaderT )

118119

119120-- | The parser used to read org files.

120−type OrgParser = ParserT [Char] OrgParserState (Reader OrgParserLocal)

121+type OrgParser m = ParserT [Char] OrgParserState (ReaderT OrgParserLocal m)

121122

122123--

123124-- Adaptions and specializations of parsing utilities

124125--

125126

126127-- | Parse any line of text

127−anyLine :: OrgParser String

128+anyLine :: Monad m => OrgParser m String

128129anyLine =

129130 P.anyLine

130131 <* updateLastPreCharPos

@@ -132,7 +133,7 @@ anyLine =

132133

133134-- The version Text.Pandoc.Parsing cannot be used, as we need additional parts

134135-- of the state saved and restored.

135−parseFromString :: OrgParser a -> String -> OrgParser a

136+parseFromString :: Monad m => OrgParser m a -> String -> OrgParser m a

136137parseFromString parser str' = do

137138 oldLastPreCharPos <- orgStateLastPreCharPos <$> getState

138139 updateState $ \s -> s{ orgStateLastPreCharPos = Nothing }

@@ -141,33 +142,34 @@ parseFromString parser str' = do

141142 return result

142143

143144-- | Skip one or more tab or space characters.

144−skipSpaces1 :: OrgParser ()

145+skipSpaces1 :: Monad m => OrgParser m ()

145146skipSpaces1 = skipMany1 spaceChar

146147

147148-- | Like @Text.Parsec.Char.newline@, but causes additional state changes.

148−newline :: OrgParser Char

149+newline :: Monad m => OrgParser m Char

149150newline =

150151 P.newline

151152 <* updateLastPreCharPos

152153 <* updateLastForbiddenCharPos

153154

154155-- | Like @Text.Parsec.Char.blanklines@, but causes additional state changes.

155−blanklines :: OrgParser [Char]

156+blanklines :: Monad m => OrgParser m [Char]

156157blanklines =

157158 P.blanklines

158159 <* updateLastPreCharPos

159160 <* updateLastForbiddenCharPos

160161

161162-- | Succeeds when we're in list context.

162−inList :: OrgParser ()

163+inList :: Monad m => OrgParser m ()

163164inList = do

164165 ctx <- orgStateParserContext <$> getState

165166 guard (ctx == ListItemState)

166167

167168-- | Parse in different context

168−withContext :: ParserContext -- ^ New parser context

169− -> OrgParser a -- ^ Parser to run in that context

170− -> OrgParser a

169+withContext :: Monad m

170+ => ParserContext -- ^ New parser context

171+ -> OrgParser m a -- ^ Parser to run in that context

172+ -> OrgParser m a

171173withContext context parser = do

172174 oldContext <- orgStateParserContext <$> getState

173175 updateState $ \s -> s{ orgStateParserContext = context }

@@ -180,19 +182,19 @@ withContext context parser = do

180182--

181183

182184-- | Get an export setting.

183−getExportSetting :: (ExportSettings -> a) -> OrgParser a

185+getExportSetting :: Monad m => (ExportSettings -> a) -> OrgParser m a

184186getExportSetting s = s . orgStateExportSettings <$> getState

185187

186188-- | Set the current position as the last position at which a forbidden char

187189-- was found (i.e. a character which is not allowed at the inner border of

188190-- markup).

189−updateLastForbiddenCharPos :: OrgParser ()

191+updateLastForbiddenCharPos :: Monad m => OrgParser m ()

190192updateLastForbiddenCharPos = getPosition >>= \p ->

191193 updateState $ \s -> s{ orgStateLastForbiddenCharPos = Just p}

192194

193195-- | Set the current parser position as the position at which a character was

194196-- seen which allows inline markup to follow.

195−updateLastPreCharPos :: OrgParser ()

197+updateLastPreCharPos :: Monad m => OrgParser m ()

196198updateLastPreCharPos = getPosition >>= \p ->

197199 updateState $ \s -> s{ orgStateLastPreCharPos = Just p}

198200

@@ -201,15 +203,15 @@ updateLastPreCharPos = getPosition >>= \p ->

201203--

202204

203205-- | Read the key of a plist style key-value list.

204−orgArgKey :: OrgParser String

206+orgArgKey :: Monad m => OrgParser m String

205207orgArgKey = try $

206208 skipSpaces *> char ':'

207209 *> many1 orgArgWordChar

208210

209211-- | Read the value of a plist style key-value list.

210−orgArgWord :: OrgParser String

212+orgArgWord :: Monad m => OrgParser m String

211213orgArgWord = many1 orgArgWordChar

212214

213215-- | Chars treated as part of a word in plists.

214−orgArgWordChar :: OrgParser Char

216+orgArgWordChar :: Monad m => OrgParser m Char

215217orgArgWordChar = alphaNum <|> oneOf "-_"

src/Text/Pandoc/Readers/RST.hs+130−115

@@ -49,18 +49,29 @@ import qualified Text.Pandoc.Builder as B

4949import Data.Sequence (viewr, ViewR(..))

5050import Data.Char (toLower, isHexDigit, isSpace)

5151import Data.Monoid ((<>))

52−import Text.Pandoc.Error

52+import Control.Monad.Except (throwError)

53+import Control.Monad.Trans (lift)

54+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))

55+import qualified Text.Pandoc.Class as P

5356

5457-- | Parse reStructuredText string and return Pandoc document.

55−readRST :: ReaderOptions -- ^ Reader options

58+readRST :: PandocMonad m

59+ => ReaderOptions -- ^ Reader options

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

57− -> Either PandocError Pandoc

58−readRST opts s = (readWith parseRST) def{ stateOptions = opts } (s ++ "\n\n")

61+ -> m Pandoc

62+readRST opts s = do

63+ parsed <- (readWithM parseRST) def{ stateOptions = opts } (s ++ "\n\n")

64+ case parsed of

65+ Right result -> return result

66+ Left _ -> throwError $ PandocParseError "error parsing rst"

5967

60−readRSTWithWarnings :: ReaderOptions -> String -> Either PandocError (Pandoc, [String])

61−readRSTWithWarnings opts s = (readWithWarnings parseRST) def{ stateOptions = opts } (s ++ "\n\n")

68+readRSTWithWarnings :: PandocMonad m

69+ => ReaderOptions -- ^ Reader options

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

71+ -> m Pandoc

72+readRSTWithWarnings = readRST

6273

63−type RSTParser = Parser [Char] ParserState

74+type RSTParser m = ParserT [Char] ParserState m

6475

6576--

6677-- Constants and data structure definitions

@@ -141,7 +152,7 @@ metaFromDefList ds meta = adjustAuthors $ foldr f meta ds

141152 factorSemi (Str ys)

142153 factorSemi x = [x]

143154

144−parseRST :: RSTParser Pandoc

155+parseRST :: PandocMonad m => RSTParser m Pandoc

145156parseRST = do

146157 optional blanklines -- skip blank lines at beginning of file

147158 startPos <- getPosition

@@ -168,10 +179,10 @@ parseRST = do

168179-- parsing blocks

169180--

170181

171−parseBlocks :: RSTParser Blocks

182+parseBlocks :: PandocMonad m => RSTParser m Blocks

172183parseBlocks = mconcat <$> manyTill block eof

173184

174−block :: RSTParser Blocks

185+block :: PandocMonad m => RSTParser m Blocks

175186block = choice [ codeBlock

176187 , blockQuote

177188 , fieldList

@@ -191,7 +202,7 @@ block = choice [ codeBlock

191202-- field list

192203--

193204

194−rawFieldListItem :: Int -> RSTParser (String, String)

205+rawFieldListItem :: Monad m => Int -> RSTParser m (String, String)

195206rawFieldListItem minIndent = try $ do

196207 indent <- length <$> many (char ' ')

197208 guard $ indent >= minIndent

@@ -204,7 +215,7 @@ rawFieldListItem minIndent = try $ do

204215 let raw = (if null first then "" else (first ++ "\n")) ++ rest ++ "\n"

205216 return (name, raw)

206217

207−fieldListItem :: Int -> RSTParser (Inlines, [Blocks])

218+fieldListItem :: PandocMonad m => Int -> RSTParser m (Inlines, [Blocks])

208219fieldListItem minIndent = try $ do

209220 (name, raw) <- rawFieldListItem minIndent

210221 term <- parseInlineFromString name

@@ -212,7 +223,7 @@ fieldListItem minIndent = try $ do

212223 optional blanklines

213224 return (term, [contents])

214225

215−fieldList :: RSTParser Blocks

226+fieldList :: PandocMonad m => RSTParser m Blocks

216227fieldList = try $ do

217228 indent <- length <$> lookAhead (many spaceChar)

218229 items <- many1 $ fieldListItem indent

@@ -224,7 +235,7 @@ fieldList = try $ do

224235-- line block

225236--

226237

227−lineBlock :: RSTParser Blocks

238+lineBlock :: PandocMonad m => RSTParser m Blocks

228239lineBlock = try $ do

229240 lines' <- lineBlockLines

230241 lines'' <- mapM parseInlineFromString lines'

@@ -235,7 +246,7 @@ lineBlock = try $ do

235246--

236247

237248-- note: paragraph can end in a :: starting a code block

238−para :: RSTParser Blocks

249+para :: PandocMonad m => RSTParser m Blocks

239250para = try $ do

240251 result <- trimInlines . mconcat <$> many1 inline

241252 option (B.plain result) $ try $ do

@@ -248,18 +259,18 @@ para = try $ do

248259 <> raw

249260 _ -> return (B.para result)

250261

251−plain :: RSTParser Blocks

262+plain :: PandocMonad m => RSTParser m Blocks

252263plain = B.plain . trimInlines . mconcat <$> many1 inline

253264

254265--

255266-- header blocks

256267--

257268

258−header :: RSTParser Blocks

269+header :: PandocMonad m => RSTParser m Blocks

259270header = doubleHeader <|> singleHeader <?> "header"

260271

261272-- a header with lines on top and bottom

262−doubleHeader :: RSTParser Blocks

273+doubleHeader :: PandocMonad m => RSTParser m Blocks

263274doubleHeader = try $ do

264275 c <- oneOf underlineChars

265276 rest <- many (char c) -- the top line

@@ -285,7 +296,7 @@ doubleHeader = try $ do

285296 return $ B.headerWith attr level txt

286297

287298-- a header with line on the bottom only

288−singleHeader :: RSTParser Blocks

299+singleHeader :: PandocMonad m => RSTParser m Blocks

289300singleHeader = try $ do

290301 notFollowedBy' whitespace

291302 txt <- trimInlines . mconcat <$> many1 (do {notFollowedBy blankline; inline})

@@ -309,7 +320,7 @@ singleHeader = try $ do

309320-- hrule block

310321--

311322

312−hrule :: Parser [Char] st Blocks

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

313324hrule = try $ do

314325 chr <- oneOf underlineChars

315326 count 3 (char chr)

@@ -323,14 +334,14 @@ hrule = try $ do

323334--

324335

325336-- read a line indented by a given string

326−indentedLine :: String -> Parser [Char] st [Char]

337+indentedLine :: Monad m => String -> ParserT [Char] st m [Char]

327338indentedLine indents = try $ do

328339 string indents

329340 anyLine

330341

331342-- one or more indented lines, possibly separated by blank lines.

332343-- any amount of indentation will work.

333−indentedBlock :: Parser [Char] st [Char]

344+indentedBlock :: Monad m => ParserT [Char] st m [Char]

334345indentedBlock = try $ do

335346 indents <- lookAhead $ many1 spaceChar

336347 lns <- many1 $ try $ do b <- option "" blanklines

@@ -339,24 +350,24 @@ indentedBlock = try $ do

339350 optional blanklines

340351 return $ unlines lns

341352

342−quotedBlock :: Parser [Char] st [Char]

353+quotedBlock :: Monad m => ParserT [Char] st m [Char]

343354quotedBlock = try $ do

344355 quote <- lookAhead $ oneOf "!\"#$%&'()*+,-./:;<=>?@[\\]^_`{|}~"

345356 lns <- many1 $ lookAhead (char quote) >> anyLine

346357 optional blanklines

347358 return $ unlines lns

348359

349−codeBlockStart :: Parser [Char] st Char

360+codeBlockStart :: Monad m => ParserT [Char] st m Char

350361codeBlockStart = string "::" >> blankline >> blankline

351362

352−codeBlock :: Parser [Char] st Blocks

363+codeBlock :: Monad m => ParserT [Char] st m Blocks

353364codeBlock = try $ codeBlockStart >> codeBlockBody

354365

355−codeBlockBody :: Parser [Char] st Blocks

366+codeBlockBody :: Monad m => ParserT [Char] st m Blocks

356367codeBlockBody = try $ B.codeBlock . stripTrailingNewlines <$>

357368 (indentedBlock <|> quotedBlock)

358369

359−lhsCodeBlock :: RSTParser Blocks

370+lhsCodeBlock :: Monad m => RSTParser m Blocks

360371lhsCodeBlock = try $ do

361372 getPosition >>= guard . (==1) . sourceColumn

362373 guardEnabled Ext_literate_haskell

@@ -366,14 +377,14 @@ lhsCodeBlock = try $ do

366377 return $ B.codeBlockWith ("", ["sourceCode", "literate", "haskell"], [])

367378 $ intercalate "\n" lns

368379

369−latexCodeBlock :: Parser [Char] st [[Char]]

380+latexCodeBlock :: Monad m => ParserT [Char] st m [[Char]]

370381latexCodeBlock = try $ do

371382 try (latexBlockLine "\\begin{code}")

372383 many1Till anyLine (try $ latexBlockLine "\\end{code}")

373384 where

374385 latexBlockLine s = skipMany spaceChar >> string s >> blankline

375386

376−birdCodeBlock :: Parser [Char] st [[Char]]

387+birdCodeBlock :: Monad m => ParserT [Char] st m [[Char]]

377388birdCodeBlock = filterSpace <$> many1 birdTrackLine

378389 where filterSpace lns =

379390 -- if (as is normal) there is always a space after >, drop it

@@ -381,14 +392,14 @@ birdCodeBlock = filterSpace <$> many1 birdTrackLine

381392 then map (drop 1) lns

382393 else lns

383394

384−birdTrackLine :: Parser [Char] st [Char]

395+birdTrackLine :: Monad m => ParserT [Char] st m [Char]

385396birdTrackLine = char '>' >> anyLine

386397

387398--

388399-- block quotes

389400--

390401

391−blockQuote :: RSTParser Blocks

402+blockQuote :: PandocMonad m => RSTParser m Blocks

392403blockQuote = do

393404 raw <- indentedBlock

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

@@ -399,10 +410,10 @@ blockQuote = do

399410-- list blocks

400411--

401412

402−list :: RSTParser Blocks

413+list :: PandocMonad m => RSTParser m Blocks

403414list = choice [ bulletList, orderedList, definitionList ] <?> "list"

404415

405−definitionListItem :: RSTParser (Inlines, [Blocks])

416+definitionListItem :: PandocMonad m => RSTParser m (Inlines, [Blocks])

406417definitionListItem = try $ do

407418 -- avoid capturing a directive or comment

408419 notFollowedBy (try $ char '.' >> char '.')

@@ -412,11 +423,11 @@ definitionListItem = try $ do

412423 contents <- parseFromString parseBlocks $ raw ++ "\n"

413424 return (term, [contents])

414425

415−definitionList :: RSTParser Blocks

426+definitionList :: PandocMonad m => RSTParser m Blocks

416427definitionList = B.definitionList <$> many1 definitionListItem

417428

418429-- parses bullet list start and returns its length (inc. following whitespace)

419−bulletListStart :: Parser [Char] st Int

430+bulletListStart :: Monad m => ParserT [Char] st m Int

420431bulletListStart = try $ do

421432 notFollowedBy' hrule -- because hrules start out just like lists

422433 marker <- oneOf bulletListMarkers

@@ -424,16 +435,16 @@ bulletListStart = try $ do

424435 return $ length (marker:white)

425436

426437-- parses ordered list start and returns its length (inc following whitespace)

427−orderedListStart :: ListNumberStyle

438+orderedListStart :: Monad m => ListNumberStyle

428439 -> ListNumberDelim

429− -> RSTParser Int

440+ -> RSTParser m Int

430441orderedListStart style delim = try $ do

431442 (_, markerLen) <- withHorizDisplacement (orderedListMarker style delim)

432443 white <- many1 spaceChar

433444 return $ markerLen + length white

434445

435446-- parse a line of a list item

436−listLine :: Int -> RSTParser [Char]

447+listLine :: Monad m => Int -> RSTParser m [Char]

437448listLine markerLength = try $ do

438449 notFollowedBy blankline

439450 indentWith markerLength

@@ -441,7 +452,7 @@ listLine markerLength = try $ do

441452 return $ line ++ "\n"

442453

443454-- indent by specified number of spaces (or equiv. tabs)

444−indentWith :: Int -> RSTParser [Char]

455+indentWith :: Monad m => Int -> RSTParser m [Char]

445456indentWith num = do

446457 tabStop <- getOption readerTabStop

447458 if (num < tabStop)

@@ -450,8 +461,8 @@ indentWith num = do

450461 (try (char '\t' >> count (num - tabStop) (char ' '))) ]

451462

452463-- parse raw text for one list item, excluding start marker and continuations

453−rawListItem :: RSTParser Int

454− -> RSTParser (Int, [Char])

464+rawListItem :: Monad m => RSTParser m Int

465+ -> RSTParser m (Int, [Char])

455466rawListItem start = try $ do

456467 markerLength <- start

457468 firstLine <- anyLine

@@ -461,14 +472,15 @@ rawListItem start = try $ do

461472-- continuation of a list item - indented and separated by blankline or

462473-- (in compact lists) endline.

463474-- Note: nested lists are parsed as continuations.

464−listContinuation :: Int -> RSTParser [Char]

475+listContinuation :: Monad m => Int -> RSTParser m [Char]

465476listContinuation markerLength = try $ do

466477 blanks <- many1 blankline

467478 result <- many1 (listLine markerLength)

468479 return $ blanks ++ concat result

469480

470−listItem :: RSTParser Int

471− -> RSTParser Blocks

481+listItem :: PandocMonad m

482+ => RSTParser m Int

483+ -> RSTParser m Blocks

472484listItem start = try $ do

473485 (markerLength, first) <- rawListItem start

474486 rest <- many (listContinuation markerLength)

@@ -490,21 +502,21 @@ listItem start = try $ do

490502 [Para xs, DefinitionList ys] -> B.fromList [Plain xs, DefinitionList ys]

491503 _ -> parsed

492504

493−orderedList :: RSTParser Blocks

505+orderedList :: PandocMonad m => RSTParser m Blocks

494506orderedList = try $ do

495507 (start, style, delim) <- lookAhead (anyOrderedListMarker <* spaceChar)

496508 items <- many1 (listItem (orderedListStart style delim))

497509 let items' = compactify' items

498510 return $ B.orderedListWith (start, style, delim) items'

499511

500−bulletList :: RSTParser Blocks

512+bulletList :: PandocMonad m => RSTParser m Blocks

501513bulletList = B.bulletList . compactify' <$> many1 (listItem bulletListStart)

502514

503515--

504516-- directive (e.g. comment, container, compound-paragraph)

505517--

506518

507−comment :: RSTParser Blocks

519+comment :: Monad m => RSTParser m Blocks

508520comment = try $ do

509521 string ".."

510522 skipMany1 spaceChar <|> (() <$ lookAhead newline)

@@ -513,11 +525,11 @@ comment = try $ do

513525 optional indentedBlock

514526 return mempty

515527

516−directiveLabel :: RSTParser String

528+directiveLabel :: Monad m => RSTParser m String

517529directiveLabel = map toLower

518530 <$> many1Till (letter <|> char '-') (try $ string "::")

519531

520−directive :: RSTParser Blocks

532+directive :: PandocMonad m => RSTParser m Blocks

521533directive = try $ do

522534 string ".."

523535 directive'

@@ -526,7 +538,7 @@ directive = try $ do

526538-- date

527539-- include

528540-- title

529−directive' :: RSTParser Blocks

541+directive' :: PandocMonad m => RSTParser m Blocks

530542directive' = do

531543 skipMany1 spaceChar

532544 label <- directiveLabel

@@ -614,13 +626,13 @@ directive' = do

614626 return $ B.divWith attrs children

615627 other -> do

616628 pos <- getPosition

617− addWarning (Just pos) $ "ignoring unknown directive: " ++ other

629+ P.addWarningWithPos (Just pos) $ "ignoring unknown directive: " ++ other

618630 return mempty

619631

620632-- TODO:

621633-- - Only supports :format: fields with a single format for :raw: roles,

622634-- change Text.Pandoc.Definition.Format to fix

623−addNewRole :: String -> [(String, String)] -> RSTParser Blocks

635+addNewRole :: PandocMonad m => String -> [(String, String)] -> RSTParser m Blocks

624636addNewRole roleString fields = do

625637 (role, parentRole) <- parseFromString inheritedRole roleString

626638 customRoles <- stateRstCustomRoles <$> getState

@@ -642,20 +654,20 @@ addNewRole roleString fields = do

642654

643655 -- warn about syntax we ignore

644656 flip mapM_ fields $ \(key, _) -> case key of

645− "language" -> when (baseRole /= "code") $ addWarning Nothing $

657+ "language" -> when (baseRole /= "code") $ lift $ P.warn $

646658 "ignoring :language: field because the parent of role :" ++

647659 role ++ ": is :" ++ baseRole ++ ": not :code:"

648− "format" -> when (baseRole /= "raw") $ addWarning Nothing $

660+ "format" -> when (baseRole /= "raw") $ lift $ P.warn $

649661 "ignoring :format: field because the parent of role :" ++

650662 role ++ ": is :" ++ baseRole ++ ": not :raw:"

651− _ -> addWarning Nothing $ "ignoring unknown field :" ++ key ++

663+ _ -> lift $ P.warn $ "ignoring unknown field :" ++ key ++

652664 ": in definition of role :" ++ role ++ ": in"

653665 when (parentRole == "raw" && countKeys "format" > 1) $

654− addWarning Nothing $

666+ lift $ P.warn $

655667 "ignoring :format: fields after the first in the definition of role :"

656668 ++ role ++": in"

657669 when (parentRole == "code" && countKeys "language" > 1) $

658− addWarning Nothing $

670+ lift $ P.warn $

659671 "ignoring :language: fields after the first in the definition of role :"

660672 ++ role ++": in"

661673

@@ -700,7 +712,7 @@ extractUnicodeChar s = maybe Nothing (\c -> Just (c,rest)) mbc

700712 where (ds,rest) = span isHexDigit s

701713 mbc = safeRead ('\'':'\\':'x':ds ++ "'")

702714

703−extractCaption :: RSTParser (Inlines, Blocks)

715+extractCaption :: PandocMonad m => RSTParser m (Inlines, Blocks)

704716extractCaption = do

705717 capt <- trimInlines . mconcat <$> many inline

706718 legend <- optional blanklines >> (mconcat <$> many block)

@@ -712,7 +724,7 @@ toChunks = dropWhile null

712724 . map (trim . unlines)

713725 . splitBy (all (`elem` (" \t" :: String))) . lines

714726

715−codeblock :: [String] -> Maybe String -> String -> String -> RSTParser Blocks

727+codeblock :: [String] -> Maybe String -> String -> String -> RSTParser m Blocks

716728codeblock classes numberLines lang body =

717729 return $ B.codeBlockWith attribs $ stripTrailingNewlines body

718730 where attribs = ("", classes', kvs)

@@ -728,7 +740,7 @@ codeblock classes numberLines lang body =

728740--- note block

729741---

730742

731−noteBlock :: RSTParser [Char]

743+noteBlock :: Monad m => RSTParser m [Char]

732744noteBlock = try $ do

733745 startPos <- getPosition

734746 string ".."

@@ -747,7 +759,7 @@ noteBlock = try $ do

747759 -- return blanks so line count isn't affected

748760 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'

749761

750−noteMarker :: RSTParser [Char]

762+noteMarker :: Monad m => RSTParser m [Char]

751763noteMarker = do

752764 char '['

753765 res <- many1 digit

@@ -760,13 +772,13 @@ noteMarker = do

760772-- reference key

761773--

762774

763−quotedReferenceName :: RSTParser Inlines

775+quotedReferenceName :: PandocMonad m => RSTParser m Inlines

764776quotedReferenceName = try $ do

765777 char '`' >> notFollowedBy (char '`') -- `` means inline code!

766778 label' <- trimInlines . mconcat <$> many1Till inline (char '`')

767779 return label'

768780

769−unquotedReferenceName :: RSTParser Inlines

781+unquotedReferenceName :: PandocMonad m => RSTParser m Inlines

770782unquotedReferenceName = try $ do

771783 label' <- trimInlines . mconcat <$> many1Till inline (lookAhead $ char ':')

772784 return label'

@@ -775,24 +787,24 @@ unquotedReferenceName = try $ do

775787-- plus isolated (no two adjacent) internal hyphens, underscores,

776788-- periods, colons and plus signs; no whitespace or other characters

777789-- are allowed.

778−simpleReferenceName' :: Parser [Char] st String

790+simpleReferenceName' :: Monad m => ParserT [Char] st m String

779791simpleReferenceName' = do

780792 x <- alphaNum

781793 xs <- many $ alphaNum

782794 <|> (try $ oneOf "-_:+." <* lookAhead alphaNum)

783795 return (x:xs)

784796

785−simpleReferenceName :: Parser [Char] st Inlines

797+simpleReferenceName :: Monad m => ParserT [Char] st m Inlines

786798simpleReferenceName = do

787799 raw <- simpleReferenceName'

788800 return $ B.str raw

789801

790−referenceName :: RSTParser Inlines

802+referenceName :: PandocMonad m => RSTParser m Inlines

791803referenceName = quotedReferenceName <|>

792804 (try $ simpleReferenceName <* lookAhead (char ':')) <|>

793805 unquotedReferenceName

794806

795−referenceKey :: RSTParser [Char]

807+referenceKey :: PandocMonad m => RSTParser m [Char]

796808referenceKey = do

797809 startPos <- getPosition

798810 choice [substKey, anonymousKey, regularKey]

@@ -801,7 +813,7 @@ referenceKey = do

801813 -- return enough blanks to replace key

802814 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'

803815

804−targetURI :: Parser [Char] st [Char]

816+targetURI :: Monad m => ParserT [Char] st m [Char]

805817targetURI = do

806818 skipSpaces

807819 optional newline

@@ -810,7 +822,7 @@ targetURI = do

810822 blanklines

811823 return $ escapeURI $ trim $ contents

812824

813−substKey :: RSTParser ()

825+substKey :: PandocMonad m => RSTParser m ()

814826substKey = try $ do

815827 string ".."

816828 skipMany1 spaceChar

@@ -828,7 +840,7 @@ substKey = try $ do

828840 let key = toKey $ stripFirstAndLast ref

829841 updateState $ \s -> s{ stateSubstitutions = M.insert key il $ stateSubstitutions s }

830842

831−anonymousKey :: RSTParser ()

843+anonymousKey :: Monad m => RSTParser m ()

832844anonymousKey = try $ do

833845 oneOfStrings [".. __:", "__"]

834846 src <- targetURI

@@ -842,7 +854,7 @@ stripTicks = reverse . stripTick . reverse . stripTick

842854 where stripTick ('`':xs) = xs

843855 stripTick xs = xs

844856

845−regularKey :: RSTParser ()

857+regularKey :: PandocMonad m => RSTParser m ()

846858regularKey = try $ do

847859 string ".. _"

848860 (_,ref) <- withRaw referenceName

@@ -869,31 +881,31 @@ regularKey = try $ do

869881-- Grid tables TODO:

870882-- - column spans

871883

872−dashedLine :: Char -> Parser [Char] st (Int, Int)

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

873885dashedLine ch = do

874886 dashes <- many1 (char ch)

875887 sp <- many (char ' ')

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

877889

878−simpleDashedLines :: Char -> Parser [Char] st [(Int,Int)]

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

879891simpleDashedLines ch = try $ many1 (dashedLine ch)

880892

881893-- Parse a table row separator

882−simpleTableSep :: Char -> RSTParser Char

894+simpleTableSep :: Monad m => Char -> RSTParser m Char

883895simpleTableSep ch = try $ simpleDashedLines ch >> newline

884896

885897-- Parse a table footer

886−simpleTableFooter :: RSTParser [Char]

898+simpleTableFooter :: Monad m => RSTParser m [Char]

887899simpleTableFooter = try $ simpleTableSep '=' >> blanklines

888900

889901-- Parse a raw line and split it into chunks by indices.

890−simpleTableRawLine :: [Int] -> RSTParser [String]

902+simpleTableRawLine :: Monad m => [Int] -> RSTParser m [String]

891903simpleTableRawLine indices = do

892904 line <- many1Till anyChar newline

893905 return (simpleTableSplitLine indices line)

894906

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

896−simpleTableRow :: [Int] -> RSTParser [[Block]]

908+simpleTableRow :: PandocMonad m => [Int] -> RSTParser m [[Block]]

897909simpleTableRow indices = do

898910 notFollowedBy' simpleTableFooter

899911 firstLine <- simpleTableRawLine indices

@@ -906,8 +918,9 @@ simpleTableSplitLine indices line =

906918 map trim

907919 $ tail $ splitByIndices (init indices) line

908920

909−simpleTableHeader :: Bool -- ^ Headerless table

910− -> RSTParser ([[Block]], [Alignment], [Int])

921+simpleTableHeader :: PandocMonad m

922+ => Bool -- ^ Headerless table

923+ -> RSTParser m ([[Block]], [Alignment], [Int])

911924simpleTableHeader headless = try $ do

912925 optional blanklines

913926 rawContent <- if headless

@@ -926,8 +939,9 @@ simpleTableHeader headless = try $ do

926939 return (heads, aligns, indices)

927940

928941-- Parse a simple table.

929−simpleTable :: Bool -- ^ Headerless table

930− -> RSTParser Blocks

942+simpleTable :: PandocMonad m

943+ => Bool -- ^ Headerless table

944+ -> RSTParser m Blocks

931945simpleTable headless = do

932946 Table c a _w h l <- tableWith (simpleTableHeader headless) simpleTableRow sep simpleTableFooter

933947 -- Simple tables get 0s for relative column widths (i.e., use default)

@@ -935,12 +949,13 @@ simpleTable headless = do

935949 where

936950 sep = return () -- optional (simpleTableSep '-')

937951

938−gridTable :: Bool -- ^ Headerless table

939− -> RSTParser Blocks

952+gridTable :: PandocMonad m

953+ => Bool -- ^ Headerless table

954+ -> RSTParser m Blocks

940955gridTable headerless = B.singleton

941956 <$> gridTableWith (B.toList <$> parseBlocks) headerless

942957

943−table :: RSTParser Blocks

958+table :: PandocMonad m => RSTParser m Blocks

944959table = gridTable False <|> simpleTable False <|>

945960 gridTable True <|> simpleTable True <?> "table"

946961

@@ -948,7 +963,7 @@ table = gridTable False <|> simpleTable False <|>

948963-- inline

949964--

950965

951−inline :: RSTParser Inlines

966+inline :: PandocMonad m => RSTParser m Inlines

952967inline = choice [ note -- can start with whitespace, so try before ws

953968 , whitespace

954969 , link

@@ -964,29 +979,29 @@ inline = choice [ note -- can start with whitespace, so try before ws

964979 , escapedChar

965980 , symbol ] <?> "inline"

966981

967−parseInlineFromString :: String -> RSTParser Inlines

982+parseInlineFromString :: PandocMonad m => String -> RSTParser m Inlines

968983parseInlineFromString = parseFromString (trimInlines . mconcat <$> many inline)

969984

970−hyphens :: RSTParser Inlines

985+hyphens :: Monad m => RSTParser m Inlines

971986hyphens = do

972987 result <- many1 (char '-')

973988 optional endline

974989 -- don't want to treat endline after hyphen or dash as a space

975990 return $ B.str result

976991

977−escapedChar :: Parser [Char] st Inlines

992+escapedChar :: Monad m => ParserT [Char] st m Inlines

978993escapedChar = do c <- escaped anyChar

979994 return $ if c == ' ' -- '\ ' is null in RST

980995 then mempty

981996 else B.str [c]

982997

983−symbol :: RSTParser Inlines

998+symbol :: Monad m => RSTParser m Inlines

984999symbol = do

9851000 result <- oneOf specialChars

9861001 return $ B.str [result]

9871002

9881003-- parses inline code, between codeStart and codeEnd

989−code :: RSTParser Inlines

1004+code :: Monad m => RSTParser m Inlines

9901005code = try $ do

9911006 string "``"

9921007 result <- manyTill anyChar (try (string "``"))

@@ -994,7 +1009,7 @@ code = try $ do

9941009 $ trim $ unwords $ lines result

9951010

9961011-- succeeds only if we're not right after a str (ie. in middle of word)

997−atStart :: RSTParser a -> RSTParser a

1012+atStart :: Monad m => RSTParser m a -> RSTParser m a

9981013atStart p = do

9991014 pos <- getPosition

10001015 st <- getState

@@ -1002,11 +1017,11 @@ atStart p = do

10021017 guard $ stateLastStrPos st /= Just pos

10031018 p

10041019

1005−emph :: RSTParser Inlines

1020+emph :: PandocMonad m => RSTParser m Inlines

10061021emph = B.emph . trimInlines . mconcat <$>

10071022 enclosed (atStart $ char '*') (char '*') inline

10081023

1009−strong :: RSTParser Inlines

1024+strong :: PandocMonad m => RSTParser m Inlines

10101025strong = B.strong . trimInlines . mconcat <$>

10111026 enclosed (atStart $ string "**") (try $ string "**") inline

10121027

@@ -1018,12 +1033,12 @@ strong = B.strong . trimInlines . mconcat <$>

10181033-- - Classes are silently discarded in addNewRole

10191034-- - Lacks sensible implementation for title-reference (which is the default)

10201035-- - Allows direct use of the :raw: role, rST only allows inherited use.

1021−interpretedRole :: RSTParser Inlines

1036+interpretedRole :: PandocMonad m => RSTParser m Inlines

10221037interpretedRole = try $ do

10231038 (role, contents) <- roleBefore <|> roleAfter

10241039 renderRole contents Nothing role nullAttr

10251040

1026−renderRole :: String -> Maybe String -> String -> Attr -> RSTParser Inlines

1041+renderRole :: PandocMonad m => String -> Maybe String -> String -> Attr -> RSTParser m Inlines

10271042renderRole contents fmt role attr = case role of

10281043 "sup" -> return $ B.superscript $ B.str contents

10291044 "superscript" -> return $ B.superscript $ B.str contents

@@ -1050,7 +1065,7 @@ renderRole contents fmt role attr = case role of

10501065 renderRole contents newFmt newRole newAttr

10511066 Nothing -> do

10521067 pos <- getPosition

1053− addWarning (Just pos) $ "ignoring unknown role :" ++ custom ++ ": in"

1068+ P.addWarningWithPos (Just pos) $ "ignoring unknown role :" ++ custom ++ ": in"

10541069 return $ B.str contents -- Undefined role

10551070 where

10561071 titleRef ref = return $ B.str ref -- FIXME: Not a sensible behaviour

@@ -1063,31 +1078,31 @@ renderRole contents fmt role attr = case role of

10631078addClass :: String -> Attr -> Attr

10641079addClass c (ident, classes, keyValues) = (ident, union classes [c], keyValues)

10651080

1066−roleName :: RSTParser String

1081+roleName :: PandocMonad m => RSTParser m String

10671082roleName = many1 (letter <|> char '-')

10681083

1069−roleMarker :: RSTParser String

1084+roleMarker :: PandocMonad m => RSTParser m String

10701085roleMarker = char ':' *> roleName <* char ':'

10711086

1072−roleBefore :: RSTParser (String,String)

1087+roleBefore :: PandocMonad m => RSTParser m (String,String)

10731088roleBefore = try $ do

10741089 role <- roleMarker

10751090 contents <- unmarkedInterpretedText

10761091 return (role,contents)

10771092

1078−roleAfter :: RSTParser (String,String)

1093+roleAfter :: PandocMonad m => RSTParser m (String,String)

10791094roleAfter = try $ do

10801095 contents <- unmarkedInterpretedText

10811096 role <- roleMarker <|> (stateRstDefaultRole <$> getState)

10821097 return (role,contents)

10831098

1084−unmarkedInterpretedText :: RSTParser [Char]

1099+unmarkedInterpretedText :: PandocMonad m => RSTParser m [Char]

10851100unmarkedInterpretedText = enclosed (atStart $ char '`') (char '`') anyChar

10861101

1087−whitespace :: RSTParser Inlines

1102+whitespace :: PandocMonad m => RSTParser m Inlines

10881103whitespace = B.space <$ skipMany1 spaceChar <?> "whitespace"

10891104

1090−str :: RSTParser Inlines

1105+str :: Monad m => RSTParser m Inlines

10911106str = do

10921107 let strChar = noneOf ("\t\n " ++ specialChars)

10931108 result <- many1 strChar

@@ -1095,7 +1110,7 @@ str = do

10951110 return $ B.str result

10961111

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

1098−endline :: RSTParser Inlines

1113+endline :: Monad m => RSTParser m Inlines

10991114endline = try $ do

11001115 newline

11011116 notFollowedBy blankline

@@ -1111,10 +1126,10 @@ endline = try $ do

11111126-- links

11121127--

11131128

1114−link :: RSTParser Inlines

1129+link :: PandocMonad m => RSTParser m Inlines

11151130link = choice [explicitLink, referenceLink, autoLink] <?> "link"

11161131

1117−explicitLink :: RSTParser Inlines

1132+explicitLink :: PandocMonad m => RSTParser m Inlines

11181133explicitLink = try $ do

11191134 char '`'

11201135 notFollowedBy (char '`') -- `` marks start of inline code

@@ -1143,7 +1158,7 @@ explicitLink = try $ do

11431158 _ -> return (src, "", nullAttr)

11441159 return $ B.linkWith attr (escapeURI src') tit label''

11451160

1146−referenceLink :: RSTParser Inlines

1161+referenceLink :: PandocMonad m => RSTParser m Inlines

11471162referenceLink = try $ do

11481163 (label',ref) <- withRaw (quotedReferenceName <|> simpleReferenceName) <*

11491164 char '_'

@@ -1169,20 +1184,20 @@ referenceLink = try $ do

11691184 when (isAnonKey key) $ updateState $ \s -> s{ stateKeys = M.delete key keyTable }

11701185 return $ B.linkWith attr src tit label'

11711186

1172−autoURI :: RSTParser Inlines

1187+autoURI :: Monad m => RSTParser m Inlines

11731188autoURI = do

11741189 (orig, src) <- uri

11751190 return $ B.link src "" $ B.str orig

11761191

1177−autoEmail :: RSTParser Inlines

1192+autoEmail :: Monad m => RSTParser m Inlines

11781193autoEmail = do

11791194 (orig, src) <- emailAddress

11801195 return $ B.link src "" $ B.str orig

11811196

1182−autoLink :: RSTParser Inlines

1197+autoLink :: PandocMonad m => RSTParser m Inlines

11831198autoLink = autoURI <|> autoEmail

11841199

1185−subst :: RSTParser Inlines

1200+subst :: PandocMonad m => RSTParser m Inlines

11861201subst = try $ do

11871202 (_,ref) <- withRaw $ enclosed (char '|') (char '|') inline

11881203 state <- getState

@@ -1196,7 +1211,7 @@ subst = try $ do

11961211 return mempty

11971212 Just target -> return target

11981213

1199−note :: RSTParser Inlines

1214+note :: PandocMonad m => RSTParser m Inlines

12001215note = try $ do

12011216 optional whitespace

12021217 ref <- noteMarker

@@ -1224,20 +1239,20 @@ note = try $ do

12241239 updateState $ \st -> st{ stateNotes = newnotes }

12251240 return $ B.note contents

12261241

1227−smart :: RSTParser Inlines

1242+smart :: PandocMonad m => RSTParser m Inlines

12281243smart = do

12291244 getOption readerSmart >>= guard

12301245 doubleQuoted <|> singleQuoted <|>

12311246 choice [apostrophe, dash, ellipses]

12321247

1233−singleQuoted :: RSTParser Inlines

1248+singleQuoted :: PandocMonad m => RSTParser m Inlines

12341249singleQuoted = try $ do

12351250 singleQuoteStart

12361251 withQuoteContext InSingleQuote $

12371252 B.singleQuoted . trimInlines . mconcat <$>

12381253 many1Till inline singleQuoteEnd

12391254

1240−doubleQuoted :: RSTParser Inlines

1255+doubleQuoted :: PandocMonad m => RSTParser m Inlines

12411256doubleQuoted = try $ do

12421257 doubleQuoteStart

12431258 withQuoteContext InDoubleQuote $

src/Text/Pandoc/Readers/TWiki.hs+16−9

@@ -30,7 +30,6 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

3030Conversion of twiki text to 'Pandoc' document.

3131-}

3232module Text.Pandoc.Readers.TWiki ( readTWiki

33− , readTWikiWithWarnings

3433 ) where

3534

3635import Text.Pandoc.Definition

@@ -48,17 +47,25 @@ import Data.Char (isAlphaNum)

4847import qualified Data.Foldable as F

4948import Text.Pandoc.Error

5049

51−-- | Read twiki from an input string and return a Pandoc document.

52−readTWiki :: ReaderOptions -- ^ Reader options

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

54− -> Either PandocError Pandoc

55−readTWiki opts s =

56− (readWith parseTWiki) def{ stateOptions = opts } (s ++ "\n\n")

50+import Control.Monad.Except (throwError)

51+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))

52+import qualified Text.Pandoc.Class as P

5753

58−readTWikiWithWarnings :: ReaderOptions -- ^ Reader options

54+-- | Read twiki from an input string and return a Pandoc document.

55+readTWiki :: PandocMonad m

56+ => ReaderOptions

57+ -> String

58+ -> m Pandoc

59+readTWiki opts s = case readTWikiWithWarnings' opts s of

60+ Right (doc, warns) -> do

61+ mapM_ P.warn warns

62+ return doc

63+ Left _ -> throwError $ PandocParseError "couldn't parse TWiki"

64+

65+readTWikiWithWarnings' :: ReaderOptions -- ^ Reader options

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

6067 -> Either PandocError (Pandoc, [String])

61−readTWikiWithWarnings opts s =

68+readTWikiWithWarnings' opts s =

6269 (readWith parseTWikiWithWarnings) def{ stateOptions = opts } (s ++ "\n\n")

6370 where parseTWikiWithWarnings = do

6471 doc <- parseTWiki

src/Text/Pandoc/Readers/Textile.hs+92−84

@@ -68,18 +68,23 @@ import Control.Monad ( guard, liftM, when )

6868import Data.Monoid ((<>))

6969import Text.Printf

7070import Debug.Trace (trace)

71−import Text.Pandoc.Error

71+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))

72+import Control.Monad.Except (throwError)

7273

7374-- | Parse a Textile text and return a Pandoc document.

74−readTextile :: ReaderOptions -- ^ Reader options

75+readTextile :: PandocMonad m

76+ => ReaderOptions -- ^ Reader options

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

76− -> Either PandocError Pandoc

77−readTextile opts s =

78− (readWith parseTextile) def{ stateOptions = opts } (s ++ "\n\n")

78+ -> m Pandoc

79+readTextile opts s = do

80+ parsed <- readWithM parseTextile def{ stateOptions = opts } (s ++ "\n\n")

81+ case parsed of

82+ Right result -> return result

83+ Left _ -> throwError $ PandocParseError "textile parse error"

7984

8085

8186-- | Generate a Pandoc ADT from a textile document

82−parseTextile :: Parser [Char] ParserState Pandoc

87+parseTextile :: PandocMonad m => ParserT [Char] ParserState m Pandoc

8388parseTextile = do

8489 -- textile allows raw HTML and does smart punctuation by default,

8590 -- but we do not enable smart punctuation unless it is explicitly

@@ -103,10 +108,10 @@ parseTextile = do

103108 blocks <- parseBlocks

104109 return $ Pandoc nullMeta (B.toList blocks) -- FIXME

105110

106−noteMarker :: Parser [Char] ParserState [Char]

111+noteMarker :: PandocMonad m => ParserT [Char] ParserState m [Char]

107112noteMarker = skipMany spaceChar >> string "fn" >> manyTill digit (char '.')

108113

109−noteBlock :: Parser [Char] ParserState [Char]

114+noteBlock :: PandocMonad m => ParserT [Char] ParserState m [Char]

110115noteBlock = try $ do

111116 startPos <- getPosition

112117 ref <- noteMarker

@@ -121,11 +126,11 @@ noteBlock = try $ do

121126 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'

122127

123128-- | Parse document blocks

124−parseBlocks :: Parser [Char] ParserState Blocks

129+parseBlocks :: PandocMonad m => ParserT [Char] ParserState m Blocks

125130parseBlocks = mconcat <$> manyTill block eof

126131

127132-- | Block parsers list tried in definition order

128−blockParsers :: [Parser [Char] ParserState Blocks]

133+blockParsers :: PandocMonad m => [ParserT [Char] ParserState m Blocks]

129134blockParsers = [ codeBlock

130135 , header

131136 , blockQuote

@@ -140,7 +145,7 @@ blockParsers = [ codeBlock

140145 ]

141146

142147-- | Any block in the order of definition of blockParsers

143−block :: Parser [Char] ParserState Blocks

148+block :: PandocMonad m => ParserT [Char] ParserState m Blocks

144149block = do

145150 res <- choice blockParsers <?> "block"

146151 pos <- getPosition

@@ -150,16 +155,16 @@ block = do

150155 (take 60 $ show $ B.toList res)) (return ())

151156 return res

152157

153−commentBlock :: Parser [Char] ParserState Blocks

158+commentBlock :: PandocMonad m => ParserT [Char] ParserState m Blocks

154159commentBlock = try $ do

155160 string "###."

156161 manyTill anyLine blanklines

157162 return mempty

158163

159−codeBlock :: Parser [Char] ParserState Blocks

164+codeBlock :: PandocMonad m => ParserT [Char] ParserState m Blocks

160165codeBlock = codeBlockBc <|> codeBlockPre

161166

162−codeBlockBc :: Parser [Char] ParserState Blocks

167+codeBlockBc :: PandocMonad m => ParserT [Char] ParserState m Blocks

163168codeBlockBc = try $ do

164169 string "bc."

165170 extended <- option False (True <$ char '.')

@@ -179,7 +184,7 @@ trimTrailingNewlines :: String -> String

179184trimTrailingNewlines = reverse . dropWhile (=='\n') . reverse

180185

181186-- | Code Blocks in Textile are between <pre> and </pre>

182−codeBlockPre :: Parser [Char] ParserState Blocks

187+codeBlockPre :: PandocMonad m => ParserT [Char] ParserState m Blocks

183188codeBlockPre = try $ do

184189 (t@(TagOpen _ attrs),_) <- htmlTag (tagOpen (=="pre") (const True))

185190 result' <- manyTill anyChar (htmlTag (tagClose (=="pre")))

@@ -198,7 +203,7 @@ codeBlockPre = try $ do

198203 return $ B.codeBlockWith (ident,classes,kvs) result'''

199204

200205-- | Header of the form "hN. content" with N in 1..6

201−header :: Parser [Char] ParserState Blocks

206+header :: PandocMonad m => ParserT [Char] ParserState m Blocks

202207header = try $ do

203208 char 'h'

204209 level <- digitToInt <$> oneOf "123456"

@@ -210,14 +215,14 @@ header = try $ do

210215 return $ B.headerWith attr' level name

211216

212217-- | Blockquote of the form "bq. content"

213−blockQuote :: Parser [Char] ParserState Blocks

218+blockQuote :: PandocMonad m => ParserT [Char] ParserState m Blocks

214219blockQuote = try $ do

215220 string "bq" >> attributes >> char '.' >> whitespace

216221 B.blockQuote <$> para

217222

218223-- Horizontal rule

219224

220−hrule :: Parser [Char] st Blocks

225+hrule :: PandocMonad m => ParserT [Char] st m Blocks

221226hrule = try $ do

222227 skipSpaces

223228 start <- oneOf "-*"

@@ -232,39 +237,39 @@ hrule = try $ do

232237-- | Can be a bullet list or an ordered list. This implementation is

233238-- strict in the nesting, sublist must start at exactly "parent depth

234239-- plus one"

235−anyList :: Parser [Char] ParserState Blocks

240+anyList :: PandocMonad m => ParserT [Char] ParserState m Blocks

236241anyList = try $ anyListAtDepth 1 <* blanklines

237242

238243-- | This allow one type of list to be nested into an other type,

239244-- provided correct nesting

240−anyListAtDepth :: Int -> Parser [Char] ParserState Blocks

245+anyListAtDepth :: PandocMonad m => Int -> ParserT [Char] ParserState m Blocks

241246anyListAtDepth depth = choice [ bulletListAtDepth depth,

242247 orderedListAtDepth depth,

243248 definitionList ]

244249

245250-- | Bullet List of given depth, depth being the number of leading '*'

246−bulletListAtDepth :: Int -> Parser [Char] ParserState Blocks

251+bulletListAtDepth :: PandocMonad m => Int -> ParserT [Char] ParserState m Blocks

247252bulletListAtDepth depth = try $ B.bulletList <$> many1 (bulletListItemAtDepth depth)

248253

249254-- | Bullet List Item of given depth, depth being the number of

250255-- leading '*'

251−bulletListItemAtDepth :: Int -> Parser [Char] ParserState Blocks

256+bulletListItemAtDepth :: PandocMonad m => Int -> ParserT [Char] ParserState m Blocks

252257bulletListItemAtDepth = genericListItemAtDepth '*'

253258

254259-- | Ordered List of given depth, depth being the number of

255260-- leading '#'

256−orderedListAtDepth :: Int -> Parser [Char] ParserState Blocks

261+orderedListAtDepth :: PandocMonad m => Int -> ParserT [Char] ParserState m Blocks

257262orderedListAtDepth depth = try $ do

258263 items <- many1 (orderedListItemAtDepth depth)

259264 return $ B.orderedList items

260265

261266-- | Ordered List Item of given depth, depth being the number of

262267-- leading '#'

263−orderedListItemAtDepth :: Int -> Parser [Char] ParserState Blocks

268+orderedListItemAtDepth :: PandocMonad m => Int -> ParserT [Char] ParserState m Blocks

264269orderedListItemAtDepth = genericListItemAtDepth '#'

265270

266271-- | Common implementation of list items

267−genericListItemAtDepth :: Char -> Int -> Parser [Char] ParserState Blocks

272+genericListItemAtDepth :: PandocMonad m => Char -> Int -> ParserT [Char] ParserState m Blocks

268273genericListItemAtDepth c depth = try $ do

269274 count depth (char c) >> attributes >> whitespace

270275 p <- mconcat <$> many listInline

@@ -273,25 +278,25 @@ genericListItemAtDepth c depth = try $ do

273278 return $ (B.plain p) <> sublist

274279

275280-- | A definition list is a set of consecutive definition items

276−definitionList :: Parser [Char] ParserState Blocks

281+definitionList :: PandocMonad m => ParserT [Char] ParserState m Blocks

277282definitionList = try $ B.definitionList <$> many1 definitionListItem

278283

279284-- | List start character.

280−listStart :: Parser [Char] ParserState ()

285+listStart :: PandocMonad m => ParserT [Char] ParserState m ()

281286listStart = genericListStart '*'

282287 <|> () <$ genericListStart '#'

283288 <|> () <$ definitionListStart

284289

285−genericListStart :: Char -> Parser [Char] st ()

290+genericListStart :: PandocMonad m => Char -> ParserT [Char] st m ()

286291genericListStart c = () <$ try (many1 (char c) >> whitespace)

287292

288−basicDLStart :: Parser [Char] ParserState ()

293+basicDLStart :: PandocMonad m => ParserT [Char] ParserState m ()

289294basicDLStart = do

290295 char '-'

291296 whitespace

292297 notFollowedBy newline

293298

294−definitionListStart :: Parser [Char] ParserState Inlines

299+definitionListStart :: PandocMonad m => ParserT [Char] ParserState m Inlines

295300definitionListStart = try $ do

296301 basicDLStart

297302 trimInlines . mconcat <$>

@@ -300,7 +305,7 @@ definitionListStart = try $ do

300305 <|> try (lookAhead (() <$ string ":="))

301306 )

302307

303−listInline :: Parser [Char] ParserState Inlines

308+listInline :: PandocMonad m => ParserT [Char] ParserState m Inlines

304309listInline = try (notFollowedBy newline >> inline)

305310 <|> try (endline <* notFollowedBy listStart)

306311

@@ -308,15 +313,15 @@ listInline = try (notFollowedBy newline >> inline)

308313-- the term defined, then spaces and ":=". The definition follows, on

309314-- the same single line, or spaned on multiple line, after a line

310315-- break.

311−definitionListItem :: Parser [Char] ParserState (Inlines, [Blocks])

316+definitionListItem :: PandocMonad m => ParserT [Char] ParserState m (Inlines, [Blocks])

312317definitionListItem = try $ do

313318 term <- (mconcat . intersperse B.linebreak) <$> many1 definitionListStart

314319 def' <- string ":=" *> optional whitespace *> (multilineDef <|> inlineDef)

315320 return (term, def')

316− where inlineDef :: Parser [Char] ParserState [Blocks]

321+ where inlineDef :: PandocMonad m => ParserT [Char] ParserState m [Blocks]

317322 inlineDef = liftM (\d -> [B.plain d])

318323 $ optional whitespace >> (trimInlines . mconcat <$> many listInline) <* newline

319− multilineDef :: Parser [Char] ParserState [Blocks]

324+ multilineDef :: PandocMonad m => ParserT [Char] ParserState m [Blocks]

320325 multilineDef = try $ do

321326 optional whitespace >> newline

322327 s <- many1Till anyChar (try (string "=:" >> newline))

@@ -327,7 +332,7 @@ definitionListItem = try $ do

327332-- raw content

328333

329334-- | A raw Html Block, optionally followed by blanklines

330−rawHtmlBlock :: Parser [Char] ParserState Blocks

335+rawHtmlBlock :: PandocMonad m => ParserT [Char] ParserState m Blocks

331336rawHtmlBlock = try $ do

332337 skipMany spaceChar

333338 (_,b) <- htmlTag isBlockTag

@@ -335,14 +340,14 @@ rawHtmlBlock = try $ do

335340 return $ B.rawBlock "html" b

336341

337342-- | Raw block of LaTeX content

338−rawLaTeXBlock' :: Parser [Char] ParserState Blocks

343+rawLaTeXBlock' :: PandocMonad m => ParserT [Char] ParserState m Blocks

339344rawLaTeXBlock' = do

340345 guardEnabled Ext_raw_tex

341346 B.rawBlock "latex" <$> (rawLaTeXBlock <* spaces)

342347

343348

344349-- | In textile, paragraphs are separated by blank lines.

345−para :: Parser [Char] ParserState Blocks

350+para :: PandocMonad m => ParserT [Char] ParserState m Blocks

346351para = B.para . trimInlines . mconcat <$> many1 inline

347352

348353-- Tables

@@ -353,7 +358,7 @@ toAlignment '>' = AlignRight

353358toAlignment '=' = AlignCenter

354359toAlignment _ = AlignDefault

355360

356−cellAttributes :: Parser [Char] ParserState (Bool, Alignment)

361+cellAttributes :: PandocMonad m => ParserT [Char] ParserState m (Bool, Alignment)

357362cellAttributes = try $ do

358363 isHeader <- option False (True <$ char '_')

359364 -- we just ignore colspan and rowspan markers:

@@ -366,7 +371,7 @@ cellAttributes = try $ do

366371 return (isHeader, alignment)

367372

368373-- | A table cell spans until a pipe |

369−tableCell :: Parser [Char] ParserState ((Bool, Alignment), Blocks)

374+tableCell :: PandocMonad m => ParserT [Char] ParserState m ((Bool, Alignment), Blocks)

370375tableCell = try $ do

371376 char '|'

372377 (isHeader, alignment) <- option (False, AlignDefault) $ cellAttributes

@@ -377,7 +382,7 @@ tableCell = try $ do

377382 return ((isHeader, alignment), B.plain content)

378383

379384-- | A table row is made of many table cells

380−tableRow :: Parser [Char] ParserState [((Bool, Alignment), Blocks)]

385+tableRow :: PandocMonad m => ParserT [Char] ParserState m [((Bool, Alignment), Blocks)]

381386tableRow = try $ do

382387 -- skip optional row attributes

383388 optional $ try $ do

@@ -387,7 +392,7 @@ tableRow = try $ do

387392 many1 tableCell <* char '|' <* blankline

388393

389394-- | A table with an optional header.

390−table :: Parser [Char] ParserState Blocks

395+table :: PandocMonad m => ParserT [Char] ParserState m Blocks

391396table = try $ do

392397 -- ignore table attributes

393398 caption <- option mempty $ try $ do

@@ -411,7 +416,7 @@ table = try $ do

411416 (map (map snd) rows)

412417

413418-- | Ignore markers for cols, thead, tfoot.

414−ignorableRow :: Parser [Char] ParserState ()

419+ignorableRow :: PandocMonad m => ParserT [Char] ParserState m ()

415420ignorableRow = try $ do

416421 char '|'

417422 oneOf ":^-~"

@@ -420,7 +425,7 @@ ignorableRow = try $ do

420425 _ <- anyLine

421426 return ()

422427

423−explicitBlockStart :: String -> Parser [Char] ParserState ()

428+explicitBlockStart :: PandocMonad m => String -> ParserT [Char] ParserState m ()

424429explicitBlockStart name = try $ do

425430 string name

426431 attributes

@@ -430,9 +435,10 @@ explicitBlockStart name = try $ do

430435

431436-- | Blocks like 'p' and 'table' do not need explicit block tag.

432437-- However, they can be used to set HTML/CSS attributes when needed.

433−maybeExplicitBlock :: String -- ^ block tag name

434− -> Parser [Char] ParserState Blocks -- ^ implicit block

435− -> Parser [Char] ParserState Blocks

438+maybeExplicitBlock :: PandocMonad m

439+ => String -- ^ block tag name

440+ -> ParserT [Char] ParserState m Blocks -- ^ implicit block

441+ -> ParserT [Char] ParserState m Blocks

436442maybeExplicitBlock name blk = try $ do

437443 optional $ explicitBlockStart name

438444 blk

@@ -445,12 +451,12 @@ maybeExplicitBlock name blk = try $ do

445451

446452

447453-- | Any inline element

448−inline :: Parser [Char] ParserState Inlines

454+inline :: PandocMonad m => ParserT [Char] ParserState m Inlines

449455inline = do

450456 choice inlineParsers <?> "inline"

451457

452458-- | Inline parsers tried in order

453−inlineParsers :: [Parser [Char] ParserState Inlines]

459+inlineParsers :: PandocMonad m => [ParserT [Char] ParserState m Inlines]

454460inlineParsers = [ str

455461 , whitespace

456462 , endline

@@ -470,7 +476,7 @@ inlineParsers = [ str

470476 ]

471477

472478-- | Inline markups

473−inlineMarkup :: Parser [Char] ParserState Inlines

479+inlineMarkup :: PandocMonad m => ParserT [Char] ParserState m Inlines

474480inlineMarkup = choice [ simpleInline (string "??") (B.cite [])

475481 , simpleInline (string "**") B.strong

476482 , simpleInline (string "__") B.emph

@@ -484,29 +490,29 @@ inlineMarkup = choice [ simpleInline (string "??") (B.cite [])

484490 ]

485491

486492-- | Trademark, registered, copyright

487−mark :: Parser [Char] st Inlines

493+mark :: PandocMonad m => ParserT [Char] st m Inlines

488494mark = try $ char '(' >> (try tm <|> try reg <|> copy)

489495

490−reg :: Parser [Char] st Inlines

496+reg :: PandocMonad m => ParserT [Char] st m Inlines

491497reg = do

492498 oneOf "Rr"

493499 char ')'

494500 return $ B.str "\174"

495501

496−tm :: Parser [Char] st Inlines

502+tm :: PandocMonad m => ParserT [Char] st m Inlines

497503tm = do

498504 oneOf "Tt"

499505 oneOf "Mm"

500506 char ')'

501507 return $ B.str "\8482"

502508

503−copy :: Parser [Char] st Inlines

509+copy :: PandocMonad m => ParserT [Char] st m Inlines

504510copy = do

505511 oneOf "Cc"

506512 char ')'

507513 return $ B.str "\169"

508514

509−note :: Parser [Char] ParserState Inlines

515+note :: PandocMonad m => ParserT [Char] ParserState m Inlines

510516note = try $ do

511517 ref <- (char '[' *> many1 digit <* char ']')

512518 notes <- stateNotes <$> getState

@@ -530,13 +536,13 @@ wordBoundaries :: [Char]

530536wordBoundaries = markupChars ++ stringBreakers

531537

532538-- | Parse a hyphened sequence of words

533−hyphenedWords :: Parser [Char] ParserState String

539+hyphenedWords :: PandocMonad m => ParserT [Char] ParserState m String

534540hyphenedWords = do

535541 x <- wordChunk

536542 xs <- many (try $ char '-' >> wordChunk)

537543 return $ intercalate "-" (x:xs)

538544

539−wordChunk :: Parser [Char] ParserState String

545+wordChunk :: PandocMonad m => ParserT [Char] ParserState m String

540546wordChunk = try $ do

541547 hd <- noneOf wordBoundaries

542548 tl <- many ( (noneOf wordBoundaries) <|>

@@ -545,7 +551,7 @@ wordChunk = try $ do

545551 return $ hd:tl

546552

547553-- | Any string

548−str :: Parser [Char] ParserState Inlines

554+str :: PandocMonad m => ParserT [Char] ParserState m Inlines

549555str = do

550556 baseStr <- hyphenedWords

551557 -- RedCloth compliance : if parsed word is uppercase and immediatly

@@ -558,11 +564,11 @@ str = do

558564 return $ B.str fullStr

559565

560566-- | Some number of space chars

561−whitespace :: Parser [Char] st Inlines

567+whitespace :: PandocMonad m => ParserT [Char] st m Inlines

562568whitespace = many1 spaceChar >> return B.space <?> "whitespace"

563569

564570-- | In Textile, an isolated endline character is a line break

565−endline :: Parser [Char] ParserState Inlines

571+endline :: PandocMonad m => ParserT [Char] ParserState m Inlines

566572endline = try $ do

567573 newline

568574 notFollowedBy blankline

@@ -570,18 +576,18 @@ endline = try $ do

570576 notFollowedBy rawHtmlBlock

571577 return B.linebreak

572578

573−rawHtmlInline :: Parser [Char] ParserState Inlines

579+rawHtmlInline :: PandocMonad m => ParserT [Char] ParserState m Inlines

574580rawHtmlInline = B.rawInline "html" . snd <$> htmlTag isInlineTag

575581

576582-- | Raw LaTeX Inline

577−rawLaTeXInline' :: Parser [Char] ParserState Inlines

583+rawLaTeXInline' :: PandocMonad m => ParserT [Char] ParserState m Inlines

578584rawLaTeXInline' = try $ do

579585 guardEnabled Ext_raw_tex

580586 B.singleton <$> rawLaTeXInline

581587

582588-- | Textile standard link syntax is "label":target. But we

583589-- can also have ["label":target].

584−link :: Parser [Char] ParserState Inlines

590+link :: PandocMonad m => ParserT [Char] ParserState m Inlines

585591link = try $ do

586592 bracketed <- (True <$ char '[') <|> return False

587593 char '"' *> notFollowedBy (oneOf " \t\n\r")

@@ -600,7 +606,7 @@ link = try $ do

600606 else B.spanWith attr $ B.link url "" name'

601607

602608-- | image embedding

603−image :: Parser [Char] ParserState Inlines

609+image :: PandocMonad m => ParserT [Char] ParserState m Inlines

604610image = try $ do

605611 char '!' >> notFollowedBy space

606612 (ident, cls, kvs) <- attributes

@@ -612,50 +618,50 @@ image = try $ do

612618 char '!'

613619 return $ B.imageWith attr src alt (B.str alt)

614620

615−escapedInline :: Parser [Char] ParserState Inlines

621+escapedInline :: PandocMonad m => ParserT [Char] ParserState m Inlines

616622escapedInline = escapedEqs <|> escapedTag

617623

618−escapedEqs :: Parser [Char] ParserState Inlines

624+escapedEqs :: PandocMonad m => ParserT [Char] ParserState m Inlines

619625escapedEqs = B.str <$>

620626 (try $ string "==" *> manyTill anyChar' (try $ string "=="))

621627

622628-- | literal text escaped btw <notextile> tags

623−escapedTag :: Parser [Char] ParserState Inlines

629+escapedTag :: PandocMonad m => ParserT [Char] ParserState m Inlines

624630escapedTag = B.str <$>

625631 (try $ string "<notextile>" *>

626632 manyTill anyChar' (try $ string "</notextile>"))

627633

628634-- | Any special symbol defined in wordBoundaries

629−symbol :: Parser [Char] ParserState Inlines

635+symbol :: PandocMonad m => ParserT [Char] ParserState m Inlines

630636symbol = B.str . singleton <$> (notFollowedBy newline *>

631637 notFollowedBy rawHtmlBlock *>

632638 oneOf wordBoundaries)

633639

634640-- | Inline code

635−code :: Parser [Char] ParserState Inlines

641+code :: PandocMonad m => ParserT [Char] ParserState m Inlines

636642code = code1 <|> code2

637643

638644-- any character except a newline before a blank line

639−anyChar' :: Parser [Char] ParserState Char

645+anyChar' :: PandocMonad m => ParserT [Char] ParserState m Char

640646anyChar' =

641647 satisfy (/='\n') <|> (try $ char '\n' <* notFollowedBy blankline)

642648

643−code1 :: Parser [Char] ParserState Inlines

649+code1 :: PandocMonad m => ParserT [Char] ParserState m Inlines

644650code1 = B.code <$> surrounded (char '@') anyChar'

645651

646−code2 :: Parser [Char] ParserState Inlines

652+code2 :: PandocMonad m => ParserT [Char] ParserState m Inlines

647653code2 = do

648654 htmlTag (tagOpen (=="tt") null)

649655 B.code <$> manyTill anyChar' (try $ htmlTag $ tagClose (=="tt"))

650656

651657-- | Html / CSS attributes

652−attributes :: Parser [Char] ParserState Attr

658+attributes :: PandocMonad m => ParserT [Char] ParserState m Attr

653659attributes = (foldl (flip ($)) ("",[],[])) <$>

654660 try (do special <- option id specialAttribute

655661 attrs <- many attribute

656662 return (special : attrs))

657663

658−specialAttribute :: Parser [Char] ParserState (Attr -> Attr)

664+specialAttribute :: PandocMonad m => ParserT [Char] ParserState m (Attr -> Attr)

659665specialAttribute = do

660666 alignStr <- ("center" <$ char '=') <|>

661667 ("justify" <$ try (string "<>")) <|>

@@ -664,11 +670,11 @@ specialAttribute = do

664670 notFollowedBy spaceChar

665671 return $ addStyle ("text-align:" ++ alignStr)

666672

667−attribute :: Parser [Char] ParserState (Attr -> Attr)

673+attribute :: PandocMonad m => ParserT [Char] ParserState m (Attr -> Attr)

668674attribute = try $

669675 (classIdAttr <|> styleAttr <|> langAttr) <* notFollowedBy spaceChar

670676

671−classIdAttr :: Parser [Char] ParserState (Attr -> Attr)

677+classIdAttr :: PandocMonad m => ParserT [Char] ParserState m (Attr -> Attr)

672678classIdAttr = try $ do -- (class class #id)

673679 char '('

674680 ws <- words `fmap` manyTill anyChar' (char ')')

@@ -679,7 +685,7 @@ classIdAttr = try $ do -- (class class #id)

679685 classes' -> return $ \(_,_,keyvals) ->

680686 ("",classes',keyvals)

681687

682−styleAttr :: Parser [Char] ParserState (Attr -> Attr)

688+styleAttr :: PandocMonad m => ParserT [Char] ParserState m (Attr -> Attr)

683689styleAttr = do

684690 style <- try $ enclosed (char '{') (char '}') anyChar'

685691 return $ addStyle style

@@ -690,21 +696,23 @@ addStyle style (id',classes,keyvals) =

690696 where keyvals' = ("style", style') : [(k,v) | (k,v) <- keyvals, k /= "style"]

691697 style' = style ++ ";" ++ concat [v | ("style",v) <- keyvals]

692698

693−langAttr :: Parser [Char] ParserState (Attr -> Attr)

699+langAttr :: PandocMonad m => ParserT [Char] ParserState m (Attr -> Attr)

694700langAttr = do

695701 lang <- try $ enclosed (char '[') (char ']') alphaNum

696702 return $ \(id',classes,keyvals) -> (id',classes,("lang",lang):keyvals)

697703

698704-- | Parses material surrounded by a parser.

699−surrounded :: Parser [Char] st t -- ^ surrounding parser

700− -> Parser [Char] st a -- ^ content parser (to be used repeatedly)

701− -> Parser [Char] st [a]

705+surrounded :: PandocMonad m

706+ => ParserT [Char] st m t -- ^ surrounding parser

707+ -> ParserT [Char] st m a -- ^ content parser (to be used repeatedly)

708+ -> ParserT [Char] st m [a]

702709surrounded border =

703710 enclosed (border *> notFollowedBy (oneOf " \t\n\r")) (try border)

704711

705−simpleInline :: Parser [Char] ParserState t -- ^ surrounding parser

706− -> (Inlines -> Inlines) -- ^ Inline constructor

707− -> Parser [Char] ParserState Inlines -- ^ content parser (to be used repeatedly)

712+simpleInline :: PandocMonad m

713+ => ParserT [Char] ParserState m t -- ^ surrounding parser

714+ -> (Inlines -> Inlines) -- ^ Inline constructor

715+ -> ParserT [Char] ParserState m Inlines -- ^ content parser (to be used repeatedly)

708716simpleInline border construct = try $ do

709717 notAfterString

710718 border *> notFollowedBy (oneOf " \t\n\r")

@@ -718,7 +726,7 @@ simpleInline border construct = try $ do

718726 then body

719727 else B.spanWith attr body

720728

721−groupedInlineMarkup :: Parser [Char] ParserState Inlines

729+groupedInlineMarkup :: PandocMonad m => ParserT [Char] ParserState m Inlines

722730groupedInlineMarkup = try $ do

723731 char '['

724732 sp1 <- option mempty $ B.space <$ whitespace

src/Text/Pandoc/Readers/Txt2Tags.hs+30−15

@@ -46,13 +46,12 @@ import Data.Maybe (fromMaybe)

4646import Control.Monad (void, guard, when)

4747import Data.Default

4848import Control.Monad.Reader (Reader, runReader, asks)

49−import Text.Pandoc.Error

5049

51−import Data.Time.LocalTime (getZonedTime)

52−import System.Directory(getModificationTime)

5350import Data.Time.Format (formatTime)

5451import Text.Pandoc.Compat.Time (defaultTimeLocale)

55−import System.IO.Error (catchIOError)

52+import Control.Monad.Except (throwError, catchError)

53+import Text.Pandoc.Class (PandocMonad, PandocExecutionError(..))

54+import qualified Text.Pandoc.Class as P

5655

5756type T2T = ParserT String ParserState (Reader T2TMeta)

5857

@@ -69,26 +68,42 @@ instance Default T2TMeta where

6968 def = T2TMeta "" "" "" ""

7069

7170-- | Get the meta information required by Txt2Tags macros

72−getT2TMeta :: [FilePath] -> FilePath -> IO T2TMeta

73−getT2TMeta inps out = do

74− curDate <- formatTime defaultTimeLocale "%F" <$> getZonedTime

71+getT2TMeta :: PandocMonad m => m T2TMeta

72+getT2TMeta = do

73+ mbInps <- P.getInputFiles

74+ let inps = case mbInps of

75+ Just x -> x

76+ Nothing -> []

77+ mbOutp <- P.getOutputFile

78+ let outp = case mbOutp of

79+ Just x -> x

80+ Nothing -> ""

81+ curDate <- formatTime defaultTimeLocale "%F" <$> P.getZonedTime

7582 let getModTime = fmap (formatTime defaultTimeLocale "%T") .

76− getModificationTime

83+ P.getModificationTime

7784 curMtime <- case inps of

78− [] -> formatTime defaultTimeLocale "%T" <$> getZonedTime

79− _ -> catchIOError

85+ [] -> formatTime defaultTimeLocale "%T" <$> P.getZonedTime

86+ _ -> catchError

8087 (maximum <$> mapM getModTime inps)

8188 (const (return ""))

82− return $ T2TMeta curDate curMtime (intercalate ", " inps) out

89+ return $ T2TMeta curDate curMtime (intercalate ", " inps) outp

8390

8491-- | Read Txt2Tags from an input string returning a Pandoc document

85−readTxt2Tags :: T2TMeta -> ReaderOptions -> String -> Either PandocError Pandoc

86−readTxt2Tags t opts s = flip runReader t $ readWithM parseT2T (def {stateOptions = opts}) (s ++ "\n\n")

92+readTxt2Tags :: PandocMonad m

93+ => ReaderOptions

94+ -> String

95+ -> m Pandoc

96+readTxt2Tags opts s = do

97+ meta <- getT2TMeta

98+ let parsed = flip runReader meta $ readWithM parseT2T (def {stateOptions = opts}) (s ++ "\n\n")

99+ case parsed of

100+ Right result -> return $ result

101+ Left _ -> throwError $ PandocParseError "error parsing t2t"

87102

88103-- | Read Txt2Tags (ignoring all macros) from an input string returning

89104-- a Pandoc document

90−readTxt2TagsNoMacros :: ReaderOptions -> String -> Either PandocError Pandoc

91−readTxt2TagsNoMacros = readTxt2Tags def

105+readTxt2TagsNoMacros :: PandocMonad m => ReaderOptions -> String -> m Pandoc

106+readTxt2TagsNoMacros = readTxt2Tags

92107

93108parseT2T :: T2T Pandoc

94109parseT2T = do