aboutsummaryrefslogtreecommitdiff
path: root/src/Text/Pandoc
diff options
context:
space:
mode:
Diffstat (limited to 'src/Text/Pandoc')
-rw-r--r--src/Text/Pandoc/Definition.hs18
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs9
-rw-r--r--src/Text/Pandoc/Readers/RST.hs42
-rw-r--r--src/Text/Pandoc/Shared.hs22
-rw-r--r--src/Text/Pandoc/Writers/Markdown.hs8
-rw-r--r--src/Text/Pandoc/Writers/RST.hs18
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))
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-05 12:07:14 +0000