aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs6
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs22
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs26
3 files changed, 27 insertions, 27 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index dd10bb0a..fe656a4b 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -145,7 +145,7 @@ ppClass dflags x = out dflags x{tcdSigs=[]} :
concatMap (ppSig dflags . addContext . unL) (tcdSigs x)
where
addContext (TypeSig name (L l sig) nwcs) = TypeSig name (L l $ f sig) nwcs
- addContext (MinimalSig sig) = MinimalSig sig
+ addContext (MinimalSig src sig) = MinimalSig src sig
addContext _ = error "expected TypeSig"
f (HsForAllTy a b c con d) = HsForAllTy a b c (reL (context : unLoc con)) d
@@ -189,7 +189,7 @@ ppCtor dflags dat subdocs con
where
f (PrefixCon args) = [typeSig name $ args ++ [resType]]
f (InfixCon a1 a2) = f $ PrefixCon [a1,a2]
- f (RecCon recs) = f (PrefixCon $ map cd_fld_type (map unLoc recs)) ++ concat
+ f (RecCon (L _ recs)) = f (PrefixCon $ map cd_fld_type (map unLoc recs)) ++ concat
[(concatMap (lookupCon dflags subdocs) (cd_fld_names r)) ++
[out dflags (map unL $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]]
| r <- map unLoc recs]
@@ -203,7 +203,7 @@ ppCtor dflags dat subdocs con
resType = case con_res con of
ResTyH98 -> apps $ map (reL . HsTyVar) $
(tcdName dat) : [hsTyVarName v | L _ v@(UserTyVar _) <- hsQTvBndrs $ tyClDeclTyVars dat]
- ResTyGADT x -> x
+ ResTyGADT _ x -> x
---------------------------------------------------------------------
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index ee5bc861..125e1b3a 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -477,7 +477,7 @@ rDoc = maybeDoc . fmap latexStripTrailingWhitespace
ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
- -> LHsTyVarBndrs DocName -> [Located ([DocName], [DocName])]
+ -> LHsTyVarBndrs DocName -> [Located ([Located DocName], [Located DocName])]
-> Bool -> LaTeX
ppClassHdr summ lctxt n tvs fds unicode =
keyword "class"
@@ -486,13 +486,13 @@ ppClassHdr summ lctxt n tvs fds unicode =
<+> ppFds fds unicode
-ppFds :: [Located ([DocName], [DocName])] -> Bool -> LaTeX
+ppFds :: [Located ([Located DocName], [Located DocName])] -> Bool -> LaTeX
ppFds fds unicode =
if null fds then empty else
char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds))
where
- fundep (vars1,vars2) = hsep (map ppDocName vars1) <+> arrow unicode <+>
- hsep (map ppDocName vars2)
+ fundep (vars1,vars2) = hsep (map (ppDocName . unLoc) vars1) <+> arrow unicode <+>
+ hsep (map (ppDocName . unLoc) vars2)
ppClassDecl :: [DocInstance DocName] -> SrcSpan
@@ -598,8 +598,8 @@ ppDataDecl instances subdocs _loc doc dataDecl unicode
(whereBit, leaders)
| null cons = (empty,[])
| otherwise = case resTy of
- ResTyGADT _ -> (decltt (keyword "where"), repeat empty)
- _ -> (empty, (decltt (text "=") : repeat (decltt (text "|"))))
+ ResTyGADT _ _ -> (decltt (keyword "where"), repeat empty)
+ _ -> (empty, (decltt (text "=") : repeat (decltt (text "|"))))
constrBit
| null cons = Nothing
@@ -636,7 +636,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
map (ppLParendType unicode) args))
<-> rDoc mbDoc <+> nl
- RecCon fields ->
+ RecCon (L _ fields) ->
(decltt (header_ unicode <+> ppOcc)
<-> rDoc mbDoc <+> nl)
$$
@@ -648,11 +648,11 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
ppLParendType unicode arg2 ])
<-> rDoc mbDoc <+> nl
- ResTyGADT resTy -> case con_details con of
+ ResTyGADT _ resTy -> case con_details con of
-- prefix & infix could also use hsConDeclArgTys if it seemed to
-- simplify the code.
PrefixCon args -> doGADTCon args resTy
- cd@(RecCon fields) -> doGADTCon (hsConDeclArgTys cd) resTy <+> nl $$
+ cd@(RecCon (L _ fields)) -> doGADTCon (hsConDeclArgTys cd) resTy <+> nl $$
doRecordFields fields
InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
@@ -948,8 +948,8 @@ ppr_mono_ty _ (HsTyLit t) u = ppr_tylit t u
ppr_tylit :: HsTyLit -> Bool -> LaTeX
-ppr_tylit (HsNumTy n) _ = integer n
-ppr_tylit (HsStrTy s) _ = text (show s)
+ppr_tylit (HsNumTy _ n) _ = integer n
+ppr_tylit (HsStrTy _ s) _ = text (show s)
-- XXX: Ok in verbatim, but not otherwise
-- XXX: Do something with Unicode parameter?
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index d24a3f04..405a13f8 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -145,7 +145,7 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
ppForAll :: LHsTyVarBndrs DocName -> Unicode -> Qualification -> Html
ppForAll tvs unicode qual =
- case [ppKTv n k | L _ (KindedTyVar n k) <- hsQTvBndrs tvs] of
+ case [ppKTv n k | L _ (KindedTyVar (L _ n) k) <- hsQTvBndrs tvs] of
[] -> noHtml
ts -> forallSymbol unicode <+> hsep ts +++ dot
where ppKTv n k = parens $
@@ -380,7 +380,7 @@ ppHsContext cxt unicode qual = parenList (map (ppType unicode qual) cxt)
ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
- -> LHsTyVarBndrs DocName -> [Located ([DocName], [DocName])]
+ -> LHsTyVarBndrs DocName -> [Located ([Located DocName], [Located DocName])]
-> Unicode -> Qualification -> Html
ppClassHdr summ lctxt n tvs fds unicode qual =
keyword "class"
@@ -389,13 +389,13 @@ ppClassHdr summ lctxt n tvs fds unicode qual =
<+> ppFds fds unicode qual
-ppFds :: [Located ([DocName], [DocName])] -> Unicode -> Qualification -> Html
+ppFds :: [Located ([Located DocName], [Located DocName])] -> Unicode -> Qualification -> Html
ppFds fds unicode qual =
if null fds then noHtml else
char '|' <+> hsep (punctuate comma (map (fundep . unLoc) fds))
where
fundep (vars1,vars2) = ppVars vars1 <+> arrow unicode <+> ppVars vars2
- ppVars = hsep . map (ppDocName qual Prefix True)
+ ppVars = hsep . map ((ppDocName qual Prefix True) . unLoc)
ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan
-> [(DocName, DocForDecl DocName)]
@@ -469,7 +469,7 @@ 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 _ 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]
@@ -572,7 +572,7 @@ ppDataDecl summary links instances fixities subdocs loc doc dataDecl
whereBit
| null cons = noHtml
| otherwise = case resTy of
- ResTyGADT _ -> keyword "where"
+ ResTyGADT _ _ -> keyword "where"
_ -> noHtml
constrBit = subConstructors qual
@@ -600,7 +600,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con_res con of
PrefixCon args ->
(header_ unicode qual +++ hsep (ppOcc
: map (ppLParendType unicode qual) args), noHtml, noHtml)
- RecCon fields ->
+ RecCon (L _ fields) ->
(header_ unicode qual +++ ppOcc <+> char '{',
doRecordFields fields,
char '}')
@@ -609,7 +609,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con_res con of
ppOccInfix, ppLParendType unicode qual arg2],
noHtml, noHtml)
- ResTyGADT resTy -> case con_details con of
+ ResTyGADT _ resTy -> case con_details con of
-- prefix & infix could use hsConDeclArgTys if it seemed to
-- simplify the code.
PrefixCon args -> (doGADTCon args resTy, noHtml, noHtml)
@@ -617,7 +617,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con_res con of
-- Constr :: (Context) => { field :: a, field2 :: b } -> Ty (a, b)
-- (except each field gets its own line in docs, to match
-- non-GADT records)
- RecCon fields -> (ppOcc <+> dcolon unicode <+>
+ RecCon (L _ fields) -> (ppOcc <+> dcolon unicode <+>
ppForAllCon forall_ ltvs lcontext unicode qual <+> char '{',
doRecordFields fields,
char '}' <+> arrow unicode <+> ppLType unicode qual resTy)
@@ -682,7 +682,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, field
ppLParendType unicode qual arg2]
<+> fixity
- ResTyGADT resTy -> case con_details con of
+ ResTyGADT _ resTy -> case con_details con of
-- prefix & infix could also use hsConDeclArgTys if it seemed to
-- simplify the code.
PrefixCon args -> doGADTCon args resTy
@@ -690,7 +690,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, field
InfixCon arg1 arg2 -> doGADTCon [arg1, arg2] resTy
fieldPart = case con_details con of
- RecCon fields -> [doRecordFields fields]
+ RecCon (L _ fields) -> [doRecordFields fields]
_ -> []
doRecordFields fields = subFields qual
@@ -907,8 +907,8 @@ ppr_mono_ty _ (HsNamedWildcardTy name) _ q = ppDocName q Prefix True name
ppr_mono_ty _ (HsTyLit n) _ _ = ppr_tylit n
ppr_tylit :: HsTyLit -> Html
-ppr_tylit (HsNumTy n) = toHtml (show n)
-ppr_tylit (HsStrTy s) = toHtml (show s)
+ppr_tylit (HsNumTy _ n) = toHtml (show n)
+ppr_tylit (HsStrTy _ s) = toHtml (show s)
ppr_fun_ty :: Int -> LHsType DocName -> LHsType DocName -> Unicode -> Qualification -> Html
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-26 16:42:39 +0000