From f6e5d57bee5a7bf5d74d26982db64fa8a56f17bd Mon Sep 17 00:00:00 2001 From: Sebastian Meric de Bellefon Date: Sun, 15 May 2016 01:12:28 -0400 Subject: Fix #280. Parsing of module header The initial newlines were counted as indentation spaces, thus disturbing the parsing of next lines --- haddock-api/src/Haddock/Interface/ParseModuleHeader.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'haddock-api/src/Haddock/Interface') diff --git a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs index e7d2a085..768a31ce 100644 --- a/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs +++ b/haddock-api/src/Haddock/Interface/ParseModuleHeader.hs @@ -76,7 +76,7 @@ parseKey :: String -> String -> Maybe (String,String) parseKey key toParse0 = do let - (spaces0,toParse1) = extractLeadingSpaces toParse0 + (spaces0,toParse1) = extractLeadingSpaces (dropWhile (`elem` ['\r', '\n']) toParse0) indentation = spaces0 afterKey0 <- extractPrefix key toParse1 -- cgit v1.2.3 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 From 4202f96a37c9786708bd0410631bc1cf7a82d76a Mon Sep 17 00:00:00 2001 From: alexbiehl Date: Thu, 26 May 2016 12:43:09 +0200 Subject: Remove misplaced haddock comment --- haddock-api/src/Haddock/Interface/Create.hs | 2 +- 1 file changed, 1 insertion(+), 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 e0b52cb5..cb855693 100644 --- a/haddock-api/src/Haddock/Interface/Create.hs +++ b/haddock-api/src/Haddock/Interface/Create.hs @@ -832,7 +832,7 @@ extractRecSel nm mdl t tvs (L _ con : rest) = matching_fields flds = [ (l,f) | f@(L _ (ConDeclField ns _ _)) <- flds , L l n <- ns, selectorFieldOcc n == nm ] data_ty - -- | ResTyGADT _ ty <- con_res con = ty + -- ResTyGADT _ ty <- con_res con = ty | ConDeclGADT{} <- con = hsib_body $ con_type con | otherwise = foldl' (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar (noLoc t))) tvs -- cgit v1.2.3