d566027 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Parsing: Generalized type of registerHeader, using new typeclasses.

d566027John MacFarlane13 years ago

src/Text/Pandoc/Parsing.hs+42−12

compare with master

unifiedsplit

@@ -1,4 +1,5 @@

1−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

1+{-# LANGUAGE GeneralizedNewtypeDeriving, TypeSynonymInstances,

2+ FlexibleInstances#-}

2{-

3{-

@@ -65,6 +66,9 @@ module Text.Pandoc.Parsing ( (>>~),

65 guardEnabled,

66 guardEnabled,

66 guardDisabled,

67 guardDisabled,

67 ParserState (..),

68 ParserState (..),

69+ HasReaderOptions (..),

70+ HasHeaderMap (..),

71+ HasIdentifierList (..),

68 defaultParserState,

72 defaultParserState,

69 HeaderType (..),

73 HeaderType (..),

70 ParserContext (..),

74 ParserContext (..),

@@ -826,6 +830,34 @@ instance HasMeta ParserState where

826 deleteMeta field st =

830 deleteMeta field st =

827 st{ stateMeta = deleteMeta field $ stateMeta st }

831 st{ stateMeta = deleteMeta field $ stateMeta st }

828

832

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+

829defaultParserState :: ParserState

861defaultParserState :: ParserState

830defaultParserState =

862defaultParserState =

831 ParserState { stateOptions = def,

863 ParserState { stateOptions = def,

@@ -895,10 +927,11 @@ type SubstTable = M.Map Key Inlines

895-- and the auto_identifers extension is set, generate a new

927-- and the auto_identifers extension is set, generate a new

896-- unique identifier, and update the list of identifiers

928-- unique identifier, and update the list of identifiers

897-- in state.

929-- in state.

930+registerHeader :: (HasReaderOptions m, HasHeaderMap m, HasIdentifierList m)

898−registerHeader :: Attr -> Inlines -> Parser s ParserState Attr

931+ => Attr -> Inlines -> m Attr

899registerHeader (ident,classes,kvs) header' = do

932registerHeader (ident,classes,kvs) header' = do

900− ids <- stateIdentifiers `fmap` getState

933+ ids <- getIdentifierList

901− exts <- getOption readerExtensions

934+ exts <- askReaderOption readerExtensions

902 let insert' = M.insertWith (\_new old -> old)

935 let insert' = M.insertWith (\_new old -> old)

903 if null ident && Ext_auto_identifiers `Set.member` exts

936 if null ident && Ext_auto_identifiers `Set.member` exts

904 then do

937 then do

@@ -906,16 +939,13 @@ registerHeader (ident,classes,kvs) header' = do

906 let id'' = if Ext_ascii_identifiers `Set.member` exts

939 let id'' = if Ext_ascii_identifiers `Set.member` exts

907 then catMaybes $ map toAsciiChar id'

940 then catMaybes $ map toAsciiChar id'

908 else id'

941 else id'

909− updateState $ \st -> st{

942+ putIdentifierList $ if id' == id''

910− stateIdentifiers = if id' == id''

911− then id' : ids

943+ then id' : ids

912− else id' : id'' : ids,

944+ else id' : id'' : ids

913− stateHeaders = insert' header' id' $ stateHeaders st }

945+ modifyHeaderMap $ insert' header' id'

914 return (id'',classes,kvs)

946 return (id'',classes,kvs)

915 else do

947 else do

916− unless (null ident) $

948+ unless (null ident) $ modifyHeaderMap $ insert' header' ident

917− updateState $ \st -> st{

918− stateHeaders = insert' header' ident $ stateHeaders st }

919 return (ident,classes,kvs)

949 return (ident,classes,kvs)

920

950

921-- | Fail unless we're in "smart typography" mode.

951-- | Fail unless we're in "smart typography" mode.