diff options
| author | Alexander Biehl <alexbiehl@gmail.com> | 2018-01-19 15:33:30 +0100 |
|---|---|---|
| committer | Alexander Biehl <abiehl@novomind.com> | 2018-01-19 15:34:40 +0100 |
| commit | 107ef5a33b0d33063b4b709582ca081916b46098 (patch) | |
| tree | b4e07ae9b6c7b083baf9aa99de79c08803236414 /haddock-api/src/Haddock/Interface | |
| parent | 48ee5587b574105a231072999b06aa56c37292c4 (diff) | |
extractDecl: Extract associated types correctly (#736)
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 32 |
1 files changed, 21 insertions, 11 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index f673e23b..bd990170 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -1014,21 +1014,31 @@ extractDecl name decl | otherwise = case unLoc decl of TyClD d@ClassDecl {} -> - let matches = [ lsig - | lsig <- tcdSigs d - , ClassOpSig False _ _ <- pure $ unLoc lsig - -- Note: exclude `default` declarations (see #505) - , name `elem` sigName lsig - ] + let + matchesMethod = + [ lsig + | lsig <- tcdSigs d + , ClassOpSig False _ _ <- pure $ unLoc lsig + -- Note: exclude `default` declarations (see #505) + , name `elem` sigName lsig + ] + + matchesAssociatedType = + [ lfam_decl + | lfam_decl <- tcdATs d + , name == unLoc (fdLName (unLoc lfam_decl)) + ] + -- TODO: document fixity - in case matches of - [s0] -> let (n, tyvar_names) = (tcdName d, tyClDeclTyVars d) - L pos sig = addClassContext n tyvar_names s0 - in L pos (SigD sig) + in case (matchesMethod, matchesAssociatedType) of + ([s0], _) -> let (n, tyvar_names) = (tcdName d, tyClDeclTyVars d) + L pos sig = addClassContext n tyvar_names s0 + in L pos (SigD sig) + (_, [L pos fam_decl]) -> L pos (TyClD (FamDecl fam_decl)) _ -> O.pprPanic "extractDecl" (O.text "Ambiguous decl for" O.<+> O.ppr name O.<+> O.text "in class:" O.$$ O.nest 4 (O.ppr d) O.$$ O.text "Matches:" - O.$$ O.nest 4 (O.ppr matches)) + O.$$ O.nest 4 (O.ppr matchesMethod O.<+> O.ppr matchesAssociatedType)) TyClD d@DataDecl {} -> let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d)) in if isDataConName name |