Mostly hlint-inspired cleanup.

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