diff options
Diffstat (limited to 'haddock-api/src/Haddock')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs | 30 | 
1 files 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 a7b7a561..d2a51fac 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. | 
