ghc-mod/Language/Haskell/GhcMod/Browse.hs

129 lines
4.7 KiB
Haskell
Raw Normal View History

2013-05-18 21:16:37 +00:00
module Language.Haskell.GhcMod.Browse (browseModule, browse) where
2010-03-11 10:03:17 +00:00
2010-04-28 06:51:30 +00:00
import Control.Applicative
import Control.Monad (void)
2010-03-11 10:03:17 +00:00
import Data.Char
import Data.List
import Data.Maybe (catMaybes)
2013-03-12 13:15:23 +00:00
import DataCon (dataConRepType)
import FastString (mkFastString)
2010-04-28 06:51:30 +00:00
import GHC
2014-02-06 12:27:39 +00:00
import Panic (throwGhcException)
2013-07-14 08:07:30 +00:00
import Language.Haskell.GhcMod.Doc (showUnqualifiedPage)
2013-05-17 01:00:01 +00:00
import Language.Haskell.GhcMod.GHCApi
import Language.Haskell.GhcMod.Types
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 Var
2010-03-11 10:03:17 +00:00
----------------------------------------------------------------
2013-05-20 05:28:56 +00:00
-- | Getting functions, classes, etc from a module.
-- If 'detailed' is 'True', their types are also obtained.
2013-09-05 05:35:28 +00:00
-- If 'operators' is 'True', operators are also returned.
2013-05-20 05:28:56 +00:00
browseModule :: Options
-> Cradle
2013-05-20 05:28:56 +00:00
-> ModuleString -- ^ A module name. (e.g. \"Data.List\")
-> IO String
browseModule opt cradle mdlName = convert opt . sort <$> withGHCDummyFile (browse opt cradle mdlName)
2010-03-11 10:03:17 +00:00
2013-05-20 05:28:56 +00:00
-- | Getting functions, classes, etc from a module.
-- If 'detailed' is 'True', their types are also obtained.
2013-09-05 05:35:28 +00:00
-- If 'operators' is 'True', operators are also returned.
2013-05-20 05:28:56 +00:00
browse :: Options
-> Cradle
2013-05-20 05:28:56 +00:00
-> ModuleString -- ^ A module name. (e.g. \"Data.List\")
-> Ghc [String]
browse opt cradle mdlName = do
void $ initializeFlagsWithCradle opt cradle [] False
2013-03-01 01:16:31 +00:00
getModule >>= getModuleInfo >>= listExports
2010-04-27 01:28:00 +00:00
where
getModule = findModule mdlname mpkgid `gcatch` fallback
mdlname = mkModuleName mdlName
mpkgid = mkFastString <$> packageId opt
2013-03-01 01:16:31 +00:00
listExports Nothing = return []
listExports (Just mdinfo) = processExports opt mdinfo
-- findModule works only for package modules, moreover,
-- you cannot load a package module. On the other hand,
-- to browse a local module you need to load it first.
-- If CmdLineError is signalled, we assume the user
-- tried browsing a local module.
fallback (CmdLineError _) = loadAndFind
fallback e = throwGhcException e
loadAndFind = do
setTargetFiles [mdlName]
checkSlowAndSet
void $ load LoadAllTargets
findModule mdlname Nothing
processExports :: Options -> ModuleInfo -> Ghc [String]
processExports opt minfo = mapM (showExport opt minfo) $ removeOps $ modInfoExports minfo
where
removeOps
| operators opt = id
| otherwise = filter (isAlpha . head . getOccString)
showExport :: Options -> ModuleInfo -> Name -> Ghc String
showExport opt minfo e = do
mtype' <- mtype
return $ concat $ catMaybes [mqualified, Just $ formatOp $ getOccString e, mtype']
2013-02-28 17:24:14 +00:00
where
2013-11-18 14:22:49 +00:00
mqualified = (moduleNameString (moduleName $ nameModule e) ++ ".") `justIf` qualified opt
mtype
| detailed opt = do
tyInfo <- modInfoLookupName minfo e
2013-02-28 17:24:14 +00:00
-- If nothing found, load dependent module and lookup global
tyResult <- maybe (inOtherModule e) (return . Just) tyInfo
2013-03-12 13:15:23 +00:00
dflag <- getSessionDynFlags
return $ do
typeName <- tyResult >>= showThing dflag
(" :: " ++ typeName) `justIf` detailed opt
| otherwise = return Nothing
formatOp nm@(n:_)
| isAlpha n = nm
| otherwise = "(" ++ nm ++ ")"
formatOp "" = error "formatOp"
2013-02-28 17:24:14 +00:00
inOtherModule :: Name -> Ghc (Maybe TyThing)
2013-03-01 01:16:31 +00:00
inOtherModule nm = getModuleInfo (nameModule nm) >> lookupGlobalName nm
justIf :: a -> Bool -> Maybe a
justIf x True = Just x
justIf _ False = Nothing
2013-03-12 13:15:23 +00:00
showThing :: DynFlags -> TyThing -> Maybe String
showThing dflag (AnId i) = Just $ formatType dflag varType i
showThing dflag (ADataCon d) = Just $ formatType dflag dataConRepType d
showThing _ (ATyCon t) = unwords . toList <$> tyType t
2013-02-28 17:24:14 +00:00
where
2013-03-01 01:16:31 +00:00
toList t' = t' : getOccString t : map getOccString (tyConTyVars t)
2013-03-12 13:15:23 +00:00
showThing _ _ = Nothing
2013-03-01 01:16:31 +00:00
2013-03-12 13:15:23 +00:00
formatType :: NamedThing a => DynFlags -> (a -> Type) -> a -> String
formatType dflag f x = showOutputable dflag (removeForAlls $ f x)
2013-03-01 01:16:31 +00:00
tyType :: TyCon -> Maybe String
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
2013-02-28 17:24:14 +00:00
removeForAlls :: Type -> Type
2013-03-01 01:16:31 +00:00
removeForAlls ty = removeForAlls' ty' tty'
2013-02-28 17:24:14 +00:00
where
2013-03-01 01:16:31 +00:00
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
2013-03-12 13:15:23 +00:00
showOutputable :: Outputable a => DynFlags -> a -> String
2013-07-14 08:07:30 +00:00
showOutputable dflag = unwords . lines . showUnqualifiedPage dflag . ppr