Provide shared F monad functions for Markdown and Org readers

The `F` monads used for delayed evaluation of certain values in the
Markdown and Org readers are based on a shared data type capturing the
common pattern of both `F` types.

4 files changed, 36 insertions, 52 deletions

diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index e985f3d32..a6d3cd46a 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -108,10 +108,13 @@ module Text.Pandoc.Parsing ( anyLine,
                              applyMacros',
                              Parser,
                              ParserT,
-                             F(..),
+                             F,
+                             Future(..),
                              runF,
                              askF,
                              asksF,
+                             returnF,
+                             trimInlinesF,
                              token,
                              (<+?>),
                              extractIdClass,
@@ -175,7 +178,7 @@ where
 
 import Text.Pandoc.Definition
 import Text.Pandoc.Options
-import Text.Pandoc.Builder (Blocks, Inlines, rawBlock, HasMeta(..))
+import Text.Pandoc.Builder (Blocks, Inlines, rawBlock, HasMeta(..), trimInlines)
 import qualified Text.Pandoc.Builder as B
 import Text.Pandoc.XML (fromEntities)
 import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn)
@@ -205,18 +208,30 @@ type Parser t s = Parsec t s
 
 type ParserT = ParsecT
 
-newtype F a = F { unF :: Reader ParserState a } deriving (Monad, Applicative, Functor)
+-- | Reader monad wrapping the parser state. This is used to possibly delay
+-- evaluation until all relevant information has been parsed and made available
+-- in the parser state.
+newtype Future s a = Future { runDelayed :: Reader s a }
+  deriving (Monad, Applicative, Functor)
 
-runF :: F a -> ParserState -> a
-runF = runReader . unF
+type F = Future ParserState
 
-askF :: F ParserState
-askF = F ask
+runF :: Future s a -> s -> a
+runF = runReader . runDelayed
 
-asksF :: (ParserState -> a) -> F a
-asksF f = F $ asks f
+askF :: Future s s
+askF = Future ask
 
-instance Monoid a => Monoid (F a) where
+asksF :: (s -> a) -> Future s a
+asksF f = Future $ asks f
+
+returnF :: Monad m => a -> m (Future s a)
+returnF = return . return
+
+trimInlinesF :: Future s Inlines -> Future s Inlines
+trimInlinesF = liftM trimInlines
+
+instance Monoid a => Monoid (Future s a) where
   mempty = return mempty
   mappend = liftM2 mappend
   mconcat = liftM mconcat . sequence
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index 9eb242d74..5515c735b 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -50,7 +50,7 @@ import Data.Yaml (ParseException (..), YamlException (..), YamlMark (..))
 import qualified Data.Yaml as Yaml
 import System.FilePath (addExtension, takeExtension)
 import Text.HTML.TagSoup
-import Text.Pandoc.Builder (Blocks, Inlines, trimInlines)
+import Text.Pandoc.Builder (Blocks, Inlines)
 import qualified Text.Pandoc.Builder as B
 import Text.Pandoc.Class (PandocMonad, report)
 import Text.Pandoc.Definition
@@ -80,9 +80,6 @@ readMarkdown opts s = do
     Right result -> return result
     Left e       -> throwError e
 
-trimInlinesF :: F Inlines -> F Inlines
-trimInlinesF = liftM trimInlines
-
 --
 -- Constants and data structure definitions
 --
diff --git a/src/Text/Pandoc/Readers/Org/ParserState.hs b/src/Text/Pandoc/Readers/Org/ParserState.hs
index 6bed2a547..bdd1dc951 100644
--- a/src/Text/Pandoc/Readers/Org/ParserState.hs
+++ b/src/Text/Pandoc/Readers/Org/ParserState.hs
@@ -39,7 +39,7 @@ module Text.Pandoc.Readers.Org.ParserState
   , TodoState (..)
   , activeTodoMarkers
   , registerTodoSequence
-  , F(..)
+  , F
   , askF
   , asksF
   , trimInlinesF
@@ -50,14 +50,13 @@ module Text.Pandoc.Readers.Org.ParserState
   , optionsToParserState
   ) where
 
-import Control.Monad (liftM, liftM2)
-import Control.Monad.Reader (Reader, ReaderT, ask, asks, local, runReader)
+import Control.Monad.Reader (ReaderT, asks, local)
 
 import Data.Default (Default (..))
 import qualified Data.Map as M
 import qualified Data.Set as Set
 
-import Text.Pandoc.Builder (Blocks, Inlines, trimInlines)
+import Text.Pandoc.Builder (Blocks, Inlines)
 import Text.Pandoc.Definition (Meta (..), nullMeta)
 import Text.Pandoc.Options (ReaderOptions (..))
 import Text.Pandoc.Logging
@@ -65,7 +64,12 @@ import Text.Pandoc.Parsing (HasHeaderMap (..), HasIdentifierList (..),
                             HasLogMessages (..),
                             HasLastStrPosition (..), HasQuoteContext (..),
                             HasReaderOptions (..), ParserContext (..),
-                            QuoteContext (..), SourcePos)
+                            QuoteContext (..), SourcePos, Future,
+                            askF, asksF, returnF, runF, trimInlinesF)
+
+-- | This is used to delay evaluation until all relevant information has been
+-- parsed and made available in the parser state.
+type F = Future OrgParserState
 
 -- | An inline note / footnote containing the note key and its (inline) value.
 type OrgNoteRecord = (String, F Blocks)
@@ -229,35 +233,3 @@ defaultExportSettings = ExportSettings
   , exportWithEmail = True
   , exportWithTodoKeywords = True
   }
-
-
---
--- Parser state reader
---
-
--- | Reader monad wrapping the parser state.  This is used to delay evaluation
--- until all relevant information has been parsed and made available in the
--- parser state.  See also the newtype of the same name in
--- Text.Pandoc.Parsing.
-newtype F a = F { unF :: Reader OrgParserState a
-                } deriving (Functor, Applicative, Monad)
-
-instance Monoid a => Monoid (F a) where
-  mempty = return mempty
-  mappend = liftM2 mappend
-  mconcat = fmap mconcat . sequence
-
-runF :: F a -> OrgParserState -> a
-runF = runReader . unF
-
-askF :: F OrgParserState
-askF = F ask
-
-asksF :: (OrgParserState -> a) -> F a
-asksF f = F $ asks f
-
-trimInlinesF :: F Inlines -> F Inlines
-trimInlinesF = liftM trimInlines
-
-returnF :: Monad m => a -> m (F a)
-returnF = return . return
diff --git a/src/Text/Pandoc/Readers/Org/Parsing.hs b/src/Text/Pandoc/Readers/Org/Parsing.hs
index 03c9b1981..464ef9ca6 100644
--- a/src/Text/Pandoc/Readers/Org/Parsing.hs
+++ b/src/Text/Pandoc/Readers/Org/Parsing.hs
@@ -110,7 +110,7 @@ module Text.Pandoc.Readers.Org.Parsing
 
 import Text.Pandoc.Readers.Org.ParserState
 
-import Text.Pandoc.Parsing hiding (anyLine, blanklines, newline,
+import Text.Pandoc.Parsing hiding (F, anyLine, blanklines, newline,
                             parseFromString)
 import qualified Text.Pandoc.Parsing as P