aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2015-11-13 12:18:17 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2015-11-13 12:18:17 +0000
commit0d157fea7d1e4055abcb6453545f8bf326ce2279 (patch)
tree5ae49f42a15167bec798ad05bd22998cbbb1261b
parent0413c544b60c063ef286777d3008c4e33b4afbcd (diff)
parent83a9e9d2c7f0debec9d56e8b3b7cc8a8eb73361e (diff)
Merge with origin/head
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs9
-rw-r--r--haddock-api/src/Haddock/Convert.hs6
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs6
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs4
4 files changed, 13 insertions, 12 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index c523d610..dca16408 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -480,10 +480,10 @@ ppClassDecl summary links instances fixities loc d subdocs
-- there are different subdocs for different names in a single
-- type signature?
- minimalBit = case [ s | L _ (MinimalSig _ s) <- lsigs ] of
+ minimalBit = case [ s | L _ (MinimalSig _ (L _ s)) <- lsigs ] of
-- Miminal complete definition = every shown method
And xs : _ | sort [getName n | Var (L _ n) <- xs] ==
- sort [getName n | L _ (TypeSig ns _) <- lsigs, L _ n <- ns]
+ sort [getName n | L _ (TypeSig ns _ _) <- lsigs, L _ n <- ns]
-> noHtml
-- Minimal complete definition = the only shown method
@@ -498,9 +498,10 @@ ppClassDecl summary links instances fixities loc d subdocs
_ -> noHtml
ppMinimal _ (Var (L _ n)) = ppDocName qual Prefix True n
- ppMinimal _ (And fs) = foldr1 (\a b -> a+++", "+++b) $ map (ppMinimal True) fs
- ppMinimal p (Or fs) = wrap $ foldr1 (\a b -> a+++" | "+++b) $ map (ppMinimal False) fs
+ ppMinimal _ (And fs) = foldr1 (\a b -> a+++", "+++b) $ map (ppMinimal True . unLoc) fs
+ ppMinimal p (Or fs) = wrap $ foldr1 (\a b -> a+++" | "+++b) $ map (ppMinimal False . unLoc) fs
where wrap | p = parens | otherwise = id
+ ppMinimal p (Parens x) = ppMinimal p (unLoc x)
instancesBit = ppInstances instances nm unicode qual
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 38851b16..ce71cf86 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -78,7 +78,7 @@ tyThingToLHsDecl t = case t of
, tcdFDs = map (\ (l,r) -> noLoc
(map (noLoc . getName) l, map (noLoc . getName) r) ) $
snd $ classTvsFds cl
- , tcdSigs = noLoc (MinimalSig mempty . fmap noLoc $ classMinimalDef cl) :
+ , tcdSigs = noLoc (MinimalSig mempty . noLoc . fmap noLoc $ classMinimalDef cl) :
map (noLoc . synifyIdSig DeleteTopLevelQuantification)
(classMethods cl)
, tcdMeths = emptyBag --ignore default method definitions, they don't affect signature
@@ -304,9 +304,7 @@ synifyDataCon use_gadt_syntax dc =
, con_cxt = ctx
, con_details = hat
, con_res = hs_res_ty
- , con_doc = Nothing
- -- we don't want any "deprecated GADT syntax" warnings!
- , con_old_rec = False }
+ , con_doc = Nothing }
synifyName :: NamedThing n => n -> Located Name
synifyName = noLoc . getName
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index d53e7351..f7eb5a82 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -501,7 +501,7 @@ mkExportItems
lookupExport (IEVar (L _ x)) = declWith x
lookupExport (IEThingAbs (L _ t)) = declWith t
lookupExport (IEThingAll (L _ t)) = declWith t
- lookupExport (IEThingWith (L _ t) _ _) = declWith t
+ lookupExport (IEThingWith (L _ t) _ _ _) = declWith t
lookupExport (IEModuleContents (L _ m)) =
moduleExports thisMod m dflags warnings gre exportedNames decls modMap instIfaceMap maps fixMap splices
lookupExport (IEGroup lev docStr) = return $
@@ -556,7 +556,7 @@ mkExportItems
L loc (TyClD cl@ClassDecl{}) -> do
mdef <- liftGhcToErrMsgGhc $ minimalDef t
- let sig = maybeToList $ fmap (noLoc . MinimalSig mempty . fmap noLoc) mdef
+ let sig = maybeToList $ fmap (noLoc . MinimalSig mempty . noLoc . fmap noLoc) mdef
return [ mkExportDecl t
(L loc $ TyClD cl { tcdSigs = sig ++ tcdSigs cl }) docs_ ]
@@ -748,7 +748,7 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap
return $ Just (ExportDecl decl doc subs [] (fixities name subs) (l `elem` splices))
mkExportItem (L l (TyClD cl@ClassDecl{ tcdLName = L _ name, tcdSigs = sigs })) = do
mdef <- liftGhcToErrMsgGhc $ minimalDef name
- let sig = maybeToList $ fmap (noLoc . MinimalSig mempty . fmap noLoc) mdef
+ let sig = maybeToList $ fmap (noLoc . MinimalSig mempty . noLoc . fmap noLoc) mdef
expDecl (L l (TyClD cl { tcdSigs = sig ++ sigs })) l name
mkExportItem decl@(L l d)
| name:_ <- getMainDeclBinder d = expDecl decl l name
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index f95e527e..3640d348 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -444,7 +444,9 @@ renameSig sig = case sig of
FixSig (FixitySig lnames fixity) -> do
lnames' <- mapM renameL lnames
return $ FixSig (FixitySig lnames' fixity)
- MinimalSig src s -> MinimalSig src <$> traverse renameL s
+ MinimalSig src (L l s) -> do
+ s' <- traverse renameL s
+ return $ MinimalSig src (L l s')
-- we have filtered out all other kinds of signatures in Interface.Create
_ -> error "expected TypeSig"