b5bda75 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

Made KeyTable a map instead of an association list.

b5bda75John MacFarlane16 years ago

src/Text/Pandoc/Definition.hs+9−9

compare with master

unifiedsplit

@@ -33,19 +33,19 @@ module Text.Pandoc.Definition where

34import Data.Generics

36−data Pandoc = Pandoc Meta [Block] deriving (Eq, Read, Show, Typeable, Data)

36+data Pandoc = Pandoc Meta [Block] deriving (Eq, Ord, Read, Show, Typeable, Data)

38-- | Bibliographic information for the document: title, authors, date.

39data Meta = Meta { docTitle :: [Inline]

40 , docAuthors :: [[Inline]]

41 , docDate :: [Inline] }

42− deriving (Eq, Show, Read, Typeable, Data)

42+ deriving (Eq, Ord, Show, Read, Typeable, Data)

44-- | Alignment of a table column.

45data Alignment = AlignLeft

46 | AlignRight

47 | AlignCenter

48− | AlignDefault deriving (Eq, Show, Read, Typeable, Data)

48+ | AlignDefault deriving (Eq, Ord, Show, Read, Typeable, Data)

50-- | List attributes.

51type ListAttributes = (Int, ListNumberStyle, ListNumberDelim)

@@ -56,13 +56,13 @@ data ListNumberStyle = DefaultStyle

56 | LowerRoman

57 | UpperRoman

58 | LowerAlpha

59− | UpperAlpha deriving (Eq, Show, Read, Typeable, Data)

59+ | UpperAlpha deriving (Eq, Ord, Show, Read, Typeable, Data)

61-- | Delimiter of list numbers.

62data ListNumberDelim = DefaultDelim

63 | Period

64 | OneParen

65− | TwoParens deriving (Eq, Show, Read, Typeable, Data)

65+ | TwoParens deriving (Eq, Ord, Show, Read, Typeable, Data)

67-- | Attributes: identifier, classes, key-value pairs

68type Attr = (String, [String], [(String, String)])

@@ -90,16 +90,16 @@ data Block

90 -- column headers (each a list of blocks), and

91 -- rows (each a list of lists of blocks)

92 | Null -- ^ Nothing

93− deriving (Eq, Read, Show, Typeable, Data)

93+ deriving (Eq, Ord, Read, Show, Typeable, Data)

95-- | Type of quotation marks to use in Quoted inline.

96−data QuoteType = SingleQuote | DoubleQuote deriving (Show, Eq, Read, Typeable, Data)

96+data QuoteType = SingleQuote | DoubleQuote deriving (Show, Eq, Ord, Read, Typeable, Data)

98-- | Link target (URL, title).

99type Target = (String, String)

100

101-- | Type of math element (display or inline).

102−data MathType = DisplayMath | InlineMath deriving (Show, Eq, Read, Typeable, Data)

102+data MathType = DisplayMath | InlineMath deriving (Show, Eq, Ord, Read, Typeable, Data)

103

104-- | Inline elements.

105data Inline

@@ -126,7 +126,7 @@ data Inline

126 | Image [Inline] Target -- ^ Image: alt text (list of inlines), target

127 -- and target

128 | Note [Block] -- ^ Footnote or endnote

129− deriving (Show, Eq, Read, Typeable, Data)

129+ deriving (Show, Eq, Ord, Read, Typeable, Data)

130

131-- | Applies a transformation on @a@s to matching elements in a @b@.

132processWith :: (Data a, Data b) => (a -> a) -> b -> b

src/Text/Pandoc/Readers/Markdown.hs+5−4

@@ -32,6 +32,7 @@ module Text.Pandoc.Readers.Markdown (

32 ) where

34import Data.List ( transpose, isSuffixOf, sortBy, findIndex, intercalate )

35+import qualified Data.Map as M

35import Data.Ord ( comparing )

36import Data.Ord ( comparing )

36import Data.Char ( isAlphaNum )

37import Data.Char ( isAlphaNum )

37import Data.Maybe

38import Data.Maybe

@@ -202,10 +203,10 @@ referenceKey = try $ do

