From 1a69896d8f2c676aaf8563e1a7b2ba5870597f54 Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Sat, 18 Apr 2015 18:34:55 -0700 Subject: Revert "Merge pull request #1947 from mpickering/Fmonad" Closes #2062. This reverts commit c302bdcdbe97b38721015fe82403b2a8f488a702, reversing changes made to b983adf0d0cbc98d2da1e2751f46ae1f93352be6. Conflicts: src/Text/Pandoc/Parsing.hs src/Text/Pandoc/Readers/Markdown.hs src/Text/Pandoc/Readers/Org.hs src/Text/Pandoc/Readers/RST.hs --- src/Text/Pandoc/Parsing.hs | 55 +++++++++++++++++++++++++++------------------- 1 file changed, 33 insertions(+), 22 deletions(-) (limited to 'src/Text/Pandoc/Parsing.hs') diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs index 33120e55d..5c27d3e6d 100644 --- a/src/Text/Pandoc/Parsing.hs +++ b/src/Text/Pandoc/Parsing.hs @@ -65,8 +65,7 @@ module Text.Pandoc.Parsing ( anyLine, widthsFromIndices, gridTableWith, readWith, - returnWarnings, - returnState, + readWithWarnings, readWithM, testStringWith, guardEnabled, @@ -105,8 +104,11 @@ module Text.Pandoc.Parsing ( anyLine, applyMacros', Parser, ParserT, + F(..), + runF, + askF, + asksF, token, - generalize, -- * Re-exports from Text.Pandoc.Parsec Stream, runParser, @@ -187,7 +189,7 @@ import Data.Default import qualified Data.Set as Set import Control.Monad.Reader import Control.Monad.Identity -import Control.Applicative ((<$>), (<*>), (*>), (<*), (<$)) +import Control.Applicative ((<$>), (<*>), (*>), (<*), (<$), Applicative) import Data.Monoid import Data.Maybe (catMaybes) @@ -197,6 +199,22 @@ type Parser t s = Parsec t s type ParserT = ParsecT +newtype F a = F { unF :: Reader ParserState a } deriving (Monad, Applicative, Functor) + +runF :: F a -> ParserState -> a +runF = runReader . unF + +askF :: F ParserState +askF = F ask + +asksF :: (ParserState -> a) -> F a +asksF f = F $ asks f + +instance Monoid a => Monoid (F a) where + mempty = return mempty + mappend = liftM2 mappend + mconcat = liftM mconcat . sequence + -- | Parse any line of text anyLine :: Stream [Char] m Char => ParserT [Char] st m [Char] anyLine = do @@ -860,18 +878,15 @@ readWith :: Parser [Char] st a -> Either PandocError a readWith p t inp = runIdentity $ readWithM p t inp -returnWarnings :: (Stream s m c) - => ParserT s ParserState m a - -> ParserT s ParserState m (a, [String]) -returnWarnings p = do +readWithWarnings :: Parser [Char] ParserState a + -> ParserState + -> String + -> Either PandocError (a, [String]) +readWithWarnings p = readWith $ do doc <- p warnings <- stateWarnings <$> getState return (doc, warnings) --- | Return the final internal state with the result of a parser -returnState :: (Stream s m c) => ParsecT s st m a -> ParsecT s st m (a, st) -returnState p = (,) <$> p <*> getState - -- | Parse a string with @parser@ (for testing). testStringWith :: (Show a, Stream [Char] Identity Char) => ParserT [Char] ParserState Identity a @@ -893,6 +908,7 @@ data ParserState = ParserState stateNotes :: NoteTable, -- ^ List of notes (raw bodies) stateNotes' :: NoteTable', -- ^ List of notes (parsed bodies) stateMeta :: Meta, -- ^ Document metadata + stateMeta' :: F Meta, -- ^ Document metadata stateHeaderTable :: [HeaderType], -- ^ Ordered list of header types used stateHeaders :: M.Map Inlines String, -- ^ List of headers and ids (used for implicit ref links) stateIdentifiers :: [String], -- ^ List of header identifiers used @@ -907,8 +923,7 @@ data ParserState = ParserState stateCaption :: Maybe Inlines, -- ^ Caption in current environment stateInHtmlBlock :: Maybe String, -- ^ Tag type of HTML block being parsed stateMarkdownAttribute :: Bool, -- ^ True if in markdown=1 context - stateWarnings :: [String], -- ^ Warnings generated by the parser - stateInFootnote :: Bool -- ^ True if in a footnote block. + stateWarnings :: [String] -- ^ Warnings generated by the parser } instance Default ParserState where @@ -990,6 +1005,7 @@ defaultParserState = stateNotes = [], stateNotes' = [], stateMeta = nullMeta, + stateMeta' = return nullMeta, stateHeaderTable = [], stateHeaders = M.empty, stateIdentifiers = [], @@ -1002,8 +1018,7 @@ defaultParserState = stateCaption = Nothing, stateInHtmlBlock = Nothing, stateMarkdownAttribute = False, - stateWarnings = [], - stateInFootnote = False } + stateWarnings = []} -- | Succeed only if the extension is enabled. guardEnabled :: (Stream s m a, HasReaderOptions st) => Extension -> ParserT s st m () @@ -1042,7 +1057,7 @@ data QuoteContext type NoteTable = [(String, String)] -type NoteTable' = [(String, Blocks)] -- used in markdown reader +type NoteTable' = [(String, F Blocks)] -- used in markdown reader newtype Key = Key String deriving (Show, Read, Eq, Ord) @@ -1238,15 +1253,11 @@ applyMacros' target = do else return target -- | Append a warning to the log. -addWarning :: (Stream s m c) => Maybe SourcePos -> String -> ParserT s ParserState m () +addWarning :: Maybe SourcePos -> String -> Parser [Char] ParserState () addWarning mbpos msg = updateState $ \st -> st{ stateWarnings = (msg ++ maybe "" (\pos -> " " ++ show pos) mbpos) : stateWarnings st } - -generalize :: (Monad m) => Parser s st a -> ParserT s st m a -generalize m = mkPT (\ s -> (return $ (return . runIdentity) <$> runIdentity (runParsecT m s))) - infixr 5 <+?> (<+?>) :: (Monoid a, Monad m) => ParserT s st m a -> ParserT s st m a -> ParserT s st m a a <+?> b = a >>= flip fmap (try b <|> return mempty) . (<>) -- cgit v1.2.3