aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface/Rename.hs
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Interface/Rename.hs')
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs43
1 files changed, 31 insertions, 12 deletions
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 091d9bff..2478ce23 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE RecordWildCards #-}
----------------------------------------------------------------------------
-- |
-- Module : Haddock.Interface.Rename
@@ -12,7 +13,7 @@
module Haddock.Interface.Rename (renameInterface) where
-import Data.Traversable (traverse, Traversable)
+import Data.Traversable (mapM)
import Haddock.GhcUtils
import Haddock.Types
@@ -25,7 +26,6 @@ import Control.Applicative
import Control.Monad hiding (mapM)
import Data.List
import qualified Data.Map as Map hiding ( Map )
-import Data.Traversable (mapM)
import Prelude hiding (mapM)
@@ -287,16 +287,24 @@ renameWildCardInfo (AnonWildCard (L l name)) = AnonWildCard . L l <$> rename na
renameWildCardInfo (NamedWildCard (L l name)) = NamedWildCard . L l <$> rename name
renameInstHead :: InstHead Name -> RnM (InstHead DocName)
-renameInstHead (className, k, types, rest) = do
- className' <- rename className
- k' <- mapM renameType k
- types' <- mapM renameType types
- rest' <- case rest of
- ClassInst cs -> ClassInst <$> mapM renameType cs
+renameInstHead InstHead {..} = do
+ cname <- rename ihdClsName
+ kinds <- mapM renameType ihdKinds
+ types <- mapM renameType ihdTypes
+ itype <- case ihdInstType of
+ ClassInst { .. } -> ClassInst
+ <$> mapM renameType clsiCtx
+ <*> renameLHsQTyVars clsiTyVars
+ <*> mapM renameSig clsiSigs
+ <*> mapM renamePseudoFamilyDecl clsiAssocTys
TypeInst ts -> TypeInst <$> traverse renameType ts
DataInst dd -> DataInst <$> renameTyClD dd
- return (className', k', types', rest')
-
+ return InstHead
+ { ihdClsName = cname
+ , ihdKinds = kinds
+ , ihdTypes = types
+ , ihdInstType = itype
+ }
renameLDecl :: LHsDecl Name -> RnM (LHsDecl DocName)
renameLDecl (L loc d) = return . L loc =<< renameDecl d
@@ -375,6 +383,16 @@ renameFamilyDecl (FamilyDecl { fdInfo = info, fdLName = lname
, fdTyVars = ltyvars', fdResultSig = result'
, fdInjectivityAnn = injectivity' })
+
+renamePseudoFamilyDecl :: PseudoFamilyDecl Name
+ -> RnM (PseudoFamilyDecl DocName)
+renamePseudoFamilyDecl (PseudoFamilyDecl { .. }) = PseudoFamilyDecl
+ <$> renameFamilyInfo pfdInfo
+ <*> renameL pfdLName
+ <*> mapM renameLType pfdTyVars
+ <*> renameFamilyResultSig pfdKindSig
+
+
renameFamilyInfo :: FamilyInfo Name -> RnM (FamilyInfo DocName)
renameFamilyInfo DataFamily = return DataFamily
renameFamilyInfo OpenTypeFamily = return OpenTypeFamily
@@ -553,10 +571,11 @@ renameExportItem item = case item of
decl' <- renameLDecl decl
doc' <- renameDocForDecl doc
subs' <- mapM renameSub subs
- instances' <- forM instances $ \(inst, idoc) -> do
+ instances' <- forM instances $ \(inst, idoc, L l n) -> do
inst' <- renameInstHead inst
+ n' <- rename n
idoc' <- mapM renameDoc idoc
- return (inst', idoc')
+ return (inst', idoc',L l n')
fixities' <- forM fixities $ \(name, fixity) -> do
name' <- lookupRn name
return (name', fixity)