From 8b423693647f0749b61b01d5bd41430b1dbb623e Mon Sep 17 00:00:00 2001 From: David Waern Date: Sun, 21 Oct 2007 14:35:49 +0000 Subject: 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 f22f9a2c..9f8399e2 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 -------------------------------------------------------------------------------- -- cgit v1.2.3