6ed41fd · typeable/pandoc

git.iko.soy/typeable/pandoc

Factored out registerHeader from markdown reader, added to Parsing.

Text.Pandoc.Parsing now exports registerHeader, which can be used in other readers.

commit6ed41fdfcc3b57e88cf98b875a75ab5e1629dca6 authorJohn MacFarlane <fiddlosopher@gmail.com> dateSun 1 Sep 2013, 08:54 (13 years ago) parentc27c0ce

2 files changed+34−28

compare with master

unifiedsplit

src/Text/Pandoc/Parsing.hs+32 src/Text/Pandoc/Readers/Markdown.hs+2−28

src/Text/Pandoc/Parsing.hs+32

@@ -75,6 +75,7 @@ module Text.Pandoc.Parsing ( (>>~),

7575 SubstTable,

7676 Key (..),

7777 toKey,

78+ registerHeader,

7879 smartPunctuation,

7980 withQuoteContext,

8081 singleQuoteStart,

@@ -151,6 +152,7 @@ where

151152import Text.Pandoc.Definition

152153import Text.Pandoc.Options

153154import Text.Pandoc.Builder (Blocks, Inlines, rawBlock, HasMeta(..))

155+import qualified Text.Pandoc.Builder as B

154156import Text.Pandoc.XML (fromEntities)

155157import qualified Text.Pandoc.UTF8 as UTF8 (putStrLn)

156158import Text.Parsec

@@ -162,11 +164,13 @@ import Text.Pandoc.Shared

162164import qualified Data.Map as M

163165import Text.TeXMath.Macros (applyMacros, Macro, parseMacroDefinitions)

164166import Text.Pandoc.Compat.TagSoupEntity ( lookupEntity )

167+import Text.Pandoc.Asciify (toAsciiChar)

165168import Data.Default

166169import qualified Data.Set as Set

167170import Control.Monad.Reader

168171import Control.Applicative ((*>), (<*), (<$), liftA2)

169172import Data.Monoid

173+import Data.Maybe (catMaybes)

170174

171175type Parser t s = Parsec t s

172176

@@ -886,6 +890,34 @@ type KeyTable = M.Map Key Target

886890

887891type SubstTable = M.Map Key Inlines

888892

893+-- | Add header to the list of headers in state, together

894+-- with its associated identifier. If the identifier is null

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

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

897+-- in state.

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

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

900+ ids <- stateIdentifiers `fmap` getState

901+ exts <- getOption readerExtensions

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

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

904+ then do

905+ let id' = uniqueIdent (B.toList header') ids

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

907+ then catMaybes $ map toAsciiChar id'

908+ 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 }

914+ return (id'',classes,kvs)

915+ else do

916+ unless (null ident) $

917+ updateState $ \st -> st{

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

919+ return (ident,classes,kvs)

920+

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

890922failUnlessSmart :: Parser [tok] ParserState ()

891923failUnlessSmart = getOption readerSmart >>= guard

src/Text/Pandoc/Readers/Markdown.hs+2−28

@@ -49,7 +49,6 @@ import Text.Pandoc.Builder (Inlines, Blocks, trimInlines, (<>))

4949import Text.Pandoc.Options

5050import Text.Pandoc.Shared

5151import Text.Pandoc.XML (fromEntities)

52−import Text.Pandoc.Asciify (toAsciiChar)

5352import Text.Pandoc.Parsing hiding (tableWith)

5453import Text.Pandoc.Readers.LaTeX ( rawLaTeXInline, rawLaTeXBlock )

5554import Text.Pandoc.Readers.HTML ( htmlTag, htmlInBalanced, isInlineTag, isBlockTag,

@@ -471,31 +470,6 @@ block = choice [ mempty <$ blanklines

471470header :: MarkdownParser (F Blocks)

472471header = setextHeader <|> atxHeader <?> "header"

473472

474−-- returns unique identifier

475−addToHeaderList :: Attr -> F Inlines -> MarkdownParser Attr

476−addToHeaderList (ident,classes,kvs) text = do

477− let header' = runF text defaultParserState

478− exts <- getOption readerExtensions

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

480− if null ident && Ext_auto_identifiers `Set.member` exts

481− then do

482− ids <- stateIdentifiers `fmap` getState

483− let id' = uniqueIdent (B.toList header') ids

484− let id'' = if Ext_ascii_identifiers `Set.member` exts

485− then catMaybes $ map toAsciiChar id'

486− else id'

487− updateState $ \st -> st{

488− stateIdentifiers = if id' == id''

489− then id' : ids

490− else id' : id'' : ids,

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

492− return (id'',classes,kvs)

493− else do

494− unless (null ident) $

495− updateState $ \st -> st{

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

497− return (ident,classes,kvs)

498−

499473atxHeader :: MarkdownParser (F Blocks)

500474atxHeader = try $ do

501475 level <- many1 (char '#') >>= return . length

@@ -504,7 +478,7 @@ atxHeader = try $ do

504478 skipSpaces

505479 text <- trimInlinesF . mconcat <$> many (notFollowedBy atxClosing >> inline)

506480 attr <- atxClosing

507− attr' <- addToHeaderList attr text

481+ attr' <- registerHeader attr (runF text defaultParserState)

508482 return $ B.headerWith attr' level <$> text

509483

510484atxClosing :: MarkdownParser Attr

@@ -543,7 +517,7 @@ setextHeader = try $ do

543517 many (char underlineChar)

544518 blanklines

545519 let level = (fromMaybe 0 $ findIndex (== underlineChar) setextHChars) + 1

546− attr' <- addToHeaderList attr text

520+ attr' <- registerHeader attr (runF text defaultParserState)

547521 return $ B.headerWith attr' level <$> text

548522

549523--