Merge pull request #1947 from mpickering/Fmonad

Remove F Monad from Markdown and Org readers.

1 files changed, 21 insertions, 33 deletions

diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index 28ea2bd2f..aebdcae4c 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -65,7 +65,8 @@ module Text.Pandoc.Parsing ( anyLine,
                              widthsFromIndices,
                              gridTableWith,
                              readWith,
-                             readWithWarnings,
+                             returnWarnings,
+                             returnState,
                              readWithM,
                              testStringWith,
                              guardEnabled,
@@ -104,11 +105,8 @@ module Text.Pandoc.Parsing ( anyLine,
                              applyMacros',
                              Parser,
                              ParserT,
-                             F(..),
-                             runF,
-                             askF,
-                             asksF,
                              token,
+                             generalize,
                              -- * Re-exports from Text.Pandoc.Parsec
                              Stream,
                              runParser,
@@ -188,7 +186,7 @@ import Data.Default
 import qualified Data.Set as Set
 import Control.Monad.Reader
 import Control.Monad.Identity
-import Control.Applicative ((<$>), (<*>), (*>), (<*), (<$), Applicative)
+import Control.Applicative ((<$>), (<*>), (*>), (<*), (<$))
 import Data.Monoid
 import Data.Maybe (catMaybes)
 
@@ -196,22 +194,6 @@ 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
@@ -884,15 +866,18 @@ readWith :: Parser [Char] st a
          -> a
 readWith p t inp = runIdentity $ readWithM p t inp
 
-readWithWarnings :: Parser [Char] ParserState a
-                    -> ParserState
-                    -> String
-                    -> (a, [String])
-readWithWarnings p = readWith $ do
+returnWarnings :: (Stream s m c)
+                    => ParserT s ParserState m a
+                    -> ParserT s ParserState m (a, [String])
+returnWarnings p = 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
@@ -914,7 +899,6 @@ 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
@@ -929,7 +913,8 @@ 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
+      stateWarnings        :: [String],      -- ^ Warnings generated by the parser
+      stateInFootnote      :: Bool           -- ^ True if in a footnote block.
     }
 
 instance Default ParserState where
@@ -1011,7 +996,6 @@ defaultParserState =
                   stateNotes           = [],
                   stateNotes'          = [],
                   stateMeta            = nullMeta,
-                  stateMeta'           = return nullMeta,
                   stateHeaderTable     = [],
                   stateHeaders         = M.empty,
                   stateIdentifiers     = [],
@@ -1024,7 +1008,8 @@ defaultParserState =
                   stateCaption         = Nothing,
                   stateInHtmlBlock     = Nothing,
                   stateMarkdownAttribute = False,
-                  stateWarnings        = []}
+                  stateWarnings        = [],
+                  stateInFootnote      = False }
 
 -- | Succeed only if the extension is enabled.
 guardEnabled :: (Stream s m a,  HasReaderOptions st) => Extension -> ParserT s st m ()
@@ -1063,7 +1048,7 @@ data QuoteContext
 
 type NoteTable = [(String, String)]
 
-type NoteTable' = [(String, F Blocks)]  -- used in markdown reader
+type NoteTable' = [(String, Blocks)]  -- used in markdown reader
 
 newtype Key = Key String deriving (Show, Read, Eq, Ord)
 
@@ -1259,8 +1244,11 @@ applyMacros' target = do
      else return target
 
 -- | Append a warning to the log.
-addWarning :: Maybe SourcePos -> String -> Parser [Char] ParserState ()
+addWarning :: (Stream s m c) => Maybe SourcePos -> String -> ParserT s ParserState m ()
 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)))