From ebd41f6eb98fdbd43e25fdd574271de9159cde11 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Sun, 22 May 2016 12:31:50 +0200 Subject: Create: Remove redundant imports --- haddock-api/src/Haddock/Interface/Create.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'haddock-api/src/Haddock/Interface') diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 007038cb..a351c0dc 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -36,7 +36,6 @@ import Control.Arrow (second) import Control.DeepSeq import Control.Monad import Data.Function (on) -import qualified Data.Foldable as F import qualified Packages import qualified Module @@ -50,7 +49,7 @@ import TcRnTypes import FastString (concatFS) import BasicTypes ( StringLiteral(..) ) import qualified Outputable as O -import HsDecls ( gadtDeclDetails,getConDetails ) +import HsDecls ( getConDetails ) -- | Use a 'TypecheckedModule' to produce an 'Interface'. -- To do this, we need access to already processed modules in the topological -- cgit v1.2.3 From c03dad1c5d4ab7c44234d145ba9c13f17a918201 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Sun, 22 May 2016 12:32:02 +0200 Subject: Create: Better debug output For tracking down #505 --- haddock-api/src/Haddock/Interface/Create.hs | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'haddock-api/src/Haddock/Interface') diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index a351c0dc..8d561d68 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -789,7 +789,10 @@ extractDecl name mdl decl [s0] -> let (n, tyvar_names) = (tcdName d, tyClDeclTyVars d) L pos sig = addClassContext n tyvar_names s0 in L pos (SigD sig) - _ -> error "internal: extractDecl (ClassDecl)" + _ -> 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)) TyClD d@DataDecl {} -> let (n, tyvar_tys) = (tcdName d, lHsQTyVarsToTypes (tyClDeclTyVars d)) in SigD <$> extractRecSel name mdl n tyvar_tys (dd_cons (tcdDataDefn d)) -- cgit v1.2.3 From 6193f6d07f380436048928182ef511f167909a53 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Sun, 22 May 2016 12:42:23 +0200 Subject: Don't consider default class ops when looking for decls When we are looking for an operation within a class we don't care about `default`-type declarations. This was the cause of #505. --- haddock-api/src/Haddock/Interface/Create.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'haddock-api/src/Haddock/Interface') diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs index 8d561d68..e0b52cb5 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -783,8 +783,13 @@ extractDecl name mdl decl | otherwise = case unLoc decl of TyClD d@ClassDecl {} -> - let matches = [ sig | sig <- tcdSigs d, name `elem` sigName sig, - isTypeLSig sig ] -- TODO: document fixity + let matches = [ lsig + | lsig <- tcdSigs d + , ClassOpSig False _ _ <- pure $ unLoc lsig + -- Note: exclude `default` declarations (see #505) + , name `elem` sigName lsig + ] + -- TODO: document fixity in case matches of [s0] -> let (n, tyvar_names) = (tcdName d, tyClDeclTyVars d) L pos sig = addClassContext n tyvar_names s0 -- cgit v1.2.3