From b191243837fa64136bd3d0e5feef975847c392b5 Mon Sep 17 00:00:00 2001
From: David Waern <davve@dtek.chalmers.se>
Date: Sun, 21 Oct 2007 14:35:49 +0000
Subject: [PATCH] FIX: Ord for OrdName was not comparing modules
---
src/Haddock/Interface/Rename.hs | 19 ++++++++++++++-----
1 file changed, 14 insertions(+), 5 deletions(-)
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index f22f9a2cc9..9f8399e2c2 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -17,6 +17,7 @@ import BasicTypes
import SrcLoc
import Bag (emptyBag)
import Outputable
+import Util (thenCmp)
import Data.List
import Data.Map (Map)
@@ -59,7 +60,7 @@ renameInterface renamingEnv mod =
-- filter out certain built in type constructors using their string
-- representation. TODO: use the Name constants from the GHC API.
strings = filter (`notElem` ["()", "[]", "(->)"])
- (map (showSDoc . ppr) missingNames)
+ (map pretty missingNames)
in do
-- report things that we couldn't link to. Only do this for non-hidden
@@ -116,19 +117,27 @@ lookupRn and_then name = do
newtype OrdName = MkOrdName Name
instance Eq OrdName where
- (MkOrdName a) == (MkOrdName b) = a == b
+ (MkOrdName a) == (MkOrdName b) = compare a b == EQ
instance Ord OrdName where
- (MkOrdName a) `compare` (MkOrdName b) = nameOccName a `compare` nameOccName b
+ (MkOrdName a) `compare` (MkOrdName b) =
+ case (nameModule_maybe a, nameModule_maybe b) of
+ (Just modA, Just modB) ->
+ (modA `compare` modB) `thenCmp` (getOccName a `compare` getOccName b)
+ (Nothing, Nothing) -> getOccName a `compare` getOccName b
+ _ -> LT
+
+instance Outputable OrdName where
+ ppr (MkOrdName x) = ppr (nameOccName x)
runRnFM :: LinkEnv -> RnM a -> (a,[Name])
runRnFM env rn = unRn rn lkp
where
lkp n = case Map.lookup (MkOrdName n) ordEnv of
Nothing -> (False, NoLink n)
- Just (MkOrdName q) -> (True, Link q)
+ Just q -> (True, Link q)
- ordEnv = Map.fromList . map (MkOrdName *** MkOrdName) . Map.toList $ env
+ ordEnv = Map.fromList . map (MkOrdName *** id) . Map.toList $ env
--------------------------------------------------------------------------------
--
GitLab