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

refactoring Browse.

This commit is contained in:
Kazu Yamamoto 2013-03-01 10:16:31 +09:00
parent 4d9a170e50
commit b417e070ae
1 changed files with 29 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
Browse.hs
View File

@ -34,9 +34,13 @@ browseModule opt mdlName = convert opt . format <$> browse opt mdlName
browse :: Options -> String -> IO [String] browse :: Options -> String -> IO [String]
browse opt mdlName = withGHC $ do browse opt mdlName = withGHC $ do
_ <- initSession0 opt _ <- initSession0 opt
lookupModuleInfo >>= maybe (return []) (if detailed opt then processModule else return . processExports) getModule >>= getModuleInfo >>= listExports
where where
lookupModuleInfo = findModule (mkModuleName mdlName) Nothing >>= getModuleInfo getModule = findModule (mkModuleName mdlName) Nothing
listExports Nothing = return []
listExports (Just mdinfo)
| detailed opt = processModule mdinfo
| otherwise = return (processExports mdinfo)
processExports :: ModuleInfo -> [String] processExports :: ModuleInfo -> [String]
processExports = map getOccString . modInfoExports processExports = map getOccString . modInfoExports
@ -52,16 +56,15 @@ processModule minfo = mapM processName names
tyResult <- maybe (inOtherModule nm) (return . Just) tyInfo tyResult <- maybe (inOtherModule nm) (return . Just) tyInfo
return $ fromMaybe (getOccString nm) (tyResult >>= showThing) return $ fromMaybe (getOccString nm) (tyResult >>= showThing)
inOtherModule :: Name -> Ghc (Maybe TyThing) inOtherModule :: Name -> Ghc (Maybe TyThing)
inOtherModule nm = do inOtherModule nm = getModuleInfo (nameModule nm) >> lookupGlobalName nm
_ <- getModuleInfo (nameModule nm) -- FIXME
lookupGlobalName nm
showThing :: TyThing -> Maybe String showThing :: TyThing -> Maybe String
showThing (AnId i) = Just $ getOccString i ++ " :: " ++ showOutputable (removeForAlls $ varType i) showThing (AnId i) = Just $ getOccString i ++ " :: " ++ showOutputable (removeForAlls $ varType i)
showThing (ATyCon t) = do showThing (ATyCon t) = unwords . toList <$> tyType t
tyType' <- tyType t
return $ unwords $ [tyType', getOccString t] ++ map getOccString (tyConTyVars t)
where where
toList t' = t' : getOccString t : map getOccString (tyConTyVars t)
showThing _ = Nothing
tyType :: TyCon -> Maybe String tyType :: TyCon -> Maybe String
tyType typ tyType typ
| isAlgTyCon typ | isAlgTyCon typ
@ -71,14 +74,18 @@ showThing (ATyCon t) = do
| 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 = removeForAlls' ty' tty'
Nothing -> ty'
Just (pre, ftype) -> if isPredTy pre then mkFunTy pre (dropForAlls ftype) else ty'
where where
ty' = dropForAlls ty ty' = dropForAlls ty
tty' = splitFunTy_maybe ty'
removeForAlls' :: Type -> Maybe (Type, Type) -> Type
removeForAlls' ty Nothing = ty
removeForAlls' ty (Just (pre, ftype))
| isPredTy pre = mkFunTy pre (dropForAlls ftype)
| otherwise = ty
showOutputable :: Outputable a => a -> String showOutputable :: Outputable a => a -> String
showOutputable = unwords . lines . showDocForUser neverQualify . ppr showOutputable = unwords . lines . showDocForUser neverQualify . ppr