Made KeyTable a map instead of an association list.
* This affects the RST and Markdown readers. * The type for stateKeys in ParserState has also changed. * Pandoc, Meta, Inline, and Block have been given Ord instances. * Reference keys now have a type of their own (Key), with its own Ord instance for case-insensitive comparison.
This commit is contained in:
John MacFarlane
parent
91f52e2229
commit
b5bda7569e
6 changed files with 67 additions and 50 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue