From 08d1404b31a0fd6edd94b1e5674d3b07d8e4de6a Mon Sep 17 00:00:00 2001 From: John MacFarlane Date: Tue, 25 Mar 2014 13:43:34 -0700 Subject: 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. --- src/Text/Pandoc/Parsing.hs | 70 ++++++++++++++++++++---------------- src/Text/Pandoc/Readers/MediaWiki.hs | 16 ++++----- 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 -- cgit v1.2.3