202 tit <- option "" referenceTitle

203 tit <- option "" referenceTitle

203 blanklines

204 blanklines

204 endPos <- getPosition

205 endPos <- getPosition

205− let newkey = (lab, (escapeURI $ removeTrailingSpace src, tit))

206+ let target = (escapeURI $ removeTrailingSpace src, tit)

206 st <- getState

207 st <- getState

207 let oldkeys = stateKeys st

208 let oldkeys = stateKeys st

208− updateState $ \s -> s { stateKeys = newkey : oldkeys }

209+ updateState $ \s -> s { stateKeys = M.insert (Key lab) target oldkeys }

209 -- return blanks so line count isn't affected

210 -- return blanks so line count isn't affected

210 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'

211 return $ replicate (sourceLine endPos - sourceLine startPos) '\n'

211

212

@@ -1216,7 +1217,7 @@ referenceLink lab = do

1216 optional (newline >> skipSpaces) >> reference))

1217 optional (newline >> skipSpaces) >> reference))

1217 let ref' = if null ref then lab else ref

1218 let ref' = if null ref then lab else ref

1218 state <- getState

1219 state <- getState

1219− case lookupKeySrc (stateKeys state) ref' of

1220+ case lookupKeySrc (stateKeys state) (Key ref') of

1220 Nothing -> fail "no corresponding key"

1221 Nothing -> fail "no corresponding key"

1221 Just target -> return target

1222 Just target -> return target

1222

1223

@@ -1301,7 +1302,7 @@ inlineCitation = try $ do

1301chkCit :: Target -> GenParser Char ParserState (Maybe Target)

1302chkCit :: Target -> GenParser Char ParserState (Maybe Target)

1302chkCit t = do

1303chkCit t = do

1303 st <- getState

1304 st <- getState

1304− case lookupKeySrc (stateKeys st) [Str $ fst t] of

1305+ case lookupKeySrc (stateKeys st) (Key [Str $ fst t]) of

1305 Just _ -> fail "This is a link"

1306 Just _ -> fail "This is a link"

1306 Nothing -> if elem (fst t) $ stateCitations st

1307 Nothing -> if elem (fst t) $ stateCitations st

1307 then return $ Just t

1308 then return $ Just t

src/Text/Pandoc/Readers/RST.hs+23−19

@@ -34,7 +34,9 @@ import Text.Pandoc.Definition

34import Text.Pandoc.Shared

35import Text.ParserCombinators.Parsec

36import Control.Monad ( when, unless, liftM )

37−import Data.List ( findIndex, delete, intercalate, transpose )

37+import Data.List ( findIndex, intercalate, transpose, sort )

38+import qualified Data.Map as M

39+import Text.Printf ( printf )

39-- | Parse reStructuredText string and return Pandoc document.

41-- | Parse reStructuredText string and return Pandoc document.

40readRST :: ParserState -- ^ Parser state, including options for parser

42readRST :: ParserState -- ^ Parser state, including options for parser

@@ -93,9 +95,6 @@ parseRST = do

93 docMinusKeys <- manyTill (referenceKey <|> lineClump) eof >>= return . concat

95 docMinusKeys <- manyTill (referenceKey <|> lineClump) eof >>= return . concat

94 setInput docMinusKeys

96 setInput docMinusKeys

95 setPosition startPos

97 setPosition startPos

96− st <- getState

97− let reversedKeys = stateKeys st

98− updateState $ \s -> s { stateKeys = reverse reversedKeys }

99 -- now parse it for real...

98 -- now parse it for real...

100 blocks <- parseBlocks

99 blocks <- parseBlocks

101 let blocks' = filter (/= Null) blocks

100 let blocks' = filter (/= Null) blocks

@@ -540,10 +539,10 @@ referenceName = quotedReferenceName <|>

540referenceKey :: GenParser Char ParserState [Char]

539referenceKey :: GenParser Char ParserState [Char]

541referenceKey = do

540referenceKey = do

542 startPos <- getPosition

541 startPos <- getPosition

543− key <- choice [imageKey, anonymousKey, regularKey]

542+ (key, target) <- choice [imageKey, anonymousKey, regularKey]

544 st <- getState

543 st <- getState

545 let oldkeys = stateKeys st

544 let oldkeys = stateKeys st

546− updateState $ \s -> s { stateKeys = key : oldkeys }

545+ updateState $ \s -> s { stateKeys = M.insert key target oldkeys }

547 optional blanklines

546 optional blanklines

548 endPos <- getPosition

547 endPos <- getPosition

549 -- return enough blanks to replace key

548 -- return enough blanks to replace key

@@ -558,28 +557,29 @@ targetURI = do

558 blanklines

557 blanklines

559 return $ escapeURI $ removeLeadingTrailingSpace $ contents

558 return $ escapeURI $ removeLeadingTrailingSpace $ contents

560

559

561−imageKey :: GenParser Char ParserState ([Inline], (String, [Char]))

560+imageKey :: GenParser Char ParserState (Key, Target)

562imageKey = try $ do

561imageKey = try $ do

563 string ".. |"

562 string ".. |"

564 ref <- manyTill inline (char '|')

563 ref <- manyTill inline (char '|')

565 skipSpaces

564 skipSpaces

566 string "image::"

565 string "image::"

567 src <- targetURI

566 src <- targetURI

568− return (normalizeSpaces ref, (src, ""))

567+ return (Key (normalizeSpaces ref), (src, ""))

569

568

570−anonymousKey :: GenParser Char st ([Inline], (String, [Char]))

569+anonymousKey :: GenParser Char st (Key, Target)

571anonymousKey = try $ do

570anonymousKey = try $ do

572 oneOfStrings [".. __:", "__"]

571 oneOfStrings [".. __:", "__"]

573 src <- targetURI

572 src <- targetURI

573+ pos <- getPosition

574− return ([Str "_"], (src, ""))

574+ return (Key [Str $ "_" ++ printf "%09d" (sourceLine pos)], (src, ""))

575

576−regularKey :: GenParser Char ParserState ([Inline], (String, [Char]))

576+regularKey :: GenParser Char ParserState (Key, Target)

577regularKey = try $ do

578 string ".. _"

579 ref <- referenceName

580 char ':'

581 src <- targetURI

582− return (normalizeSpaces ref, (src, ""))

582+ return (Key (normalizeSpaces ref), (src, ""))

583

584--

585-- tables

@@ -889,17 +889,21 @@ explicitLink = try $ do

889referenceLink :: GenParser Char ParserState Inline

890referenceLink = try $ do

891 label' <- (quotedReferenceName <|> simpleReferenceName) >>~ char '_'

892− key <- option label' (do{char '_'; return [Str "_"]}) -- anonymous link

893 state <- getState

892 state <- getState

894 let keyTable = stateKeys state

893 let keyTable = stateKeys state

894+ let isAnonKey (Key [Str ('_':_)]) = True

895+ isAnonKey _ = False

896+ key <- option (Key label') $

897+ do char '_'

898+ let anonKeys = sort $ filter isAnonKey $ M.keys keyTable

899+ if null anonKeys

900+ then pzero

901+ else return (head anonKeys)

895 (src,tit) <- case lookupKeySrc keyTable key of

902 (src,tit) <- case lookupKeySrc keyTable key of

896 Nothing -> fail "no corresponding key"

903 Nothing -> fail "no corresponding key"

897 Just target -> return target

904 Just target -> return target

898− -- if anonymous link, remove first anon key so it won't be used again

905+ -- if anonymous link, remove key so it won't be used again

899− let keyTable' = if (key == [Str "_"]) -- anonymous link?

906+ when (isAnonKey key) $ updateState $ \s -> s{ stateKeys = M.delete key keyTable }

900− then delete ([Str "_"], (src,tit)) keyTable -- remove first anon key

901− else keyTable

902− setState $ state { stateKeys = keyTable' }

903 return $ Link (normalizeSpaces label') (src, tit)

907 return $ Link (normalizeSpaces label') (src, tit)

904

908

905autoURI :: GenParser Char ParserState Inline

909autoURI :: GenParser Char ParserState Inline

@@ -922,7 +926,7 @@ image = try $ do

922 ref <- manyTill inline (char '|')

926 ref <- manyTill inline (char '|')

923 state <- getState

927 state <- getState

924 let keyTable = stateKeys state

928 let keyTable = stateKeys state

925− (src,tit) <- case lookupKeySrc keyTable ref of

929+ (src,tit) <- case lookupKeySrc keyTable (Key ref) of

926 Nothing -> fail "no corresponding key"

930 Nothing -> fail "no corresponding key"

927 Just target -> return target

931 Just target -> return target

928 return $ Image (normalizeSpaces ref) (src, tit)

932 return $ Image (normalizeSpaces ref) (src, tit)

src/Text/Pandoc/Shared.hs+16−6

@@ -88,6 +88,7 @@ module Text.Pandoc.Shared (

88 QuoteContext (..),

89 NoteTable,

90 KeyTable,

91+ Key (..),

91 lookupKeySrc,

92 lookupKeySrc,

92 refsMatch,

93 refsMatch,

93 -- * Prettyprinting

94 -- * Prettyprinting

@@ -127,6 +128,7 @@ import System.FilePath ( (</>) )

127import Data.Generics (Typeable, Data)

128import Data.Generics (Typeable, Data)

128import qualified Control.Monad.State as S

129import qualified Control.Monad.State as S

129import Control.Monad (join)

130import Control.Monad (join)

131+import qualified Data.Map as M

130import Paths_pandoc (getDataFileName)

132import Paths_pandoc (getDataFileName)

131

133

132--

134--

@@ -704,7 +706,7 @@ defaultParserState =

704 stateParserContext = NullState,

706 stateParserContext = NullState,

705 stateQuoteContext = NoQuote,

707 stateQuoteContext = NoQuote,

706 stateSanitizeHTML = False,

708 stateSanitizeHTML = False,

707− stateKeys = [],

709+ stateKeys = M.empty,

708#ifdef _CITEPROC

710#ifdef _CITEPROC

709 stateCitations = [],

711 stateCitations = [],

710#endif

712#endif

@@ -739,15 +741,23 @@ data QuoteContext

739

741

740type NoteTable = [(String, String)]

742type NoteTable = [(String, String)]

741

743

742−type KeyTable = [([Inline], Target)]

744+newtype Key = Key [Inline] deriving (Show, Read)

745+

746+instance Eq Key where

747+ Key a == Key b = refsMatch a b

748+

749+instance Ord Key where

750+ compare (Key a) (Key b) = if a == b then EQ else compare a b

751+

752+type KeyTable = M.Map Key Target

743

753

744-- | Look up key in key table and return target object.

754-- | Look up key in key table and return target object.

745lookupKeySrc :: KeyTable -- ^ Key table

755lookupKeySrc :: KeyTable -- ^ Key table

746− -> [Inline] -- ^ Key

756+ -> Key -- ^ Key

747 -> Maybe Target

757 -> Maybe Target

748−lookupKeySrc table key = case find (refsMatch key . fst) table of

758+lookupKeySrc table key = case M.lookup key table of

749− Nothing -> Nothing

759+ Nothing -> Nothing

750− Just (_, src) -> Just src

760+ Just src -> Just src

751

761

752-- | Returns @True@ if keys match (case insensitive).

762-- | Returns @True@ if keys match (case insensitive).

753refsMatch :: [Inline] -> [Inline] -> Bool

763refsMatch :: [Inline] -> [Inline] -> Bool

src/Text/Pandoc/Writers/Markdown.hs+4−4

@@ -40,7 +40,7 @@ import Text.PrettyPrint.HughesPJ hiding ( Str )

40import Control.Monad.State

42type Notes = [[Block]]

43−type Refs = KeyTable

43+type Refs = [([Inline], Target)]

44data WriterState = WriterState { stNotes :: Notes

45 , stRefs :: Refs

46 , stPlain :: Bool }

@@ -94,7 +94,7 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do

94 st <- get

95 notes' <- notesToMarkdown opts (reverse $ stNotes st)

96 st' <- get -- note that the notes may contain refs

97− refs' <- keyTableToMarkdown opts (reverse $ stRefs st')

97+ refs' <- refsToMarkdown opts (reverse $ stRefs st')

98 let main = render $ body $+$ text "" $+$ notes' $+$ text "" $+$ refs'

99 let context = writerVariables opts ++

100 [ ("toc", render toc)

@@ -109,8 +109,8 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do

109 else return main

110

111-- | Return markdown representation of reference key table.

112−keyTableToMarkdown :: WriterOptions -> KeyTable -> State WriterState Doc

112+refsToMarkdown :: WriterOptions -> Refs -> State WriterState Doc

113−keyTableToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat

113+refsToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat

114

115-- | Return markdown representation of a reference key.

116keyToMarkdown :: WriterOptions

src/Text/Pandoc/Writers/RST.hs+10−8

@@ -39,10 +39,12 @@ import Text.PrettyPrint.HughesPJ hiding ( Str )

39import Control.Monad.State

40import Control.Applicative ( (<$>) )

42+type Refs = [([Inline], Target)]

43+

42data WriterState =

44data WriterState =

43 WriterState { stNotes :: [[Block]]

45 WriterState { stNotes :: [[Block]]

44− , stLinks :: KeyTable

46+ , stLinks :: Refs

45− , stImages :: KeyTable

47+ , stImages :: Refs

46 , stHasMath :: Bool

48 , stHasMath :: Bool

47 , stOptions :: WriterOptions

49 , stOptions :: WriterOptions

48 }

50 }

@@ -65,8 +67,8 @@ pandocToRST (Pandoc (Meta tit auth dat) blocks) = do

65 body <- blockListToRST blocks

67 body <- blockListToRST blocks

66 notes <- liftM (reverse . stNotes) get >>= notesToRST

68 notes <- liftM (reverse . stNotes) get >>= notesToRST

67 -- note that the notes may contain refs, so we do them first

69 -- note that the notes may contain refs, so we do them first

68− refs <- liftM (reverse . stLinks) get >>= keyTableToRST

70+ refs <- liftM (reverse . stLinks) get >>= refsToRST

69− pics <- liftM (reverse . stImages) get >>= pictTableToRST

71+ pics <- liftM (reverse . stImages) get >>= pictRefsToRST

70 hasMath <- liftM stHasMath get

72 hasMath <- liftM stHasMath get

71 let main = render $ body $+$ notes $+$ text "" $+$ refs $+$ pics

73 let main = render $ body $+$ notes $+$ text "" $+$ refs $+$ pics

72 let context = writerVariables opts ++

74 let context = writerVariables opts ++

@@ -80,8 +82,8 @@ pandocToRST (Pandoc (Meta tit auth dat) blocks) = do

80 else return main

82 else return main

82-- | Return RST representation of reference key table.

84-- | Return RST representation of reference key table.

83−keyTableToRST :: KeyTable -> State WriterState Doc

85+refsToRST :: Refs -> State WriterState Doc

84−keyTableToRST refs = mapM keyToRST refs >>= return . vcat

86+refsToRST refs = mapM keyToRST refs >>= return . vcat

86-- | Return RST representation of a reference key.

88-- | Return RST representation of a reference key.

87keyToRST :: ([Inline], (String, String))

89keyToRST :: ([Inline], (String, String))

@@ -107,8 +109,8 @@ noteToRST num note = do

107 return $ marker $$ nest 3 contents

109 return $ marker $$ nest 3 contents

108

110

109-- | Return RST representation of picture reference table.

111-- | Return RST representation of picture reference table.

110−pictTableToRST :: KeyTable -> State WriterState Doc

112+pictRefsToRST :: Refs -> State WriterState Doc

111−pictTableToRST refs = mapM pictToRST refs >>= return . vcat

113+pictRefsToRST refs = mapM pictToRST refs >>= return . vcat

112

114

113-- | Return RST representation of a picture substitution reference.

115-- | Return RST representation of a picture substitution reference.

114pictToRST :: ([Inline], (String, String))

116pictToRST :: ([Inline], (String, String))