ghc-mod/Browse.hs

90 lines
3.0 KiB
Haskell
Raw Normal View History

2010-03-11 10:03:17 +00:00
module Browse (browseModule) where
2010-04-28 06:51:30 +00:00
import Control.Applicative
2010-03-11 10:03:17 +00:00
import Data.Char
import Data.List
import Data.Maybe (fromMaybe)
2013-02-28 07:33:11 +00:00
import DynFlags (getDynFlags) -- FIXME
2010-04-28 06:51:30 +00:00
import GHC
2012-02-14 07:09:53 +00:00
import GHCApi
2010-04-28 06:51:30 +00:00
import Name
import Outputable
import TyCon
import Type
2013-02-28 07:33:11 +00:00
import Types
import Var
2010-03-11 10:03:17 +00:00
----------------------------------------------------------------
2010-03-11 13:39:07 +00:00
browseModule :: Options -> String -> IO String
2013-02-28 07:33:11 +00:00
browseModule opt mdlName = convert opt . format <$> browse opt mdlName
2010-03-11 10:03:17 +00:00
where
2011-01-27 05:29:39 +00:00
format
| operators opt = formatOps
| otherwise = removeOps
removeOps = sort . filter (isAlpha.head)
formatOps = sort . map formatOps'
formatOps' x@(s:_)
| isAlpha s = x
| otherwise = "(" ++ name ++ ")" ++ tail_
where
(name, tail_) = break isSpace x
2011-01-27 05:29:39 +00:00
formatOps' [] = error "formatOps'"
2010-03-11 10:03:17 +00:00
browse :: Options -> String -> IO [String]
browse opt mdlName = withGHC $ do
2012-08-06 00:43:47 +00:00
_ <- initSession0 opt
lookupModuleInfo >>= maybe (return []) (if detailed opt then processModule else return . processExports)
2010-04-27 01:28:00 +00:00
where
lookupModuleInfo = findModule (mkModuleName mdlName) Nothing >>= getModuleInfo
processExports :: ModuleInfo -> [String]
processExports = map getOccString . modInfoExports
processModule :: ModuleInfo -> Ghc [String]
processModule minfo = do
dynFlags <- getDynFlags
2013-02-28 07:33:11 +00:00
let processName :: Name -> Ghc String
processName nm = do
tyInfo <- modInfoLookupName minfo nm
-- If nothing found, load dependent module and lookup global
tyResult <- maybe inOtherModule (return . Just) tyInfo
return $ fromMaybe name (tyResult >>= showThing dynFlags)
where
inOtherModule :: Ghc (Maybe TyThing)
inOtherModule = do
_ <- getModuleInfo (nameModule nm) -- FIXME
lookupGlobalName nm
name = getOccString nm
mapM processName exports
2013-02-28 07:33:11 +00:00
where
exports = modInfoExports minfo
showThing :: DynFlags -> TyThing -> Maybe String
showThing dflags t = case t of
2013-02-28 07:33:11 +00:00
AnId i -> Just $ getOccString i ++ " :: " ++ showOutputable dflags (removeForAlls $ varType i)
ATyCon typ -> do
tyType' <- tyType typ
return $ unwords $ [tyType', getOccString typ] ++ map getOccString (tyConTyVars typ)
_ -> Nothing
where
tyType :: TyCon -> Maybe String
2013-02-28 07:33:11 +00:00
tyType typ
| isAlgTyCon typ
&& not (isNewTyCon typ)
&& not (isClassTyCon typ) = Just "data"
| isNewTyCon typ = Just "newtype"
| isClassTyCon typ = Just "class"
| isSynTyCon typ = Just "type"
| otherwise = Nothing
removeForAlls :: Type -> Type
removeForAlls ty = case splitFunTy_maybe ty' of
Nothing -> ty'
Just (pre, ftype) -> if isPredTy pre then mkFunTy pre (dropForAlls ftype) else ty'
where
ty' = dropForAlls ty
showOutputable :: Outputable a => DynFlags -> a -> String
showOutputable dflags = unwords . lines . showSDocForUser dflags neverQualify . ppr