6ed41fd · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Factored out registerHeader from markdown reader, added to Parsing.

6ed41fdJohn MacFarlane13 years ago

src/Text/Pandoc/Parsing.hs+32

compare with master

unifiedsplit

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

75 SubstTable,

76 Key (..),

77 toKey,

78+ registerHeader,

78 smartPunctuation,

79 smartPunctuation,

79 withQuoteContext,

80 withQuoteContext,

80 singleQuoteStart,

81 singleQuoteStart,

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

151import Text.Pandoc.Definition

152import Text.Pandoc.Definition

152import Text.Pandoc.Options

153import Text.Pandoc.Options

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

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

155+import qualified Text.Pandoc.Builder as B

154import Text.Pandoc.XML (fromEntities)

156import Text.Pandoc.XML (fromEntities)

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

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

156import Text.Parsec

158import Text.Parsec

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

162import qualified Data.Map as M

164import qualified Data.Map as M

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

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

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

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

167+import Text.Pandoc.Asciify (toAsciiChar)

165import Data.Default

168import Data.Default

166import qualified Data.Set as Set

169import qualified Data.Set as Set

167import Control.Monad.Reader

170import Control.Monad.Reader

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

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

169import Data.Monoid

172import Data.Monoid

173+import Data.Maybe (catMaybes)

170

174

171type Parser t s = Parsec t s

175type Parser t s = Parsec t s

172

176

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

886

890

887type SubstTable = M.Map Key Inlines

891type SubstTable = M.Map Key Inlines

888

892

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+

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

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

890failUnlessSmart :: Parser [tok] ParserState ()

922failUnlessSmart :: Parser [tok] ParserState ()

891failUnlessSmart = getOption readerSmart >>= guard

923failUnlessSmart = getOption readerSmart >>= guard

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

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

49import Text.Pandoc.Options

50import Text.Pandoc.Shared

51import Text.Pandoc.XML (fromEntities)

52−import Text.Pandoc.Asciify (toAsciiChar)

53import Text.Pandoc.Parsing hiding (tableWith)

52import Text.Pandoc.Parsing hiding (tableWith)

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

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

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

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

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

471header :: MarkdownParser (F Blocks)

470header :: MarkdownParser (F Blocks)

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

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

473

472

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−

499atxHeader :: MarkdownParser (F Blocks)

473atxHeader :: MarkdownParser (F Blocks)

500atxHeader = try $ do

474atxHeader = try $ do

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

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

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

504 skipSpaces

478 skipSpaces

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

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

506 attr <- atxClosing

480 attr <- atxClosing

507− attr' <- addToHeaderList attr text

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

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

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

509

483

510atxClosing :: MarkdownParser Attr

484atxClosing :: MarkdownParser Attr

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

543 many (char underlineChar)

517 many (char underlineChar)

544 blanklines

518 blanklines

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

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

546− attr' <- addToHeaderList attr text

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

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

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

548

522

549--

523--