Change return type of HTML reader

This commit is contained in:
Matthew Pickering 2015-02-18 13:03:12 +00:00
parent b935ef6de5
commit b9e04825cf

View file

@ -1,4 +1,5 @@
{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses,
ViewPatterns#-}
{- {-
Copyright (C) 2006-2014 John MacFarlane <jgm@berkeley.edu> Copyright (C) 2006-2014 John MacFarlane <jgm@berkeley.edu>
@ -62,15 +63,18 @@ import Text.TeXMath (readMathML, writeTeX)
import Data.Default (Default (..), def) import Data.Default (Default (..), def)
import Control.Monad.Reader (Reader,ask, asks, local, runReader) import Control.Monad.Reader (Reader,ask, asks, local, runReader)
import Text.Pandoc.Error
import Text.Parsec.Error
-- | Convert HTML-formatted string to 'Pandoc' document. -- | Convert HTML-formatted string to 'Pandoc' document.
readHtml :: ReaderOptions -- ^ Reader options readHtml :: ReaderOptions -- ^ Reader options
-> String -- ^ String to parse (assumes @'\n'@ line endings) -> String -- ^ String to parse (assumes @'\n'@ line endings)
-> Pandoc -> Either PandocError Pandoc
readHtml opts inp = readHtml opts inp =
case flip runReader def $ runParserT parseDoc (HTMLState def{ stateOptions = opts } []) "source" tags of mapLeft (ParseFailure . getError) . flip runReader def $
Left err' -> error $ "\nError at " ++ show err' runParserT parseDoc (HTMLState def{ stateOptions = opts } []) "source" tags
Right result -> result
where tags = stripPrefixes . canonicalizeTags $ where tags = stripPrefixes . canonicalizeTags $
parseTagsOptions parseOptions{ optTagPosition = True } inp parseTagsOptions parseOptions{ optTagPosition = True } inp
parseDoc = do parseDoc = do
@ -78,6 +82,9 @@ readHtml opts inp =
meta <- stateMeta . parserState <$> getState meta <- stateMeta . parserState <$> getState
bs' <- replaceNotes (B.toList blocks) bs' <- replaceNotes (B.toList blocks)
return $ Pandoc meta bs' return $ Pandoc meta bs'
getError (errorMessages -> ms) = case ms of
[] -> ""
(m:_) -> messageString m
replaceNotes :: [Block] -> TagParser [Block] replaceNotes :: [Block] -> TagParser [Block]
replaceNotes = walkM replaceNotes' replaceNotes = walkM replaceNotes'