aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Rename.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Rename.hs')
-rw-r--r--src/Haddock/Rename.hs20
1 files changed, 15 insertions, 5 deletions
diff --git a/src/Haddock/Rename.hs b/src/Haddock/Rename.hs
index 6ba07215..5ac711cb 100644
--- a/src/Haddock/Rename.hs
+++ b/src/Haddock/Rename.hs
@@ -12,6 +12,7 @@ module Haddock.Rename (
import Haddock.Types
import GHC hiding ( NoLink )
+import Name
import BasicTypes
import SrcLoc
import Bag ( emptyBag )
@@ -20,6 +21,7 @@ import Data.Map ( Map )
import qualified Data.Map as Map hiding ( Map )
import Prelude hiding ( mapM )
import Data.Traversable ( mapM )
+import Control.Arrow
-- -----------------------------------------------------------------------------
-- Monad for renaming
@@ -58,14 +60,22 @@ lookupRn and_then name = do
(False,maps_to) -> do outRn name; return (and_then maps_to)
(True, maps_to) -> return (and_then maps_to)
+newtype OrdName = MkOrdName Name
+
+instance Eq OrdName where
+ (MkOrdName a) == (MkOrdName b) = a == b
+
+instance Ord OrdName where
+ (MkOrdName a) `compare` (MkOrdName b) = nameOccName a `compare` nameOccName b
+
runRnFM :: Map Name Name -> RnM a -> (a,[Name])
runRnFM env rn = unRn rn lkp
- where lkp n = case Map.lookup n env of
- Nothing -> (False, NoLink n)
- Just q -> (True, Link q)
+ where
+ lkp n = case Map.lookup (MkOrdName n) ordEnv of
+ Nothing -> (False, NoLink n)
+ Just (MkOrdName q) -> (True, Link q)
-runRn :: (n -> (Bool,DocName)) -> GenRnM n a -> (a,[n])
-runRn lkp rn = unRn rn lkp
+ ordEnv = Map.fromList . map (MkOrdName *** MkOrdName) . Map.toList $ env
-- -----------------------------------------------------------------------------
-- Renaming