diff options
| author | David Waern <david.waern@gmail.com> | 2009-11-14 12:10:47 +0000 | 
|---|---|---|
| committer | David Waern <david.waern@gmail.com> | 2009-11-14 12:10:47 +0000 | 
| commit | d3dcfadaa31815dc6ad1d45adf67d2386e33091c (patch) | |
| tree | 45e2ad34e0fec7757954509ab6c81ecb4cb78edc /src/Haddock | |
| parent | e7be4057a769c79969f762e83c6fc8c751ad6533 (diff) | |
hlint police
Diffstat (limited to 'src/Haddock')
| -rw-r--r-- | src/Haddock/Convert.hs | 8 | ||||
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 14 | ||||
| -rw-r--r-- | src/Haddock/Interface/ExtractFnArgDocs.hs | 1 | ||||
| -rw-r--r-- | src/Haddock/Interface/LexParseRn.hs | 3 | ||||
| -rw-r--r-- | src/Haddock/ModuleTree.hs | 6 | ||||
| -rw-r--r-- | src/Haddock/Types.hs | 5 | 
6 files changed, 18 insertions, 19 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.  | 
