diff options
Diffstat (limited to 'src/Haddock')
| -rw-r--r-- | src/Haddock/Interface/Rename.hs | 84 | 
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 | 
