aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock')
-rw-r--r--src/Haddock/Convert.hs8
-rw-r--r--src/Haddock/Interface/Create.hs14
-rw-r--r--src/Haddock/Interface/ExtractFnArgDocs.hs1
-rw-r--r--src/Haddock/Interface/LexParseRn.hs3
-rw-r--r--src/Haddock/ModuleTree.hs6
-rw-r--r--src/Haddock/Types.hs5
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.
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 15:22:44 +0000