Fix regression: markdown references should be case-insensitive.

This broke when we added the Key type.  We had assumed that
the custom case-insensitive Ord instance would ensure case-insensitive
matching, but that is not how Data.Map works.

* Added a test case for case-insensitivity in markdown-reader-more
* Removed old refsMatch from Text.Pandoc.Parsing module;
* hid the 'Key' constructor;
* dropped the custom Ord and Eq instances, deriving instead;
* added fromKey and toKey to convert between Keys and Inline lists;
* toKey ensures that keys are case-insensitive, since this is the
  only way the API provides to construct a Key.

Resolves Issue #272.

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