diff options
author | Ćukasz Hanuszczak <lukasz.hanuszczak@gmail.com> | 2015-07-29 15:37:48 +0200 |
---|---|---|
committer | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2015-08-21 18:22:32 +0100 |
commit | 3073526a26d013e8751068fbd526974dcfb8259f (patch) | |
tree | a51705bccd9f443e7d37b115036d558e5503dbe9 /haddock-api/src | |
parent | de395700afa73065a2ec69ba5e3cc3ec1a474d11 (diff) |
Make instance details record use new type for family declarations.
Diffstat (limited to 'haddock-api/src')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 23 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 2 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/Rename.hs | 12 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Types.hs | 2 |
4 files changed, 24 insertions, 15 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 4b28e4ff..eb4524c2 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -291,6 +291,14 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode <+> equals <+> ppType unicode qual (unLoc rhs) , Nothing, [] ) + + +ppPseudoFamilyDecl :: LinksInfo -> Splice -> Unicode -> Qualification + -> PseudoFamilyDecl DocName + -> Html +ppPseudoFamilyDecl = undefined + + -------------------------------------------------------------------------------- -- * Associated Types -------------------------------------------------------------------------------- @@ -302,15 +310,6 @@ ppAssocType summ links doc (L loc decl) fixities splice unicode qual = ppTyFam summ True links [] fixities loc (fst doc) decl splice unicode qual -ppSimpleAssocTy :: LinksInfo -> Splice -> Unicode -> Qualification - -> FamilyDecl DocName - -> Html -ppSimpleAssocTy links splice unicode qual decl = - ppAssocType False links noDocForDecl ldecl [] splice unicode qual - where - ldecl = L (getLoc $ fdLName decl) decl - - -------------------------------------------------------------------------------- -- * TyClDecl helpers -------------------------------------------------------------------------------- @@ -574,12 +573,12 @@ ppInstHead links splice unicode qual mdoc origin no (InstHead {..}) = ppInstanceAssocTys :: LinksInfo -> Splice -> Unicode -> Qualification - -> [FamilyDecl DocName] + -> [PseudoFamilyDecl DocName] -> [Html] ppInstanceAssocTys links splice unicode qual = - map ppSimpleAssocTy' + map ppFamilyDecl' where - ppSimpleAssocTy' = ppSimpleAssocTy links splice unicode qual + ppFamilyDecl' = ppPseudoFamilyDecl links splice unicode qual ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index a2716d92..095bd9e0 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -400,7 +400,7 @@ synifyInstHead (_, preds, cls, types) = InstHead , clsiSigs = map synifyClsIdSig $ classMethods cls , clsiAssocTys = do (Right (FamDecl fam)) <- map (synifyTyCon Nothing) $ classATs cls - pure fam + pure $ mkPseudoFamilyDecl fam } } where diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index 82d14a2c..146a7c0b 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -268,7 +268,7 @@ renameInstHead InstHead {..} = do <$> mapM renameType clsiCtx <*> renameLTyVarBndrs clsiTyVars <*> mapM renameSig clsiSigs - <*> mapM renameFamilyDecl clsiAssocTys + <*> mapM renamePseudoFamilyDecl clsiAssocTys TypeInst ts -> TypeInst <$> traverse renameType ts DataInst dd -> DataInst <$> renameTyClD dd return InstHead @@ -352,6 +352,16 @@ renameFamilyDecl (FamilyDecl { fdInfo = info, fdLName = lname return (FamilyDecl { fdInfo = info', fdLName = lname' , fdTyVars = ltyvars', fdKindSig = tckind' }) + +renamePseudoFamilyDecl :: PseudoFamilyDecl Name + -> RnM (PseudoFamilyDecl DocName) +renamePseudoFamilyDecl (PseudoFamilyDecl { .. }) = PseudoFamilyDecl + <$> renameFamilyInfo pfdInfo + <*> renameL pfdLName + <*> mapM renameLType pfdTyVars + <*> renameMaybeLKind pfdKindSig + + renameFamilyInfo :: FamilyInfo Name -> RnM (FamilyInfo DocName) renameFamilyInfo DataFamily = return DataFamily renameFamilyInfo OpenTypeFamily = return OpenTypeFamily diff --git a/haddock-api/src/Haddock/Types.hs b/haddock-api/src/Haddock/Types.hs index 90672c9d..1f074ac3 100644 --- a/haddock-api/src/Haddock/Types.hs +++ b/haddock-api/src/Haddock/Types.hs @@ -328,7 +328,7 @@ data InstType name { clsiCtx :: [HsType name] , clsiTyVars :: LHsTyVarBndrs name , clsiSigs :: [Sig name] - , clsiAssocTys :: [FamilyDecl name] + , clsiAssocTys :: [PseudoFamilyDecl name] } | TypeInst (Maybe (HsType name)) -- ^ Body (right-hand side) | DataInst (TyClDecl name) -- ^ Data constructors |