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

Refactoring Browse.hs.

Browse Source
This commit is contained in:
Kazu Yamamoto 2013-02-28 16:33:11 +09:00
parent 66a61b249f
commit 8fe6c99131
1 changed files with 30 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
Browse.hs
View File

@ -1,24 +1,23 @@
module Browse (browseModule) where module Browse (browseModule) where
import Control.Arrow (second)
import Control.Applicative 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 DynFlags (getDynFlags)
import Name import Name
import Types
import Outputable import Outputable
import Var
import TyCon import TyCon
import Type import Type
import Types
import Var
---------------------------------------------------------------- ----------------------------------------------------------------
browseModule :: Options -> String -> IO String browseModule :: Options -> String -> IO String
browseModule opt mdlName = (convert opt . format) <$> browse opt mdlName browseModule opt mdlName = convert opt . format <$> browse opt mdlName
where where
format format
| operators opt = formatOps | operators opt = formatOps
@ -45,8 +44,7 @@ browse opt mdlName = withGHC $ do
processModule :: ModuleInfo -> Ghc [String] processModule :: ModuleInfo -> Ghc [String]
processModule minfo = do processModule minfo = do
dynFlags <- getDynFlags dynFlags <- getDynFlags
let let processName :: Name -> Ghc String
processName :: Name -> Ghc String
processName 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
@ -55,7 +53,7 @@ browse opt mdlName = withGHC $ do
where where
inOtherModule :: Ghc (Maybe TyThing) inOtherModule :: Ghc (Maybe TyThing)
inOtherModule = do inOtherModule = do
otherModule <- getModuleInfo (nameModule nm) _ <- getModuleInfo (nameModule nm) -- FIXME
lookupGlobalName nm lookupGlobalName nm
name = getOccString nm name = getOccString nm
mapM processName exports mapM processName exports
@ -64,18 +62,20 @@ browse opt mdlName = withGHC $ do
showThing :: DynFlags -> TyThing -> Maybe String showThing :: DynFlags -> TyThing -> Maybe String
showThing dflags t = case t of showThing dflags t = case t of
(AnId i) -> Just $ getOccString i ++ " :: " ++ showOutputable dflags (removeForAlls $ varType i) AnId i -> Just $ getOccString i ++ " :: " ++ showOutputable dflags (removeForAlls $ varType i)
(ATyCon t) -> do ATyCon typ -> do
tyType' <- tyType t tyType' <- tyType typ
return $ intercalate " " $ [tyType', getOccString t] ++ map getOccString (tyConTyVars t) return $ unwords $ [tyType', getOccString typ] ++ map getOccString (tyConTyVars typ)
_ -> Nothing _ -> Nothing
where where
tyType :: TyCon -> Maybe String tyType :: TyCon -> Maybe String
tyType t tyType typ
| isAlgTyCon t && not (isNewTyCon t) && not (isClassTyCon t) = Just "data" | isAlgTyCon typ
| isNewTyCon t = Just "newtype" && not (isNewTyCon typ)
| isClassTyCon t = Just "class" && not (isClassTyCon typ) = Just "data"
| isSynTyCon t = Just "type" | isNewTyCon typ = Just "newtype"
| isClassTyCon typ = Just "class"
| isSynTyCon typ = Just "type"
| otherwise = Nothing | otherwise = Nothing
removeForAlls :: Type -> Type removeForAlls :: Type -> Type
@ -85,7 +85,5 @@ browse opt mdlName = withGHC $ do
where where
ty' = dropForAlls ty ty' = dropForAlls ty
showOutputable :: Outputable a => DynFlags -> a -> String showOutputable :: Outputable a => DynFlags -> a -> String
showOutputable dflags = unwords . lines . showSDocForUser dflags neverQualify . ppr showOutputable dflags = unwords . lines . showSDocForUser dflags neverQualify . ppr