hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Making Browse compilable with GHC 7.4.x.

Browse Source
This commit is contained in:
Kazu Yamamoto 2013-03-01 02:42:54 +09:00
parent 9796d639ab
commit eece2969ab
1 changed files with 13 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
Browse.hs
View File

@ -4,9 +4,9 @@ import Control.Applicative
import Data.Char import Data.Char
import Data.List import Data.List
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import DynFlags (getDynFlags) -- FIXME
import GHC import GHC
import GHCApi import GHCApi
import Gap
import Name import Name
import Outputable import Outputable
import TyCon import TyCon
@ -42,29 +42,25 @@ processExports :: ModuleInfo -> [String]
processExports = map getOccString . modInfoExports processExports = map getOccString . modInfoExports
processModule :: ModuleInfo -> Ghc [String] processModule :: ModuleInfo -> Ghc [String]
processModule minfo = do processModule minfo = mapM processName names
dynFlags <- getDynFlags
mapM (processName dynFlags) names
where where
names = modInfoExports minfo names = modInfoExports minfo
processName :: DynFlags -> Name -> Ghc String processName :: Name -> Ghc String
processName dynFlags nm = do processName nm = do
tyInfo <- modInfoLookupName minfo nm tyInfo <- modInfoLookupName minfo nm
-- If nothing found, load dependent module and lookup global -- If nothing found, load dependent module and lookup global
tyResult <- maybe (inOtherModule nm) (return . Just) tyInfo tyResult <- maybe (inOtherModule nm) (return . Just) tyInfo
return $ fromMaybe (getOccString nm) (tyResult >>= showThing dynFlags) return $ fromMaybe (getOccString nm) (tyResult >>= showThing)
inOtherModule :: Name -> Ghc (Maybe TyThing) inOtherModule :: Name -> Ghc (Maybe TyThing)
inOtherModule nm = do inOtherModule nm = do
_ <- getModuleInfo (nameModule nm) -- FIXME _ <- getModuleInfo (nameModule nm) -- FIXME
lookupGlobalName nm lookupGlobalName nm
showThing :: DynFlags -> TyThing -> Maybe String showThing :: TyThing -> Maybe String
showThing dflags t = case t of showThing (AnId i) = Just $ getOccString i ++ " :: " ++ showOutputable (removeForAlls $ varType i)
AnId i -> Just $ getOccString i ++ " :: " ++ showOutputable dflags (removeForAlls $ varType i) showThing (ATyCon t) = do
ATyCon typ -> do tyType' <- tyType t
tyType' <- tyType typ return $ unwords $ [tyType', getOccString t] ++ map getOccString (tyConTyVars t)
return $ unwords $ [tyType', getOccString typ] ++ map getOccString (tyConTyVars typ)
_ -> Nothing
where where
tyType :: TyCon -> Maybe String tyType :: TyCon -> Maybe String
tyType typ tyType typ
@ -75,6 +71,7 @@ showThing dflags t = case t of
| isClassTyCon typ = Just "class" | isClassTyCon typ = Just "class"
| isSynTyCon typ = Just "type" | isSynTyCon typ = Just "type"
| otherwise = Nothing | otherwise = Nothing
showThing _ = Nothing
removeForAlls :: Type -> Type removeForAlls :: Type -> Type
removeForAlls ty = case splitFunTy_maybe ty' of removeForAlls ty = case splitFunTy_maybe ty' of
@ -83,5 +80,5 @@ removeForAlls ty = case splitFunTy_maybe ty' of
where where
ty' = dropForAlls ty ty' = dropForAlls ty
showOutputable :: Outputable a => DynFlags -> a -> String showOutputable :: Outputable a => a -> String
showOutputable dflags = unwords . lines . showSDocForUser dflags neverQualify . ppr showOutputable = unwords . lines . showDocForUser neverQualify . ppr