aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Text/Pandoc/Parsing.hs55
-rw-r--r--src/Text/Pandoc/Readers/Markdown.hs4
-rw-r--r--src/Text/Pandoc/Readers/RST.hs15
-rw-r--r--tests/markdown-reader-more.native6
-rw-r--r--tests/markdown-reader-more.txt10
5 files changed, 42 insertions, 48 deletions
diff --git a/src/Text/Pandoc/Parsing.hs b/src/Text/Pandoc/Parsing.hs
index 47e97c7cc..ecb3dd262 100644
--- a/src/Text/Pandoc/Parsing.hs
+++ b/src/Text/Pandoc/Parsing.hs
@@ -64,9 +64,10 @@ module Text.Pandoc.Parsing ( (>>~),
QuoteContext (..),
NoteTable,
KeyTable,
- Key (..),
- lookupKeySrc,
- refsMatch )
+ Key,
+ toKey,
+ fromKey,
+ lookupKeySrc )
where
import Text.Pandoc.Definition
@@ -651,13 +652,21 @@ data QuoteContext
type NoteTable = [(String, String)]
-newtype Key = Key [Inline] deriving (Show, Read)
+newtype Key = Key [Inline] deriving (Show, Read, Eq, Ord)
-instance Eq Key where
- Key a == Key b = refsMatch a b
+toKey :: [Inline] -> Key
+toKey = Key . processWith lowercase
+ where lowercase :: Inline -> Inline
+ lowercase (Str xs) = Str (map toLower xs)
+ lowercase (Math t xs) = Math t (map toLower xs)
+ lowercase (Code xs) = Code (map toLower xs)
+ lowercase (TeX xs) = TeX (map toLower xs)
+ lowercase (HtmlInline xs) = HtmlInline (map toLower xs)
+ lowercase LineBreak = Space
+ lowercase x = x
-instance Ord Key where
- compare (Key a) (Key b) = if a == b then EQ else compare a b
+fromKey :: Key -> [Inline]
+fromKey (Key xs) = xs
type KeyTable = M.Map Key Target
@@ -669,33 +678,3 @@ 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
-refsMatch ((Str x):restx) ((Str y):resty) =
- ((map toLower x) == (map toLower y)) && refsMatch restx resty
-refsMatch ((Emph x):restx) ((Emph y):resty) =
- refsMatch x y && refsMatch restx resty
-refsMatch ((Strong x):restx) ((Strong y):resty) =
- refsMatch x y && refsMatch restx resty
-refsMatch ((Strikeout x):restx) ((Strikeout y):resty) =
- refsMatch x y && refsMatch restx resty
-refsMatch ((Superscript x):restx) ((Superscript y):resty) =
- refsMatch x y && refsMatch restx resty
-refsMatch ((Subscript x):restx) ((Subscript y):resty) =
- refsMatch x y && refsMatch restx resty
-refsMatch ((SmallCaps x):restx) ((SmallCaps y):resty) =
- refsMatch x y && refsMatch restx resty
-refsMatch ((Quoted t x):restx) ((Quoted u y):resty) =
- t == u && refsMatch x y && refsMatch restx resty
-refsMatch ((Code x):restx) ((Code y):resty) =
- ((map toLower x) == (map toLower y)) && refsMatch restx resty
-refsMatch ((Math t x):restx) ((Math u y):resty) =
- ((map toLower x) == (map toLower y)) && t == u && refsMatch restx resty
-refsMatch ((TeX x):restx) ((TeX y):resty) =
- ((map toLower x) == (map toLower y)) && refsMatch restx resty
-refsMatch ((HtmlInline x):restx) ((HtmlInline y):resty) =
- ((map toLower x) == (map toLower y)) && refsMatch restx resty
-refsMatch (x:restx) (y:resty) = (x == y) && refsMatch restx resty
-refsMatch [] x = null x
-refsMatch x [] = null x
-
diff --git a/src/Text/Pandoc/Readers/Markdown.hs b/src/Text/Pandoc/Readers/Markdown.hs
index 30012eaa5..feee31ec5 100644
--- a/src/Text/Pandoc/Readers/Markdown.hs
+++ b/src/Text/Pandoc/Readers/Markdown.hs
@@ -220,7 +220,7 @@ referenceKey = try $ do
let target = (escapeURI $ removeTrailingSpace src, tit)
st <- getState
let oldkeys = stateKeys st
- updateState $ \s -> s { stateKeys = M.insert (Key lab) target oldkeys }
+ updateState $ \s -> s { stateKeys = M.insert (toKey lab) target oldkeys }
-- return blanks so line count isn't affected
return $ replicate (sourceLine endPos - sourceLine startPos) '\n'
@@ -1237,7 +1237,7 @@ referenceLink lab = do
optional (newline >> skipSpaces) >> reference))
let ref' = if null ref then lab else ref
state <- getState
- case lookupKeySrc (stateKeys state) (Key ref') of
+ case lookupKeySrc (stateKeys state) (toKey ref') of
Nothing -> fail "no corresponding key"
Just target -> return target
diff --git a/src/Text/Pandoc/Readers/RST.hs b/src/Text/Pandoc/Readers/RST.hs
index 13afe5053..a39a46117 100644
--- a/src/Text/Pandoc/Readers/RST.hs
+++ b/src/Text/Pandoc/Readers/RST.hs
@@ -565,14 +565,14 @@ imageKey = try $ do
skipSpaces
string "image::"
src <- targetURI
- return (Key (normalizeSpaces ref), (src, ""))
+ return (toKey (normalizeSpaces ref), (src, ""))
anonymousKey :: GenParser Char st (Key, Target)
anonymousKey = try $ do
oneOfStrings [".. __:", "__"]
src <- targetURI
pos <- getPosition
- return (Key [Str $ "_" ++ printf "%09d" (sourceLine pos)], (src, ""))
+ return (toKey [Str $ "_" ++ printf "%09d" (sourceLine pos)], (src, ""))
regularKey :: GenParser Char ParserState (Key, Target)
regularKey = try $ do
@@ -580,7 +580,7 @@ regularKey = try $ do
ref <- referenceName
char ':'
src <- targetURI
- return (Key (normalizeSpaces ref), (src, ""))
+ return (toKey (normalizeSpaces ref), (src, ""))
--
-- tables
@@ -779,9 +779,10 @@ referenceLink = try $ do
label' <- (quotedReferenceName <|> simpleReferenceName) >>~ char '_'
state <- getState
let keyTable = stateKeys state
- let isAnonKey (Key [Str ('_':_)]) = True
- isAnonKey _ = False
- key <- option (Key label') $
+ let isAnonKey x = case fromKey x of
+ [Str ('_':_)] -> True
+ _ -> False
+ key <- option (toKey label') $
do char '_'
let anonKeys = sort $ filter isAnonKey $ M.keys keyTable
if null anonKeys
@@ -814,7 +815,7 @@ image = try $ do
ref <- manyTill inline (char '|')
state <- getState
let keyTable = stateKeys state
- (src,tit) <- case lookupKeySrc keyTable (Key ref) of
+ (src,tit) <- case lookupKeySrc keyTable (toKey ref) of
Nothing -> fail "no corresponding key"
Just target -> return target
return $ Image (normalizeSpaces ref) (src, tit)
diff --git a/tests/markdown-reader-more.native b/tests/markdown-reader-more.native
index 884fe868e..55968af32 100644
--- a/tests/markdown-reader-more.native
+++ b/tests/markdown-reader-more.native
@@ -41,4 +41,8 @@ Pandoc (Meta {docTitle = [Str "Title",Space,Str "spanning",Space,Str "multiple",
[ [ Plain [Str "Third",Space,Str "example",Str "."] ]
]
, Header 2 [Str "Macros"]
-, Para [Math InlineMath "\\langle x,y \\rangle"] ]
+, Para [Math InlineMath "\\langle x,y \\rangle"]
+, Header 2 [Str "Case",Str "-",Str "insensitive",Space,Str "references"]
+, Para [Link [Str "Fum"] ("/fum","")]
+, Para [Link [Str "FUM"] ("/fum","")]
+, Para [Link [Str "bat"] ("/bat","")] ]
diff --git a/tests/markdown-reader-more.txt b/tests/markdown-reader-more.txt
index 5e03d7152..dd43a5df3 100644
--- a/tests/markdown-reader-more.txt
+++ b/tests/markdown-reader-more.txt
@@ -106,3 +106,13 @@ Explanation of examples (@foo) and (@bar).
$\tuple{x,y}$
+## Case-insensitive references
+
+[Fum]
+
+[FUM]
+
+[bat]
+
+[fum]: /fum
+[BAT]: /bat
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-08 13:15:43 +0000