diff options
Diffstat (limited to 'haddock-api/src/Haddock/Interface/Rename.hs')
-rw-r--r-- | haddock-api/src/Haddock/Interface/Rename.hs | 43 |
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) |