@@ -1,4 +1,5 @@
1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
1+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances,
2+ FlexibleInstances#-}
23{-
34Copyright (C) 2006-2010 John MacFarlane <jgm@berkeley.edu>
45
@@ -65,6 +66,9 @@ module Text.Pandoc.Parsing ( (>>~),
6566 guardEnabled,
6667 guardDisabled,
6768 ParserState (..),
69+ HasReaderOptions (..),
70+ HasHeaderMap (..),
71+ HasIdentifierList (..),
6872 defaultParserState,
6973 HeaderType (..),
7074 ParserContext (..),
@@ -826,6 +830,34 @@ instance HasMeta ParserState where
826830 deleteMeta field st =
827831 st{ stateMeta = deleteMeta field $ stateMeta st }
828832
833+class Monad m => HasReaderOptions m where
834+ askReaderOption :: (ReaderOptions -> b) -> m b
835+
836+class Monad m => HasHeaderMap m where
837+ getHeaderMap :: m (M.Map Inlines String)
838+ putHeaderMap :: M.Map Inlines String -> m ()
839+ modifyHeaderMap :: (M.Map Inlines String -> M.Map Inlines String) -> m ()
840+ -- default
841+ modifyHeaderMap f = getHeaderMap >>= putHeaderMap . f
842+
843+class Monad m => HasIdentifierList m where
844+ getIdentifierList :: m [String]
845+ putIdentifierList :: [String] -> m ()
846+ modifyIdentifierList :: ([String] -> [String]) -> m ()
847+ -- default
848+ modifyIdentifierList f = getIdentifierList >>= putIdentifierList . f
849+
850+instance HasReaderOptions (Parser s ParserState) where
851+ askReaderOption = getOption
852+
853+instance HasHeaderMap (Parser s ParserState) where
854+ getHeaderMap = fmap stateHeaders getState
855+ putHeaderMap hm = updateState $ \st -> st{ stateHeaders = hm }
856+
857+instance HasIdentifierList (Parser s ParserState) where
858+ getIdentifierList = fmap stateIdentifiers getState
859+ putIdentifierList l = updateState $ \st -> st{ stateIdentifiers = l }
860+
829861defaultParserState :: ParserState
830862defaultParserState =
831863 ParserState { stateOptions = def,
@@ -895,10 +927,11 @@ type SubstTable = M.Map Key Inlines
895927-- and the auto_identifers extension is set, generate a new
896928-- unique identifier, and update the list of identifiers
897929-- in state.
898−registerHeader :: Attr -> Inlines -> Parser s ParserState Attr
930+registerHeader :: (HasReaderOptions m, HasHeaderMap m, HasIdentifierList m)
931+ => Attr -> Inlines -> m Attr
899932registerHeader (ident,classes,kvs) header' = do
900− ids <- stateIdentifiers `fmap` getState
901− exts <- getOption readerExtensions
933+ ids <- getIdentifierList
934+ exts <- askReaderOption readerExtensions
902935 let insert' = M.insertWith (\_new old -> old)
903936 if null ident && Ext_auto_identifiers `Set.member` exts
904937 then do
@@ -906,16 +939,13 @@ registerHeader (ident,classes,kvs) header' = do
906939 let id'' = if Ext_ascii_identifiers `Set.member` exts
907940 then catMaybes $ map toAsciiChar id'
908941 else id'
909− updateState $ \st -> st{
910− stateIdentifiers = if id' == id''
911− then id' : ids
912− else id' : id'' : ids,
913− stateHeaders = insert' header' id' $ stateHeaders st }
942+ putIdentifierList $ if id' == id''
943+ then id' : ids
944+ else id' : id'' : ids
945+ modifyHeaderMap $ insert' header' id'
914946 return (id'',classes,kvs)
915947 else do
916− unless (null ident) $
917− updateState $ \st -> st{
918− stateHeaders = insert' header' ident $ stateHeaders st }
948+ unless (null ident) $ modifyHeaderMap $ insert' header' ident
919949 return (ident,classes,kvs)
920950
921951-- | Fail unless we're in "smart typography" mode.