aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Backends')
-rw-r--r--src/Haddock/Backends/Hoogle.hs4
-rw-r--r--src/Haddock/Backends/Xhtml.hs6
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs65
-rw-r--r--src/Haddock/Backends/Xhtml/Utils.hs4
4 files changed, 38 insertions, 41 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index cbb5921d..e7a78fc2 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -101,7 +101,7 @@ out = f . unwords . map (dropWhile isSpace) . lines . showSDocUnqual . ppr
operator :: String -> String
-operator (x:xs) | not (isAlphaNum x) && x `notElem` "_' ([{" = "(" ++ x:xs ++ ")"
+operator (x:xs) | not (isAlphaNum x) && x `notElem` "_' ([{" = '(' : x:xs ++ ")"
operator x = x
@@ -124,7 +124,7 @@ ppExport _ = []
ppSig :: Sig Name -> [String]
ppSig (TypeSig names sig) = [operator prettyNames ++ " :: " ++ outHsType typ]
where
- prettyNames = concat . intersperse ", " $ map out names
+ prettyNames = intercalate ", " $ map out names
typ = case unL sig of
HsForAllTy Explicit a b c -> HsForAllTy Implicit a b c
x -> x
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index c8998f3e..84468610 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -431,7 +431,7 @@ ppHtmlIndex odir doctitle _maybe_package themes
indexLinks nm entries
many_entities ->
td ! [ theclass "src" ] << toHtml str <-> td << spaceHtml </>
- aboves (map doAnnotatedEntity (zip [1..] many_entities))
+ aboves (zipWith (curry doAnnotatedEntity) [1..] many_entities)
doAnnotatedEntity :: (Integer, (Name, [(Module, Bool)])) -> HtmlTable
doAnnotatedEntity (j,(nm,entries))
@@ -539,7 +539,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
maybe_doc_hdr
= case exports of
[] -> noHtml
- ExportGroup _ _ _ : _ -> noHtml
+ ExportGroup {} : _ -> noHtml
_ -> h1 << "Documentation"
bdy =
@@ -621,7 +621,7 @@ ppModuleContents qual exports
-- we need to assign a unique id to each section heading so we can hyperlink
-- them from the contents:
numberSectionHeadings :: [ExportItem DocName] -> [ExportItem DocName]
-numberSectionHeadings exports = go 1 exports
+numberSectionHeadings = go 1
where go :: Int -> [ExportItem DocName] -> [ExportItem DocName]
go _ [] = []
go n (ExportGroup lev _ doc : es)
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 9d7865f2..5cdc819c 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -79,7 +79,7 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
argDoc n = Map.lookup n argDocs
do_largs n leader (L _ t) = do_args n leader t
- do_args :: Int -> Html -> (HsType DocName) -> [SubDecl]
+ do_args :: Int -> Html -> HsType DocName -> [SubDecl]
do_args n leader (HsForAllTy Explicit tvs lctxt ltype)
= (leader <+>
hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]) <+>
@@ -99,7 +99,7 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
= (leader <+> ppLFunLhType unicode qual lt, argDoc n, [])
: do_largs (n+1) (arrow unicode) r
do_args n leader t
- = (leader <+> ppType unicode qual t, argDoc n, []) : []
+ = [(leader <+> ppType unicode qual t, argDoc n, [])]
ppTyVars :: [LHsTyVarBndr DocName] -> [Html]
@@ -296,12 +296,12 @@ ppLContextNoArrow = ppContextNoArrow . unLoc
ppContextNoArrow :: HsContext DocName -> Bool -> Qualification -> Html
ppContextNoArrow [] _ _ = noHtml
-ppContextNoArrow cxt unicode qual = pp_hs_context (map unLoc cxt) unicode qual
+ppContextNoArrow cxt unicode qual = ppHsContext (map unLoc cxt) unicode qual
ppContextNoLocs :: [HsType DocName] -> Bool -> Qualification -> Html
ppContextNoLocs [] _ _ = noHtml
-ppContextNoLocs cxt unicode qual = pp_hs_context cxt unicode qual
+ppContextNoLocs cxt unicode qual = ppHsContext cxt unicode qual
<+> darrow unicode
@@ -309,10 +309,10 @@ ppContext :: HsContext DocName -> Bool -> Qualification -> Html
ppContext cxt unicode qual = ppContextNoLocs (map unLoc cxt) unicode qual
-pp_hs_context :: [HsType DocName] -> Bool -> Qualification-> Html
-pp_hs_context [] _ _ = noHtml
-pp_hs_context [p] unicode qual = ppType unicode qual p
-pp_hs_context cxt unicode qual = parenList (map (ppType unicode qual) cxt)
+ppHsContext :: [HsType DocName] -> Bool -> Qualification-> Html
+ppHsContext [] _ _ = noHtml
+ppHsContext [p] unicode qual = ppType unicode qual p
+ppHsContext cxt unicode qual = parenList (map (ppType unicode qual) cxt)
-------------------------------------------------------------------------------
@@ -326,8 +326,8 @@ ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
ppClassHdr summ lctxt n tvs fds unicode qual =
keyword "class"
<+> (if not . null . unLoc $ lctxt then ppLContext lctxt unicode qual else noHtml)
- <+> ppAppDocNameNames summ n (tyvarNames $ tvs)
- <+> ppFds fds unicode qual
+ <+> ppAppDocNameNames summ n (tyvarNames tvs)
+ <+> ppFds fds unicode qual
ppFds :: [Located ([DocName], [DocName])] -> Bool -> Qualification -> Html
@@ -396,7 +396,7 @@ ppClassDecl summary links instances loc mbDoc subdocs
-- there are different subdocs for different names in a single
-- type signature?
- instancesBit = ppInstances instances nm unicode qual
+ instancesBit = ppInstances instances nm unicode qual
ppClassDecl _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
@@ -413,11 +413,8 @@ ppInstances instances baseName unicode qual
<+> ppAppNameTypes n ts unicode qual
-lookupAnySubdoc :: (Eq name1) =>
- name1 -> [(name1, DocForDecl name2)] -> DocForDecl name2
-lookupAnySubdoc n subdocs = case lookup n subdocs of
- Nothing -> noDocForDecl
- Just docs -> docs
+lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
+lookupAnySubdoc n = fromMaybe noDocForDecl . lookup n
-------------------------------------------------------------------------------
@@ -430,7 +427,7 @@ ppShortDataDecl :: Bool -> LinksInfo -> SrcSpan -> TyClDecl DocName -> Bool
-> Qualification -> Html
ppShortDataDecl summary _links _loc dataDecl unicode qual
- | [] <- cons = dataHeader
+ | [] <- cons = dataHeader
| [lcon] <- cons, ResTyH98 <- resTy,
(cHead,cBody,cFoot) <- ppShortConstrParts summary (unLoc lcon) unicode qual
@@ -513,7 +510,7 @@ ppShortConstrParts summary con unicode qual = case con_res con of
-- (except each field gets its own line in docs, to match
-- non-GADT records)
RecCon fields -> (ppBinder summary occ <+> dcolon unicode <+>
- ppForAll forall ltvs lcontext unicode qual <+> char '{',
+ ppForAll forall_ ltvs lcontext unicode qual <+> char '{',
doRecordFields fields,
char '}' <+> arrow unicode <+> ppLType unicode qual resTy)
InfixCon arg1 arg2 -> (doGADTCon [arg1, arg2] resTy, noHtml, noHtml)
@@ -521,29 +518,29 @@ ppShortConstrParts summary con unicode qual = case con_res con of
where
doRecordFields fields = shortSubDecls (map (ppShortField summary unicode qual) fields)
doGADTCon args resTy = ppBinder summary occ <+> dcolon unicode <+> hsep [
- ppForAll forall ltvs lcontext unicode qual,
+ ppForAll forall_ ltvs lcontext unicode qual,
ppLType unicode qual (foldr mkFunTy resTy args) ]
- header_ = ppConstrHdr forall tyVars context
+ header_ = ppConstrHdr forall_ tyVars context
occ = nameOccName . getName . unLoc . con_name $ con
ltvs = con_qvars con
tyVars = tyvarNames ltvs
lcontext = con_cxt con
context = unLoc (con_cxt con)
- forall = con_explicit con
+ forall_ = con_explicit con
mkFunTy a b = noLoc (HsFunTy a b)
-- ppConstrHdr is for (non-GADT) existentials constructors' syntax
ppConstrHdr :: HsExplicitFlag -> [Name] -> HsContext DocName -> Bool
-> Qualification -> Html
-ppConstrHdr forall tvs ctxt unicode qual
+ppConstrHdr forall_ tvs ctxt unicode qual
= (if null tvs then noHtml else ppForall)
+++
(if null ctxt then noHtml else ppContextNoArrow ctxt unicode qual
<+> darrow unicode +++ toHtml " ")
where
- ppForall = case forall of
+ ppForall = case forall_ of
Explicit -> forallSymbol unicode <+> hsep (map ppName tvs) <+> toHtml ". "
Implicit -> noHtml
@@ -581,15 +578,15 @@ ppSideBySideConstr subdocs unicode qual (L _ con) = (decl, mbDoc, fieldPart)
doGADTCon :: [LHsType DocName] -> Located (HsType DocName) -> Html
doGADTCon args resTy =
ppBinder False occ <+> dcolon unicode
- <+> hsep [ppForAll forall ltvs (con_cxt con) unicode qual,
+ <+> hsep [ppForAll forall_ ltvs (con_cxt con) unicode qual,
ppLType unicode qual (foldr mkFunTy resTy args) ]
- header_ = ppConstrHdr forall tyVars context
+ header_ = ppConstrHdr forall_ tyVars context
occ = nameOccName . getName . unLoc . con_name $ con
ltvs = con_qvars con
tyVars = tyvarNames (con_qvars con)
context = unLoc (con_cxt con)
- forall = con_explicit con
+ forall_ = con_explicit con
-- don't use "con_doc con", in case it's reconstructed from a .hi file,
-- or also because we want Haddock to do the doc-parsing, not GHC.
-- 'join' is in Maybe.
@@ -651,13 +648,13 @@ tupleParens _ = parenList
pREC_TOP, pREC_FUN, pREC_OP, pREC_CON :: Int
-pREC_TOP = (0 :: Int) -- type in ParseIface.y in GHC
-pREC_FUN = (1 :: Int) -- btype in ParseIface.y in GHC
- -- Used for LH arg of (->)
-pREC_OP = (2 :: Int) -- Used for arg of any infix operator
- -- (we don't keep their fixities around)
-pREC_CON = (3 :: Int) -- Used for arg of type applicn:
- -- always parenthesise unless atomic
+pREC_TOP = 0 :: Int -- type in ParseIface.y in GHC
+pREC_FUN = 1 :: Int -- btype in ParseIface.y in GHC
+ -- Used for LH arg of (->)
+pREC_OP = 2 :: Int -- Used for arg of any infix operator
+ -- (we don't keep their fixities around)
+pREC_CON = 3 :: Int -- Used for arg of type applicn:
+ -- always parenthesise unless atomic
maybeParen :: Int -- Precedence of context
-> Int -- Precedence of top-level operator
@@ -699,7 +696,7 @@ ppForAll expl tvs cxt unicode qual
ppr_mono_lty :: Int -> LHsType DocName -> Bool -> Qualification -> Html
-ppr_mono_lty ctxt_prec ty unicode qual = ppr_mono_ty ctxt_prec (unLoc ty) unicode qual
+ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
ppr_mono_ty :: Int -> HsType DocName -> Bool -> Qualification -> Html
diff --git a/src/Haddock/Backends/Xhtml/Utils.hs b/src/Haddock/Backends/Xhtml/Utils.hs
index c020c64d..be1fcb9b 100644
--- a/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/src/Haddock/Backends/Xhtml/Utils.hs
@@ -44,7 +44,7 @@ import Name ( getOccString, nameOccName, isValOcc )
spliceURL :: Maybe FilePath -> Maybe Module -> Maybe GHC.Name ->
Maybe SrcSpan -> String -> String
-spliceURL maybe_file maybe_mod maybe_name maybe_loc url = run url
+spliceURL maybe_file maybe_mod maybe_name maybe_loc = run
where
file = fromMaybe "" maybe_file
mdl = case maybe_mod of
@@ -72,7 +72,7 @@ spliceURL maybe_file maybe_mod maybe_name maybe_loc url = run url
run ('%':'N':rest) = name ++ run rest
run ('%':'K':rest) = kind ++ run rest
run ('%':'L':rest) = line ++ run rest
- run ('%':'%':rest) = "%" ++ run rest
+ run ('%':'%':rest) = '%' : run rest
run ('%':'{':'M':'O':'D':'U':'L':'E':'}':rest) = mdl ++ run rest
run ('%':'{':'F':'I':'L':'E':'}':rest) = file ++ run rest
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-21 11:37:17 +0000