Tue Nov 28 11:34:36 UTC 2017

Repository : ssh://git@git.haskell.org/haddock

On branches: 2.17.3.1-spanfix,alexbiehl-patch-1,ghc-8.0,ghc-8.0-facebook,ghc-head,ghc-head1,haddock-quick,headdock-library-1.4.5,ie_avails,issue-303,issue-475,master,pr-filter-maps,pr/cabal-desc,travis,v2.16,v2.17,v2.17.3,v2.18,wip-located-module-as,wip/D2418,wip/T11080-open-data-kinds,wip/T11258,wip/T11430,wip/T12105,wip/T12105-2,wip/T12942,wip/T13163,wip/T14529,wip/T3384,wip/embelleshed-rdr,wip/new-tree-one-param,wip/rae,wip/remove-frames,wip/remove-frames1,wip/revert-ttg-2017-11-20,wip/ttg-2017-10-13,wip/ttg-2017-10-31,wip/ttg-2017-11-06,wip/ttg2-2017-11-10,wip/ttg3-2017-11-12,wip/ttg4-constraints-2017-11-13,wip/ttg6-unrevert-2017-11-22
Link       : http://git.haskell.org/haddock.git/commitdiff/4b352b94f07436d45dfcce8070c2f8301218b9ac

>---------------------------------------------------------------

commit 4b352b94f07436d45dfcce8070c2f8301218b9ac
Author: Łukasz Hanuszczak <lukasz.hanuszczak at gmail.com>
Date:   Sat Jul 18 19:05:46 2015 +0200

    Change state of the type renaming monad.


>---------------------------------------------------------------

4b352b94f07436d45dfcce8070c2f8301218b9ac
 .../src/Haddock/Backends/Xhtml/Specialize.hs       | 30 ++++++++++++----------
 1 file changed, 16 insertions(+), 14 deletions(-)

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs
index a7b7a56..d2a51fa 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs
@@ -100,14 +100,14 @@ parseTupleArity ('(':commas) = do
 parseTupleArity _ = Nothing
 
 
-rename :: Ord name => HsType name -> HsType name
+rename :: NamedThing name => HsType name -> HsType name
 rename = fst . evalRWS undefined Map.empty . renameType -- TODO.
 
 
-type Rename name a = RWS (Set name) () (Map name name) a
+type Rename name a = RWS (Set OccName) () (Map Name name) a
 
 
-renameType :: Ord name => HsType name -> Rename name (HsType name)
+renameType :: NamedThing name => HsType name -> Rename name (HsType name)
 renameType (HsForAllTy ex mspan lbndrs lctx lt) = do
     lbndrs' <- renameLTyVarBndrs lbndrs
     HsForAllTy
@@ -144,52 +144,54 @@ renameType HsWildcardTy = pure HsWildcardTy
 renameType (HsNamedWildcardTy name) = HsNamedWildcardTy <$> renameName name
 
 
-renameLType :: Ord name => LHsType name -> Rename name (LHsType name)
+renameLType :: NamedThing name => LHsType name -> Rename name (LHsType name)
 renameLType = located renameType
 
 
-renameLTypes :: Ord name => [LHsType name] -> Rename name [LHsType name]
+renameLTypes :: NamedThing name => [LHsType name] -> Rename name [LHsType name]
 renameLTypes = mapM renameLType
 
 
-renameContext :: Ord name => HsContext name -> Rename name (HsContext name)
+renameContext :: NamedThing name => HsContext name
+              -> Rename name (HsContext name)
 renameContext = renameLTypes
 
 
-renameLTyVarBndrs :: Ord name => LHsTyVarBndrs name -> Rename name (LHsTyVarBndrs name)
+renameLTyVarBndrs :: NamedThing name => LHsTyVarBndrs name -> Rename name (LHsTyVarBndrs name)
 renameLTyVarBndrs lbndrs = do
     tys' <- mapM (located renameTyVarBndr) $ hsq_tvs lbndrs
     pure $ lbndrs { hsq_tvs = tys' }
 
 
-renameTyVarBndr :: Ord name => HsTyVarBndr name -> Rename name (HsTyVarBndr name)
+renameTyVarBndr :: NamedThing name => HsTyVarBndr name
+                -> Rename name (HsTyVarBndr name)
 renameTyVarBndr (UserTyVar name) =
     UserTyVar <$> renameNameBndr name
 renameTyVarBndr (KindedTyVar name kinds) =
     KindedTyVar <$> located renameNameBndr name <*> pure kinds
 
 
-renameLTyOp :: Ord name => LHsTyOp name -> Rename name (LHsTyOp name)
+renameLTyOp :: NamedThing name => LHsTyOp name -> Rename name (LHsTyOp name)
 renameLTyOp (wrap, lname) = (,) wrap <$> located renameName lname
 
 
-renameNameBndr :: Ord name => name -> Rename name name
+renameNameBndr :: NamedThing name => name -> Rename name name
 renameNameBndr name = do
     fv <- ask
-    when (name `Set.member` fv) $
+    when (getOccName name `Set.member` fv) $
         freshName name
     renameName name
 
 
-renameName :: Ord name => name -> Rename name name
+renameName :: NamedThing name => name -> Rename name name
 renameName name = do
     rnmap <- get
-    pure $ case Map.lookup name rnmap of
+    pure $ case Map.lookup (getName name) rnmap of
         Just name' -> name'
         Nothing -> name
 
 
-freshName :: Ord name => name -> Rename name ()
+freshName :: NamedThing name => name -> Rename name ()
 freshName _ = pure () -- TODO.
 
 

