diff options
| -rw-r--r-- | src/Text/Pandoc/Definition.hs | 18 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/Markdown.hs | 9 | ||||
| -rw-r--r-- | src/Text/Pandoc/Readers/RST.hs | 42 | ||||
| -rw-r--r-- | src/Text/Pandoc/Shared.hs | 22 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/Markdown.hs | 8 | ||||
| -rw-r--r-- | src/Text/Pandoc/Writers/RST.hs | 18 |
6 files changed, 67 insertions, 50 deletions
diff --git a/src/Text/Pandoc/Definition.hs b/src/Text/Pandoc/Definition.hs index 169c4d1a6..7ddd26625 100644 --- a/src/Text/Pandoc/Definition.hs +++ b/src/Text/Pandoc/Definition.hs @@ -33,19 +33,19 @@ module Text.Pandoc.Definition where import Data.Generics -data Pandoc = Pandoc Meta [Block] deriving (Eq, Read, Show, Typeable, Data) +data Pandoc = Pandoc Meta [Block] deriving (Eq, Ord, Read, Show, Typeable, Data) -- | Bibliographic information for the document: title, authors, date. data Meta = Meta { docTitle :: [Inline] , docAuthors :: [[Inline]] , docDate :: [Inline] } - deriving (Eq, Show, Read, Typeable, Data) + deriving (Eq, Ord, Show, Read, Typeable, Data) -- | Alignment of a table column. data Alignment = AlignLeft | AlignRight | AlignCenter - | AlignDefault deriving (Eq, Show, Read, Typeable, Data) + | AlignDefault deriving (Eq, Ord, Show, Read, Typeable, Data) -- | List attributes. type ListAttributes = (Int, ListNumberStyle, ListNumberDelim) @@ -56,13 +56,13 @@ data ListNumberStyle = DefaultStyle | LowerRoman | UpperRoman | LowerAlpha - | UpperAlpha deriving (Eq, Show, Read, Typeable, Data) + | UpperAlpha deriving (Eq, Ord, Show, Read, Typeable, Data) -- | Delimiter of list numbers. data ListNumberDelim = DefaultDelim | Period | OneParen - | TwoParens deriving (Eq, Show, Read, Typeable, Data) + | TwoParens deriving (Eq, Ord, Show, Read, Typeable, Data) -- | Attributes: identifier, classes, key-value pairs type Attr = (String, [String], [(String, String)]) @@ -90,16 +90,16 @@ data Block -- column headers (each a list of blocks), and -- rows (each a list of lists of blocks) | Null -- ^ Nothing - deriving (Eq, Read, Show, Typeable, Data) + deriving (Eq, Ord, Read, Show, Typeable, Data) -- | Type of quotation marks to use in Quoted inline. -data QuoteType = SingleQuote | DoubleQuote deriving (Show, Eq, Read, Typeable, Data) +data QuoteType = SingleQuote | DoubleQuote deriving (Show, Eq, Ord, Read, Typeable, Data) -- | Link target (URL, title). type Target = (String, String) -- | Type of math element (display or inline). -data MathType = DisplayMath | InlineMath deriving (Show, Eq, Read, Typeable, Data) +data MathType = DisplayMath | InlineMath deriving (Show, Eq, Ord, Read, Typeable, Data) -- | Inline elements. data Inline @@ -126,7 +126,7 @@ data Inline | Image [Inline] Target -- ^ Image: alt text (list of inlines), target -- and target | Note [Block] -- ^ Footnote or endnote - deriving (Show, Eq, Read, Typeable, Data) + deriving (Show, Eq, Ord, Read, Typeable, Data) -- | Applies a transformation on @a@s to matching elements in a @b@. processWith :: (Data a, Data b) => (a -> a) -> b -> b diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs index bc8e7cd43..a6d383fca 100644 --- a/src/Text/Pandoc/Readers/Markdown.hs +++ b/src/Text/Pandoc/Readers/Markdown.hs @@ -32,6 +32,7 @@ module Text.Pandoc.Readers.Markdown ( ) where import Data.List ( transpose, isSuffixOf, sortBy, findIndex, intercalate ) +import qualified Data.Map as M import Data.Ord ( comparing ) import Data.Char ( isAlphaNum ) import Data.Maybe @@ -202,10 +203,10 @@ referenceKey = try $ do tit <- option "" referenceTitle blanklines endPos <- getPosition - let newkey = (lab, (escapeURI $ removeTrailingSpace src, tit)) + let target = (escapeURI $ removeTrailingSpace src, tit) st <- getState let oldkeys = stateKeys st - updateState $ \s -> s { stateKeys = newkey : oldkeys } + updateState $ \s -> s { stateKeys = M.insert (Key lab) target oldkeys } -- return blanks so line count isn't affected return $ replicate (sourceLine endPos - sourceLine startPos) '\n' @@ -1216,7 +1217,7 @@ referenceLink lab = do optional (newline >> skipSpaces) >> reference)) let ref' = if null ref then lab else ref state <- getState - case lookupKeySrc (stateKeys state) ref' of + case lookupKeySrc (stateKeys state) (Key ref') of Nothing -> fail "no corresponding key" Just target -> return target @@ -1301,7 +1302,7 @@ inlineCitation = try $ do chkCit :: Target -> GenParser Char ParserState (Maybe Target) chkCit t = do st <- getState - case lookupKeySrc (stateKeys st) [Str $ fst t] of + case lookupKeySrc (stateKeys st) (Key [Str $ fst t]) of Just _ -> fail "This is a link" Nothing -> if elem (fst t) $ stateCitations st then return $ Just t diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs index 5e7ea512e..7b4b5eee8 100644 --- a/src/Text/Pandoc/Readers/RST.hs +++ b/src/Text/Pandoc/Readers/RST.hs @@ -34,7 +34,9 @@ import Text.Pandoc.Definition import Text.Pandoc.Shared import Text.ParserCombinators.Parsec import Control.Monad ( when, unless, liftM ) -import Data.List ( findIndex, delete, intercalate, transpose ) +import Data.List ( findIndex, intercalate, transpose, sort ) +import qualified Data.Map as M +import Text.Printf ( printf ) -- | Parse reStructuredText string and return Pandoc document. readRST :: ParserState -- ^ Parser state, including options for parser @@ -93,9 +95,6 @@ parseRST = do docMinusKeys <- manyTill (referenceKey <|> lineClump) eof >>= return . concat setInput docMinusKeys setPosition startPos - st <- getState - let reversedKeys = stateKeys st - updateState $ \s -> s { stateKeys = reverse reversedKeys } -- now parse it for real... blocks <- parseBlocks let blocks' = filter (/= Null) blocks @@ -540,10 +539,10 @@ referenceName = quotedReferenceName <|> referenceKey :: GenParser Char ParserState [Char] referenceKey = do startPos <- getPosition - key <- choice [imageKey, anonymousKey, regularKey] + (key, target) <- choice [imageKey, anonymousKey, regularKey] st <- getState let oldkeys = stateKeys st - updateState $ \s -> s { stateKeys = key : oldkeys } + updateState $ \s -> s { stateKeys = M.insert key target oldkeys } optional blanklines endPos <- getPosition -- return enough blanks to replace key @@ -558,28 +557,29 @@ targetURI = do blanklines return $ escapeURI $ removeLeadingTrailingSpace $ contents -imageKey :: GenParser Char ParserState ([Inline], (String, [Char])) +imageKey :: GenParser Char ParserState (Key, Target) imageKey = try $ do string ".. |" ref <- manyTill inline (char '|') skipSpaces string "image::" src <- targetURI - return (normalizeSpaces ref, (src, "")) + return (Key (normalizeSpaces ref), (src, "")) -anonymousKey :: GenParser Char st ([Inline], (String, [Char])) +anonymousKey :: GenParser Char st (Key, Target) anonymousKey = try $ do oneOfStrings [".. __:", "__"] src <- targetURI - return ([Str "_"], (src, "")) + pos <- getPosition + return (Key [Str $ "_" ++ printf "%09d" (sourceLine pos)], (src, "")) -regularKey :: GenParser Char ParserState ([Inline], (String, [Char])) +regularKey :: GenParser Char ParserState (Key, Target) regularKey = try $ do string ".. _" ref <- referenceName char ':' src <- targetURI - return (normalizeSpaces ref, (src, "")) + return (Key (normalizeSpaces ref), (src, "")) -- -- tables @@ -889,17 +889,21 @@ explicitLink = try $ do referenceLink :: GenParser Char ParserState Inline referenceLink = try $ do label' <- (quotedReferenceName <|> simpleReferenceName) >>~ char '_' - key <- option label' (do{char '_'; return [Str "_"]}) -- anonymous link state <- getState let keyTable = stateKeys state + let isAnonKey (Key [Str ('_':_)]) = True + isAnonKey _ = False + key <- option (Key label') $ + do char '_' + let anonKeys = sort $ filter isAnonKey $ M.keys keyTable + if null anonKeys + then pzero + else return (head anonKeys) (src,tit) <- case lookupKeySrc keyTable key of Nothing -> fail "no corresponding key" Just target -> return target - -- if anonymous link, remove first anon key so it won't be used again - let keyTable' = if (key == [Str "_"]) -- anonymous link? - then delete ([Str "_"], (src,tit)) keyTable -- remove first anon key - else keyTable - setState $ state { stateKeys = keyTable' } + -- if anonymous link, remove key so it won't be used again + when (isAnonKey key) $ updateState $ \s -> s{ stateKeys = M.delete key keyTable } return $ Link (normalizeSpaces label') (src, tit) autoURI :: GenParser Char ParserState Inline @@ -922,7 +926,7 @@ image = try $ do ref <- manyTill inline (char '|') state <- getState let keyTable = stateKeys state - (src,tit) <- case lookupKeySrc keyTable ref of + (src,tit) <- case lookupKeySrc keyTable (Key ref) of Nothing -> fail "no corresponding key" Just target -> return target return $ Image (normalizeSpaces ref) (src, tit) diff --git a/src/Text/Pandoc/Shared.hs b/src/Text/Pandoc/Shared.hs index c43839d40..88eccb96c 100644 --- a/src/Text/Pandoc/Shared.hs +++ b/src/Text/Pandoc/Shared.hs @@ -88,6 +88,7 @@ module Text.Pandoc.Shared ( QuoteContext (..), NoteTable, KeyTable, + Key (..), lookupKeySrc, refsMatch, -- * Prettyprinting @@ -127,6 +128,7 @@ import System.FilePath ( (</>) ) import Data.Generics (Typeable, Data) import qualified Control.Monad.State as S import Control.Monad (join) +import qualified Data.Map as M import Paths_pandoc (getDataFileName) -- @@ -704,7 +706,7 @@ defaultParserState = stateParserContext = NullState, stateQuoteContext = NoQuote, stateSanitizeHTML = False, - stateKeys = [], + stateKeys = M.empty, #ifdef _CITEPROC stateCitations = [], #endif @@ -739,15 +741,23 @@ data QuoteContext type NoteTable = [(String, String)] -type KeyTable = [([Inline], Target)] +newtype Key = Key [Inline] deriving (Show, Read) + +instance Eq Key where + Key a == Key b = refsMatch a b + +instance Ord Key where + compare (Key a) (Key b) = if a == b then EQ else compare a b + +type KeyTable = M.Map Key Target -- | Look up key in key table and return target object. lookupKeySrc :: KeyTable -- ^ Key table - -> [Inline] -- ^ Key + -> Key -- ^ Key -> Maybe Target -lookupKeySrc table key = case find (refsMatch key . fst) table of - Nothing -> Nothing - Just (_, src) -> Just src +lookupKeySrc table key = case M.lookup key table of + Nothing -> Nothing + Just src -> Just src -- | Returns @True@ if keys match (case insensitive). refsMatch :: [Inline] -> [Inline] -> Bool diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs index fe8e0c2de..d6876d239 100644 --- a/src/Text/Pandoc/Writers/Markdown.hs +++ b/src/Text/Pandoc/Writers/Markdown.hs @@ -40,7 +40,7 @@ import Text.PrettyPrint.HughesPJ hiding ( Str ) import Control.Monad.State type Notes = [[Block]] -type Refs = KeyTable +type Refs = [([Inline], Target)] data WriterState = WriterState { stNotes :: Notes , stRefs :: Refs , stPlain :: Bool } @@ -94,7 +94,7 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do st <- get notes' <- notesToMarkdown opts (reverse $ stNotes st) st' <- get -- note that the notes may contain refs - refs' <- keyTableToMarkdown opts (reverse $ stRefs st') + refs' <- refsToMarkdown opts (reverse $ stRefs st') let main = render $ body $+$ text "" $+$ notes' $+$ text "" $+$ refs' let context = writerVariables opts ++ [ ("toc", render toc) @@ -109,8 +109,8 @@ pandocToMarkdown opts (Pandoc (Meta title authors date) blocks) = do else return main -- | Return markdown representation of reference key table. -keyTableToMarkdown :: WriterOptions -> KeyTable -> State WriterState Doc -keyTableToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat +refsToMarkdown :: WriterOptions -> Refs -> State WriterState Doc +refsToMarkdown opts refs = mapM (keyToMarkdown opts) refs >>= return . vcat -- | Return markdown representation of a reference key. keyToMarkdown :: WriterOptions diff --git a/src/Text/Pandoc/Writers/RST.hs b/src/Text/Pandoc/Writers/RST.hs index f4dfb2aa6..680ec7749 100644 --- a/src/Text/Pandoc/Writers/RST.hs +++ b/src/Text/Pandoc/Writers/RST.hs @@ -39,10 +39,12 @@ import Text.PrettyPrint.HughesPJ hiding ( Str ) import Control.Monad.State import Control.Applicative ( (<$>) ) +type Refs = [([Inline], Target)] + data WriterState = WriterState { stNotes :: [[Block]] - , stLinks :: KeyTable - , stImages :: KeyTable + , stLinks :: Refs + , stImages :: Refs , stHasMath :: Bool , stOptions :: WriterOptions } @@ -65,8 +67,8 @@ pandocToRST (Pandoc (Meta tit auth dat) blocks) = do body <- blockListToRST blocks notes <- liftM (reverse . stNotes) get >>= notesToRST -- note that the notes may contain refs, so we do them first - refs <- liftM (reverse . stLinks) get >>= keyTableToRST - pics <- liftM (reverse . stImages) get >>= pictTableToRST + refs <- liftM (reverse . stLinks) get >>= refsToRST + pics <- liftM (reverse . stImages) get >>= pictRefsToRST hasMath <- liftM stHasMath get let main = render $ body $+$ notes $+$ text "" $+$ refs $+$ pics let context = writerVariables opts ++ @@ -80,8 +82,8 @@ pandocToRST (Pandoc (Meta tit auth dat) blocks) = do else return main -- | Return RST representation of reference key table. -keyTableToRST :: KeyTable -> State WriterState Doc -keyTableToRST refs = mapM keyToRST refs >>= return . vcat +refsToRST :: Refs -> State WriterState Doc +refsToRST refs = mapM keyToRST refs >>= return . vcat -- | Return RST representation of a reference key. keyToRST :: ([Inline], (String, String)) @@ -107,8 +109,8 @@ noteToRST num note = do return $ marker $$ nest 3 contents -- | Return RST representation of picture reference table. -pictTableToRST :: KeyTable -> State WriterState Doc -pictTableToRST refs = mapM pictToRST refs >>= return . vcat +pictRefsToRST :: Refs -> State WriterState Doc +pictRefsToRST refs = mapM pictToRST refs >>= return . vcat -- | Return RST representation of a picture substitution reference. pictToRST :: ([Inline], (String, String)) |