aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Interface
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Interface')
-rw-r--r--src/Haddock/Interface/Create.hs24
-rw-r--r--src/Haddock/Interface/ParseModuleHeader.hs6
-rw-r--r--src/Haddock/Interface/Rename.hs20
3 files changed, 27 insertions, 23 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 737547fd..ed51734d 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -350,7 +350,7 @@ warnAboutFilteredDecls mdl decls = do
tell [
"Warning: " ++ modStr ++ ": Instances of type and data "
++ "families are not yet supported. Instances of the following families "
- ++ "will be filtered out:\n " ++ concat (intersperse ", "
+ ++ "will be filtered out:\n " ++ (intercalate ", "
$ map (occNameString . nameOccName) typeInstances) ]
let instances = nub [ pretty i | L _ (InstD (InstDecl i _ _ ats)) <- decls
@@ -359,7 +359,7 @@ warnAboutFilteredDecls mdl decls = do
unless (null instances) $
tell [
"Warning: " ++ modStr ++ ": We do not support associated types in instances yet. "
- ++ "These instances are affected:\n" ++ concat (intersperse ", " instances) ]
+ ++ "These instances are affected:\n" ++ intercalate ", " instances ]
--------------------------------------------------------------------------------
@@ -371,7 +371,7 @@ warnAboutFilteredDecls mdl decls = do
-- | Filter out declarations that we don't handle in Haddock
filterDecls :: [(LHsDecl a, doc)] -> [(LHsDecl a, doc)]
-filterDecls decls = filter (isHandled . unL . fst) decls
+filterDecls = filter (isHandled . unL . fst)
where
isHandled (ForD (ForeignImport {})) = True
isHandled (TyClD {}) = True
@@ -408,10 +408,10 @@ collectDocs = go Nothing []
where
go Nothing _ [] = []
go (Just prev) docs [] = finished prev docs []
- go prev docs ((L _ (DocD (DocCommentNext str))):ds)
+ go prev docs (L _ (DocD (DocCommentNext str)) : ds)
| Nothing <- prev = go Nothing (str:docs) ds
| Just decl <- prev = finished decl docs (go Nothing [str] ds)
- go prev docs ((L _ (DocD (DocCommentPrev str))):ds) = go prev (str:docs) ds
+ go prev docs (L _ (DocD (DocCommentPrev str)) : ds) = go prev (str:docs) ds
go Nothing docs (d:ds) = go (Just d) docs ds
go (Just prev) docs (d:ds) = finished prev docs (go (Just d) [] ds)
@@ -489,7 +489,7 @@ mkExportItems
-- We should not show a subordinate by itself if any of its
-- parents is also exported. See note [1].
- | not $ t `elem` declNames,
+ | t `notElem` declNames,
Just p <- find isExported (parents t $ unL decl) ->
do liftErrMsg $ tell [
"Warning: " ++ moduleString thisMod ++ ": " ++
@@ -517,7 +517,7 @@ mkExportItems
mayDecl <- hiDecl t
case mayDecl of
Nothing -> return [ ExportNoDecl t [] ]
- Just decl -> do
+ Just decl ->
-- We try to get the subs and docs
-- from the installed .haddock file for that package.
case M.lookup (nameModule t) instIfaceMap of
@@ -526,7 +526,7 @@ mkExportItems
["Warning: Couldn't find .haddock for export " ++ pretty t]
let subs_ = [ (n, noDocForDecl) | (n, _, _) <- subordinates (unLoc decl) ]
return [ mkExportDecl t decl (noDocForDecl, subs_) ]
- Just iface -> do
+ Just iface ->
return [ mkExportDecl t decl (lookupDocs t (instDocMap iface) (instArgMap iface) (instSubMap iface)) ]
_ -> return []
@@ -736,9 +736,9 @@ extractRecSel nm mdl t tvs (L _ con : rest) =
data_ty = foldl (\x y -> noLoc (HsAppTy x y)) (noLoc (HsTyVar t)) (map toTypeNoLoc tvs)
--- Pruning
+-- | Keep exprt items with docs.
pruneExportItems :: [ExportItem Name] -> [ExportItem Name]
-pruneExportItems items = filter hasDoc items
+pruneExportItems = filter hasDoc
where
hasDoc (ExportDecl{expItemMbDoc = (d, _)}) = isJust d
hasDoc _ = True
@@ -758,12 +758,12 @@ mkVisibleNames exports opts
-- | Find a stand-alone documentation comment by its name.
findNamedDoc :: String -> [HsDecl Name] -> ErrMsgM (Maybe HsDocString)
-findNamedDoc name decls = search decls
+findNamedDoc name = search
where
search [] = do
tell ["Cannot find documentation for: $" ++ name]
return Nothing
- search ((DocD (DocCommentNamed name' doc)):rest)
+ search (DocD (DocCommentNamed name' doc) : rest)
| name == name' = return (Just doc)
| otherwise = search rest
search (_other_decl : rest) = search rest
diff --git a/src/Haddock/Interface/ParseModuleHeader.hs b/src/Haddock/Interface/ParseModuleHeader.hs
index 35533d0d..411b6661 100644
--- a/src/Haddock/Interface/ParseModuleHeader.hs
+++ b/src/Haddock/Interface/ParseModuleHeader.hs
@@ -137,14 +137,14 @@ parseKey key toParse0 =
(spaces1,cs1) = extractLeadingSpaces cs
in
(c:spaces1,cs1)
- | True = ([],s)
+ | otherwise = ([],s)
extractNextLine :: String -> (String,String)
extractNextLine [] = ([],[])
extractNextLine (c:cs)
| c == '\n' =
([],cs)
- | True =
+ | otherwise =
let
(line,rest) = extractNextLine cs
in
@@ -156,5 +156,5 @@ parseKey key toParse0 =
extractPrefix _ [] = Nothing
extractPrefix (c1:cs1) (c2:cs2)
| toUpper c1 == toUpper c2 = extractPrefix cs1 cs2
- | True = Nothing
+ | otherwise = Nothing
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 582c2ccd..cffe68b8 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -12,19 +12,20 @@
module Haddock.Interface.Rename (renameInterface) where
-import Haddock.Types
import Haddock.GhcUtils
+import Haddock.Types
-import GHC hiding (NoLink)
-import Name
import Bag (emptyBag)
import BasicTypes ( IPName(..), ipNameName )
+import GHC hiding (NoLink)
+import Name
+import Control.Applicative
+import Control.Monad hiding (mapM)
import Data.List
import qualified Data.Map as Map hiding ( Map )
-import Prelude hiding (mapM)
import Data.Traversable (mapM)
-import Control.Monad hiding (mapM)
+import Prelude hiding (mapM)
renameInterface :: LinkEnv -> Bool -> Interface -> ErrMsgM Interface
@@ -93,6 +94,9 @@ instance Monad (GenRnM n) where
(>>=) = thenRn
return = returnRn
+instance Functor (GenRnM n) where
+ fmap f x = do a <- x; return (f a)
+
returnRn :: a -> GenRnM n a
returnRn a = RnM (const (a,[]))
thenRn :: GenRnM n a -> (a -> GenRnM n b) -> GenRnM n b
@@ -211,7 +215,7 @@ renameLKind = renameLType
renameMaybeLKind :: Maybe (LHsKind Name) -> RnM (Maybe (LHsKind DocName))
renameMaybeLKind Nothing = return Nothing
-renameMaybeLKind (Just ki) = renameLKind ki >>= return . Just
+renameMaybeLKind (Just ki) = Just <$> renameLKind ki
renameType :: HsType Name -> RnM (HsType DocName)
renameType t = case t of
@@ -241,11 +245,11 @@ renameType t = case t of
HsTupleTy b ts -> return . HsTupleTy b =<< mapM renameLType ts
- HsOpTy a (w, (L loc op)) b -> do
+ HsOpTy a (w, L loc op) b -> do
op' <- rename op
a' <- renameLType a
b' <- renameLType b
- return (HsOpTy a' (w, (L loc op')) b')
+ return (HsOpTy a' (w, L loc op') b')
HsParTy ty -> return . HsParTy =<< renameLType ty
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-27 23:43:19 +0000