hlint police

7 files changed, 29 insertions, 32 deletions

diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 277b42a4..6e564b76 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -49,7 +49,7 @@ tyThingToLHsDecl t = noLoc $ case t of
       (map (\ (l,r) -> noLoc
                  (map getName l, map getName r) ) $
          snd $ classTvsFds cl)
-      (map (\i -> noLoc $ synifyIdSig DeleteTopLevelQuantification i)
+      (map (noLoc . synifyIdSig DeleteTopLevelQuantification)
            (classMethods cl))
       emptyBag --ignore default method definitions, they don't affect signature
       (map synifyClassAT (classATs cl))
@@ -58,7 +58,7 @@ tyThingToLHsDecl t = noLoc $ case t of
 -- class associated-types are a subset of TyCon
 -- (mainly only type/data-families)
 synifyClassAT :: TyCon -> LTyClDecl Name
-synifyClassAT tc = noLoc $ synifyTyCon tc
+synifyClassAT = noLoc . synifyTyCon
 
 synifyTyCon :: TyCon -> TyClDecl Name
 synifyTyCon tc
@@ -185,14 +185,14 @@ synifyDataCon use_gadt_syntax dc = noLoc $
 #endif
 
 synifyName :: NamedThing n => n -> Located Name
-synifyName n = noLoc (getName n)
+synifyName = noLoc . getName
 
 synifyIdSig :: SynifyTypeState -> Id -> Sig Name
 synifyIdSig s i = TypeSig (synifyName i) (synifyType s (varType i))
 
 
 synifyCtx :: [PredType] -> LHsContext Name
-synifyCtx ps = noLoc (map synifyPred ps)
+synifyCtx = noLoc . map synifyPred
 
 synifyPred :: PredType -> LHsPred Name
 synifyPred (ClassP cls tys) =
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 298f96ac..7a1d6d25 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -280,7 +280,7 @@ warnAboutFilteredDecls mdl decls = do
     tell $ nub [
       "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  " ++ concat (intersperse ", "
       $ map (occNameString . nameOccName) typeInstances) ]
 
   let instances = nub [ pretty i | (L _ (InstD (InstDecl i _ _ ats)), _, _) <- decls
@@ -289,7 +289,7 @@ warnAboutFilteredDecls mdl decls = do
   unless (null instances) $
     tell $ nub [
       "Warning: " ++ modStr ++ ": We do not support associated types in instances yet. "
-      ++ "These instances are affected:\n" ++ (concat $ intersperse ", " instances) ]
+      ++ "These instances are affected:\n" ++ concat (intersperse ", " instances) ]
 
 
 --------------------------------------------------------------------------------
@@ -446,13 +446,13 @@ mkExportItems modMap this_mod gre exported_names decls declMap
     lookupExport (IEThingAll t)        = declWith t
     lookupExport (IEThingWith t _)     = declWith t
     lookupExport (IEModuleContents m)  = fullContentsOf m
-    lookupExport (IEGroup lev docStr)  = liftErrMsg $ do
+    lookupExport (IEGroup lev docStr)  = liftErrMsg $
       ifDoc (lexParseRnHaddockComment DocSectionComment gre docStr)
             (\doc -> return [ ExportGroup lev "" doc ])
-    lookupExport (IEDoc docStr)        = liftErrMsg $ do
+    lookupExport (IEDoc docStr)        = liftErrMsg $
       ifDoc (lexParseRnHaddockComment NormalHaddockComment gre docStr)
             (\doc -> return [ ExportDoc doc ])
-    lookupExport (IEDocNamed str) = liftErrMsg $ do
+    lookupExport (IEDocNamed str) = liftErrMsg $
       ifDoc (findNamedDoc str [ unL d | (d,_,_) <- decls ])
             (\docStr ->
             ifDoc (lexParseRnHaddockComment NormalHaddockComment gre docStr)
@@ -606,7 +606,7 @@ mkExportItems modMap this_mod gre exported_names decls declMap
         subs' = filter ((`elem` exported_names) . fst) subs
         sub_names = map fst subs'
 
-    isExported n = n `elem` exported_names
+    isExported = (`elem` exported_names)
 
     fullContentsOf modname
 	| m == this_mod = liftErrMsg $ fullContentsOfThisModule gre decls
@@ -663,7 +663,7 @@ fullContentsOfThisModule gre decls = liftM catMaybes $ mapM mkExportItem decls
   where
     mkExportItem (L _ (DocD (DocGroup lev docStr)), _, _) = do
         mbDoc <- lexParseRnHaddockComment DocSectionComment gre docStr
-        return $ fmap (\doc -> ExportGroup lev "" doc) mbDoc
+        return $ fmap (ExportGroup lev "") mbDoc
     mkExportItem (L _ (DocD (DocCommentNamed _ docStr)), _, _) = do
         mbDoc <- lexParseRnHaddockComment NormalHaddockComment gre docStr
         return $ fmap ExportDoc mbDoc
diff --git a/src/Haddock/Interface/ExtractFnArgDocs.hs b/src/Haddock/Interface/ExtractFnArgDocs.hs
index 0a6a05de..d3d7160f 100644
--- a/src/Haddock/Interface/ExtractFnArgDocs.hs
+++ b/src/Haddock/Interface/ExtractFnArgDocs.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE PatternGuards #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Haddock.Interface.ExtractFnArgDocs
diff --git a/src/Haddock/Interface/LexParseRn.hs b/src/Haddock/Interface/LexParseRn.hs
index 04464e77..026e753c 100644
--- a/src/Haddock/Interface/LexParseRn.hs
+++ b/src/Haddock/Interface/LexParseRn.hs
@@ -58,8 +58,7 @@ lexParseRnHaddockComment hty gre (HsDocString fs) = do
      Nothing -> do
        tell ["doc comment parse failed: "++str]
        return Nothing
-     Just doc -> do
-       return (Just (rnHsDoc gre doc))
+     Just doc -> return (Just (rnHsDoc gre doc))
 #else
 lexParseRnHaddockComment _ _ doc = return (Just doc)
 #endif
diff --git a/src/Haddock/ModuleTree.hs b/src/Haddock/ModuleTree.hs
index 62918ec6..d82c53a6 100644
--- a/src/Haddock/ModuleTree.hs
+++ b/src/Haddock/ModuleTree.hs
@@ -15,8 +15,8 @@ module Haddock.ModuleTree ( ModuleTree(..), mkModuleTree ) where
 import Haddock.Types ( HsDoc )
 
 import GHC           ( Name )
-import Module        ( Module, moduleNameString, moduleName, modulePackageId )
-import Module (packageIdString)
+import Module        ( Module, moduleNameString, moduleName, modulePackageId,
+                       packageIdString )
 
 data ModuleTree = Node String Bool (Maybe String) (Maybe (HsDoc Name)) [ModuleTree]
 
@@ -26,7 +26,7 @@ mkModuleTree showPkgs mods =
   where
     modPkg mod_ | showPkgs = Just (packageIdString (modulePackageId mod_))
                 | otherwise = Nothing
-    fn (mod_,pkg,short) trees = addToTrees mod_ pkg short trees
+    fn (mod_,pkg,short) = addToTrees mod_ pkg short
 
 addToTrees :: [String] -> Maybe String -> Maybe (HsDoc Name) -> [ModuleTree] -> [ModuleTree]
 addToTrees [] _ _ ts = ts
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 44c6f4ef..4c8c3656 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -28,6 +28,7 @@ module Haddock.Types (
 
 
 import Control.Exception
+import Control.Arrow
 import Data.Typeable
 import Data.Map (Map)
 import qualified Data.Map as Map
@@ -380,11 +381,11 @@ liftErrMsg = WriterGhc . return . runWriter
 --tell :: [ErrMsg] -> ErrMsgGhc ()
 --tell msgs = WriterGhc $ return ( (), msgs )
 instance Functor ErrMsgGhc where
-  fmap f (WriterGhc x) = WriterGhc (fmap (\(a,msgs)->(f a,msgs)) x)
+  fmap f (WriterGhc x) = WriterGhc (fmap (first f) x)
 instance Monad ErrMsgGhc where
   return a = WriterGhc (return (a, []))
   m >>= k = WriterGhc $ runWriterGhc m >>= \ (a, msgs1) ->
-               fmap (\ (b, msgs2) -> (b, msgs1 ++ msgs2)) (runWriterGhc (k a))
+               fmap (second (msgs1 ++)) (runWriterGhc (k a))
 
 -- When HsDoc syntax is part of the Haddock codebase, we'll just
 -- declare a Functor instance.
diff --git a/src/Main.hs b/src/Main.hs
index ad3f918d..76ccab3c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -90,14 +90,14 @@ handleHaddockExceptions inner =
   catches inner [Handler handler]
   where
     handler (e::HaddockException) = do
-      putStrLn $ "haddock: " ++ (show e)
+      putStrLn $ "haddock: " ++ show e
       exitFailure
 
 
 handleGhcExceptions :: IO a -> IO a
-handleGhcExceptions inner =
+handleGhcExceptions =
   -- error messages propagated as exceptions
-  handleGhcException (\e -> do
+  handleGhcException $ \e -> do
     hFlush stdout
     case e of
       PhaseFailed _ code -> exitWith code
@@ -105,7 +105,6 @@ handleGhcExceptions inner =
       _ -> do
         print (e :: GhcException)
         exitFailure
-  ) inner
 
 
 -------------------------------------------------------------------------------
@@ -232,7 +231,7 @@ render flags ifaces installedIfaces = do
                 allVisibleIfaces
     copyHtmlBits odir libDir css_file
 
-  when (Flag_GenContents `elem` flags && Flag_GenIndex `elem` flags) $ do
+  when (Flag_GenContents `elem` flags && Flag_GenIndex `elem` flags) $
     ppHtmlHelpFiles title packageStr visibleIfaces odir maybe_html_help_format []
 
   when (Flag_GenContents `elem` flags) $ do
@@ -322,7 +321,7 @@ startGhc libDir flags ghcActs = do
       -- TODO: handle warnings?
       (dynflags', rest, _) <- parseDynamicFlags dynflags flags_
       if not (null rest)
-        then throwE ("Couldn't parse GHC options: " ++ (unwords origFlags))
+        then throwE ("Couldn't parse GHC options: " ++ unwords origFlags)
         else return dynflags'
 
 
@@ -331,7 +330,7 @@ startGhc libDir flags ghcActs = do
 -------------------------------------------------------------------------------
 
 getHaddockLibDir :: [Flag] -> IO String
-getHaddockLibDir flags = do
+getHaddockLibDir flags =
   case [str | Flag_Lib str <- flags] of
     [] ->
 #ifdef IN_GHC_TREE
@@ -342,7 +341,7 @@ getHaddockLibDir flags = do
     fs -> return (last fs)
 
 getGhcLibDir :: [Flag] -> IO String
-getGhcLibDir flags = do
+getGhcLibDir flags =
   case [ dir | Flag_GhcLibDir dir <- flags ] of
     [] ->
 #ifdef IN_GHC_TREE
@@ -374,12 +373,12 @@ handleEasyFlags flags = do
     dir <- getGhcLibDir flags
     bye $ dir ++ "\n"
 
-  when (Flag_UseUnicode `elem` flags && not (Flag_Html `elem` flags)) $
-  	throwE ("Unicode can only be enabled for HTML output.")
+  when (Flag_UseUnicode `elem` flags && Flag_Html `notElem` flags) $
+  	throwE "Unicode can only be enabled for HTML output."
 
   when ((Flag_GenIndex `elem` flags || Flag_GenContents `elem` flags)
         && Flag_Html `elem` flags) $
-    throwE ("-h cannot be used with --gen-index or --gen-contents")
+    throwE "-h cannot be used with --gen-index or --gen-contents"
   where
     byeVersion = bye $
       "Haddock version " ++ projectVersion ++ ", (c) Simon Marlow 2006\n"
@@ -389,8 +388,7 @@ handleEasyFlags flags = do
 
 
 updateHTMLXRefs :: [(InterfaceFile, FilePath)] -> IO ()
-updateHTMLXRefs packages = do
-  writeIORef html_xrefs_ref (Map.fromList mapping)
+updateHTMLXRefs packages = writeIORef html_xrefs_ref (Map.fromList mapping)
   where
     mapping = [ (instMod iface, html) | (ifaces, html) <- packages
               , iface <- ifInstalledIfaces ifaces ]