API changes to HasReaderOptions, HasHeaderMap, HasIdentifierList.

Previously these were typeclasses of monads.  They've been changed
to be typeclasses of states.  This ismplifies the instance definitions
and provides more flexibility.

This is an API change!  However, it should be backwards compatible
unless you're defining instances of HasReaderOptions, HasHeaderMap,
or HasIdentifierList.  The old getOption function should work as
before (albeit with a more general type).

The function askReaderOption has been removed.
extractReaderOptions has been added.
getOption has been given a default definition.

In HasHeaderMap, extractHeaderMap and updateHeaderMap have been added.
Default definitions have been given for getHeaderMap, putHeaderMap,
and modifyHeaderMap.

In HasIdentifierList, extractIdentifierList and updateIdentifierList
have been added.  Default definitions have been given for
getIdentifierList, putIdentifierList, and modifyIdentifierList.

The ultimate goal here is to allow different parsers to use their
own, tailored parser states (instead of ParserState) while still
using shared functions.

2 files changed, 47 insertions, 39 deletions

diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index 883a560d0..c12e967dc 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -64,7 +64,6 @@ module Text.Pandoc.Parsing ( (>>~),
                              gridTableWith,
                              readWith,
                              testStringWith,
-                             getOption,
                              guardEnabled,
                              guardDisabled,
                              ParserState (..),
@@ -870,33 +869,45 @@ instance HasMeta ParserState where
   deleteMeta field st =
     st{ stateMeta = deleteMeta field $ stateMeta st }
 
-class Monad m => HasReaderOptions m where
-  askReaderOption :: (ReaderOptions -> b) -> m b
-
-class Monad m => HasHeaderMap m where
-  getHeaderMap    :: m (M.Map Inlines String)
-  putHeaderMap    :: M.Map Inlines String -> m ()
-  modifyHeaderMap :: (M.Map Inlines String -> M.Map Inlines String) -> m ()
+class HasReaderOptions st where
+  extractReaderOptions :: st -> ReaderOptions
+  getOption            :: (ReaderOptions -> b) -> Parser s st b
+  -- default
+  getOption  f         = (f . extractReaderOptions) `fmap` getState
+
+instance HasReaderOptions ParserState where
+  extractReaderOptions = stateOptions
+
+class HasHeaderMap st where
+  extractHeaderMap  :: st -> M.Map Inlines String
+  updateHeaderMap   :: M.Map Inlines String -> st -> st
+  getHeaderMap      :: Parser s st (M.Map Inlines String)
+  putHeaderMap      :: M.Map Inlines String -> Parser s st ()
+  modifyHeaderMap   :: (M.Map Inlines String -> M.Map Inlines String)
+                       -> Parser s st ()
   -- default
+  getHeaderMap      = extractHeaderMap `fmap` getState
+  putHeaderMap x    = updateState (updateHeaderMap x)
   modifyHeaderMap f = getHeaderMap >>= putHeaderMap . f
 
-class Monad m => HasIdentifierList m where
-  getIdentifierList    :: m [String]
-  putIdentifierList    :: [String] -> m ()
-  modifyIdentifierList :: ([String] -> [String]) -> m ()
+instance HasHeaderMap ParserState where
+  extractHeaderMap     = stateHeaders
+  updateHeaderMap x st = st{ stateHeaders = x }
+
+class HasIdentifierList st where
+  extractIdentifierList  :: st -> [String]
+  updateIdentifierList   :: [String] -> st -> st
+  getIdentifierList      :: Parser s st ([String])
+  putIdentifierList      :: [String] -> Parser s st ()
+  modifyIdentifierList   :: ([String] -> [String]) -> Parser s st ()
   -- default
+  getIdentifierList      = extractIdentifierList `fmap` getState
+  putIdentifierList x    = updateState (updateIdentifierList x)
   modifyIdentifierList f = getIdentifierList >>= putIdentifierList . f
 
-instance HasReaderOptions (Parser s ParserState) where
-  askReaderOption = getOption
-
-instance HasHeaderMap (Parser s ParserState) where
-  getHeaderMap      = fmap stateHeaders getState
-  putHeaderMap hm   = updateState $ \st -> st{ stateHeaders = hm }
-
-instance HasIdentifierList (Parser s ParserState) where
-  getIdentifierList   = fmap stateIdentifiers  getState
-  putIdentifierList l = updateState $ \st -> st{ stateIdentifiers = l }
+instance HasIdentifierList ParserState where
+  extractIdentifierList     = stateIdentifiers
+  updateIdentifierList x st = st{ stateIdentifiers = x }
 
 defaultParserState :: ParserState
 defaultParserState =
@@ -923,15 +934,12 @@ defaultParserState =
                   stateRstCustomRoles  = M.empty,
                   stateWarnings        = []}
 
