aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock')
-rw-r--r--src/Haddock/Interface/Rename.hs84
1 files changed, 42 insertions, 42 deletions
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index f07dc7ef..df885df5 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -19,7 +19,7 @@ import Haddock.GhcUtils
import GHC hiding (NoLink)
import Name
import BasicTypes
-import SrcLoc
+import SrcLoc
import Bag (emptyBag)
import Data.List
@@ -37,33 +37,33 @@ renameInterface renamingEnv warnings iface =
-- env
let localEnv = foldl fn renamingEnv (ifaceVisibleExports iface)
where fn env name = Map.insert name (ifaceMod iface) env
-
+
docMap = Map.map (\(_,x,_) -> x) (ifaceDeclMap iface)
docs = [ (n, doc) | (n, Just doc) <- Map.toList docMap ]
- renameMapElem (k,d) = do d' <- renameDoc d; return (k, d')
+ renameMapElem (k,d) = do d' <- renameDoc d; return (k, d')
-- rename names in the exported declarations to point to things that
-- are closer to, or maybe even exported by, the current module.
(renamedExportItems, missingNames1)
= runRnFM localEnv (renameExportItems (ifaceExportItems iface))
- (rnDocMap, missingNames2)
+ (rnDocMap, missingNames2)
= runRnFM localEnv (liftM Map.fromList (mapM renameMapElem docs))
(finalModuleDoc, missingNames3)
= runRnFM localEnv (renameMaybeDoc (ifaceDoc iface))
-- combine the missing names and filter out the built-ins, which would
- -- otherwise allways be missing.
+ -- otherwise allways be missing.
missingNames = nub $ filter isExternalName
(missingNames1 ++ missingNames2 ++ missingNames3)
- -- filter out certain built in type constructors using their string
+ -- filter out certain built in type constructors using their string
-- representation. TODO: use the Name constants from the GHC API.
--- strings = filter (`notElem` ["()", "[]", "(->)"])
+-- strings = filter (`notElem` ["()", "[]", "(->)"])
-- (map pretty missingNames)
strings = map pretty . filter (\n -> not (isSystemName n || isBuiltInSyntax n)) $ missingNames
-
+
in do
-- report things that we couldn't link to. Only do this for non-hidden
-- modules.
@@ -81,13 +81,13 @@ renameInterface renamingEnv warnings iface =
-- Monad for renaming
--
-- The monad does two things for us: it passes around the environment for
--- renaming, and it returns a list of names which couldn't be found in
+-- renaming, and it returns a list of names which couldn't be found in
-- the environment.
--------------------------------------------------------------------------------
-newtype GenRnM n a =
- RnM { unRn :: (n -> (Bool, DocName)) -- name lookup function
+newtype GenRnM n a =
+ RnM { unRn :: (n -> (Bool, DocName)) -- name lookup function
-> (a,[n])
}
@@ -95,14 +95,14 @@ type RnM a = GenRnM Name a
instance Monad (GenRnM n) where
(>>=) = thenRn
- return = returnRn
+ return = returnRn
returnRn :: a -> GenRnM n a
returnRn a = RnM (const (a,[]))
thenRn :: GenRnM n a -> (a -> GenRnM n b) -> GenRnM n b
-m `thenRn` k = RnM (\lkp -> case unRn m lkp of
- (a,out1) -> case unRn (k a) lkp of
- (b,out2) -> (b,out1++out2))
+m `thenRn` k = RnM (\lkp -> case unRn m lkp of
+ (a,out1) -> case unRn (k a) lkp of
+ (b,out2) -> (b,out1++out2))
getLookupRn :: RnM (Name -> (Bool, DocName))
getLookupRn = RnM (\lkp -> (lkp,[]))
@@ -113,15 +113,15 @@ lookupRn :: (DocName -> a) -> Name -> RnM a
lookupRn and_then name = do
lkp <- getLookupRn
case lkp name of
- (False,maps_to) -> do outRn name; return (and_then maps_to)
- (True, maps_to) -> return (and_then maps_to)
+ (False,maps_to) -> do outRn name; return (and_then maps_to)
+ (True, maps_to) -> return (and_then maps_to)
runRnFM :: LinkEnv -> RnM a -> (a,[Name])
-runRnFM env rn = unRn rn lkp
- where
+runRnFM env rn = unRn rn lkp
+ where
lkp n = case Map.lookup n env of
- Nothing -> (False, Undocumented n)
+ Nothing -> (False, Undocumented n)
Just mdl -> (True, Documented n mdl)
@@ -184,11 +184,11 @@ renameDoc d = case d of
a' <- renameDoc a
b' <- renameDoc b
return (a',b')) docs
- return (DocDefList docs')
+ return (DocDefList docs')
DocCodeBlock doc -> do
doc' <- renameDoc doc
return (DocCodeBlock doc')
- DocURL str -> return (DocURL str)
+ DocURL str -> return (DocURL str)
DocPic str -> return (DocPic str)
DocAName str -> return (DocAName str)
@@ -199,7 +199,7 @@ renameLPred = mapM renamePred
renamePred :: HsPred Name -> RnM (HsPred DocName)
renamePred (HsClassP name types) = do
- name' <- rename name
+ name' <- rename name
types' <- mapM renameLType types
return (HsClassP name' types')
renamePred (HsEqualP type1 type2) = do
@@ -212,27 +212,27 @@ renamePred (HsIParam (IPName name) t) = do
return (HsIParam (IPName name') t')
-renameLType :: LHsType Name -> RnM (LHsType DocName)
+renameLType :: LHsType Name -> RnM (LHsType DocName)
renameLType = mapM renameType
renameType :: HsType Name -> RnM (HsType DocName)
-renameType t = case t of
+renameType t = case t of
HsForAllTy expl tyvars lcontext ltype -> do
tyvars' <- mapM renameLTyVarBndr tyvars
- lcontext' <- renameLContext lcontext
+ lcontext' <- renameLContext lcontext
ltype' <- renameLType ltype
return (HsForAllTy expl tyvars' lcontext' ltype')
HsTyVar n -> return . HsTyVar =<< rename n
HsBangTy b ltype -> return . HsBangTy b =<< renameLType ltype
-
+
HsAppTy a b -> do
a' <- renameLType a
b' <- renameLType b
return (HsAppTy a' b')
- HsFunTy a b -> do
+ HsFunTy a b -> do
a' <- renameLType a
b' <- renameLType b
return (HsFunTy a' b')
@@ -308,7 +308,7 @@ renameDecl decl = case decl of
renameLTyClD :: LTyClDecl Name -> RnM (LTyClDecl DocName)
-renameLTyClD (L loc d) = return . L loc =<< renameTyClD d
+renameLTyClD (L loc d) = return . L loc =<< renameTyClD d
renameTyClD :: TyClDecl Name -> RnM (TyClDecl DocName)
@@ -329,8 +329,8 @@ renameTyClD d = case d of
typats' <- mapM (mapM renameLType) typats
cons' <- mapM renameLCon cons
-- I don't think we need the derivings, so we return Nothing
- return (TyData x lcontext' lname' ltyvars' typats' k cons' Nothing)
-
+ return (TyData x lcontext' lname' ltyvars' typats' k cons' Nothing)
+
TySynonym lname ltyvars typats ltype -> do
lname' <- renameL lname
ltyvars' <- mapM renameLTyVarBndr ltyvars
@@ -342,12 +342,12 @@ renameTyClD d = case d of
lcontext' <- renameLContext lcontext
lname' <- renameL lname
ltyvars' <- mapM renameLTyVarBndr ltyvars
- lfundeps' <- mapM renameLFunDep lfundeps
+ lfundeps' <- mapM renameLFunDep lfundeps
lsigs' <- mapM renameLSig lsigs
ats' <- mapM renameLTyClD ats
-- we don't need the default methods or the already collected doc entities
return (ClassDecl lcontext' lname' ltyvars' lfundeps' lsigs' emptyBag ats' [])
-
+
where
renameLCon (L loc con) = return . L loc =<< renameCon con
renameCon (ConDecl lname expl ltyvars lcontext details restype mbldoc) = do
@@ -357,7 +357,7 @@ renameTyClD d = case d of
details' <- renameDetails details
restype' <- renameResType restype
mbldoc' <- mapM renameLDoc mbldoc
- return (ConDecl lname' expl ltyvars' lcontext' details' restype' mbldoc')
+ return (ConDecl lname' expl ltyvars' lcontext' details' restype' mbldoc')
renameDetails (RecCon fields) = return . RecCon =<< mapM renameField fields
renameDetails (PrefixCon ps) = return . PrefixCon =<< mapM renameLType ps
@@ -379,16 +379,16 @@ renameTyClD d = case d of
xs' <- mapM rename xs
ys' <- mapM rename ys
return (L loc (xs', ys'))
-
+
renameLSig (L loc sig) = return . L loc =<< renameSig sig
-
-renameSig :: Sig Name -> RnM (Sig DocName)
-renameSig sig = case sig of
- TypeSig lname ltype -> do
+
+renameSig :: Sig Name -> RnM (Sig DocName)
+renameSig sig = case sig of
+ TypeSig lname ltype -> do
lname' <- renameL lname
ltype' <- renameLType ltype
- return (TypeSig lname' ltype')
+ return (TypeSig lname' ltype')
-- we have filtered out all other kinds of signatures in Interface.Create
_ -> error "expected TypeSig"
@@ -408,11 +408,11 @@ renameInstD :: InstDecl Name -> RnM (InstDecl DocName)
renameInstD (InstDecl ltype _ _ lATs) = do
ltype' <- renameLType ltype
lATs' <- mapM renameLTyClD lATs
- return (InstDecl ltype' emptyBag [] lATs')
+ return (InstDecl ltype' emptyBag [] lATs')
renameExportItem :: ExportItem Name -> RnM (ExportItem DocName)
-renameExportItem item = case item of
+renameExportItem item = case item of
ExportModule mdl -> return (ExportModule mdl)
ExportGroup lev id_ doc -> do
doc' <- renameDoc doc
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-21 18:03:35 +0000