-getOption :: (ReaderOptions -> a) -> Parser s ParserState a
-getOption f = (f . stateOptions) `fmap` getState
-
 -- | Succeed only if the extension is enabled.
-guardEnabled :: Extension -> Parser s ParserState ()
+guardEnabled :: HasReaderOptions st => Extension -> Parser s st ()
 guardEnabled ext = getOption readerExtensions >>= guard . Set.member ext
 
 -- | Succeed only if the extension is disabled.
-guardDisabled :: Extension -> Parser s ParserState ()
+guardDisabled :: HasReaderOptions st => Extension -> Parser s st ()
 guardDisabled ext = getOption readerExtensions >>= guard . not . Set.member ext
 
 data HeaderType
@@ -968,11 +976,11 @@ type SubstTable = M.Map Key Inlines
 --  and the auto_identifers extension is set, generate a new
 --  unique identifier, and update the list of identifiers
 --  in state.
-registerHeader :: (HasReaderOptions m, HasHeaderMap m, HasIdentifierList m)
-               => Attr -> Inlines -> m Attr
+registerHeader :: (HasReaderOptions st, HasHeaderMap st, HasIdentifierList st)
+               => Attr -> Inlines -> Parser s st Attr
 registerHeader (ident,classes,kvs) header' = do
   ids <- getIdentifierList
-  exts <- askReaderOption readerExtensions
+  exts <- getOption readerExtensions
   let insert' = M.insertWith (\_new old -> old)
   if null ident && Ext_auto_identifiers `Set.member` exts
      then do
@@ -990,7 +998,7 @@ registerHeader (ident,classes,kvs) header' = do
         return (ident,classes,kvs)
 
 -- | Fail unless we're in "smart typography" mode.
-failUnlessSmart :: Parser [tok] ParserState ()
+failUnlessSmart :: HasReaderOptions st => Parser s st ()
 failUnlessSmart = getOption readerSmart >>= guard
 
 smartPunctuation :: Parser [Char] ParserState Inline
diff --git a/src/Text/Pandoc/Readers/MediaWiki.hs b/src/Text/Pandoc/Readers/MediaWiki.hs
index 7ac2f33ba..7bad4d346 100644
--- a/src/Text/Pandoc/Readers/MediaWiki.hs
+++ b/src/Text/Pandoc/Readers/MediaWiki.hs
@@ -82,16 +82,16 @@ data MWState = MWState { mwOptions         :: ReaderOptions
 
 type MWParser = Parser [Char] MWState
 
-instance HasReaderOptions MWParser where
-  askReaderOption f = (f . mwOptions) `fmap` getState
+instance HasReaderOptions MWState where
+  extractReaderOptions = mwOptions
 
-instance HasHeaderMap MWParser where
-  getHeaderMap      = fmap mwHeaderMap getState
-  putHeaderMap hm   = updateState $ \st -> st{ mwHeaderMap = hm }
+instance HasHeaderMap MWState where
+  extractHeaderMap     = mwHeaderMap
+  updateHeaderMap x st = st{ mwHeaderMap = x }
 
-instance HasIdentifierList MWParser where
-  getIdentifierList   = fmap mwIdentifierList getState
-  putIdentifierList l = updateState $ \st -> st{ mwIdentifierList = l }
+instance HasIdentifierList MWState where
+  extractIdentifierList     = mwIdentifierList
+  updateIdentifierList x st = st{ mwIdentifierList = x }
 
 --
 -- auxiliary functions