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

106 lines
3.7 KiB
Haskell
Raw Normal View History

2013-05-20 05:28:56 +00:00
module Language.Haskell.GhcMod.Info (
info
2014-04-21 05:04:58 +00:00
, types
2013-05-20 05:28:56 +00:00
) where
2010-11-12 07:27:50 +00:00
2014-01-08 03:03:32 +00:00
import Data.Function (on)
import Data.List (sortBy)
import Data.Maybe (catMaybes)
import System.FilePath
import Exception (ghandle, SomeException(..))
import GHC (GhcMonad, LHsBind, LHsExpr, LPat, Id, TypecheckedModule(..), SrcSpan, Type)
2015-08-03 01:09:56 +00:00
import Prelude
2014-03-27 06:56:14 +00:00
import qualified GHC as G
2016-01-18 00:51:03 +00:00
import qualified Var as G (varType)
2014-03-27 06:56:14 +00:00
import qualified Language.Haskell.GhcMod.Gap as Gap
import Language.Haskell.GhcMod.Convert
import Language.Haskell.GhcMod.Doc
import Language.Haskell.GhcMod.DynFlags
import Language.Haskell.GhcMod.Gap
import Language.Haskell.GhcMod.Logging
import Language.Haskell.GhcMod.Monad
import Language.Haskell.GhcMod.SrcUtils
2013-05-17 01:00:01 +00:00
import Language.Haskell.GhcMod.Types
2015-07-04 14:49:48 +00:00
import Language.Haskell.GhcMod.Utils (mkRevRedirMapFunc)
2015-07-03 19:31:52 +00:00
import Language.Haskell.GhcMod.FileMapping (fileModSummaryWithMapping)
2016-01-18 00:51:03 +00:00
import Control.Applicative
2012-02-14 07:09:53 +00:00
----------------------------------------------------------------
2011-08-24 06:58:12 +00:00
2013-05-20 05:28:56 +00:00
-- | Obtaining information of a target expression. (GHCi's info:)
info :: IOish m
=> FilePath -- ^ A target file.
2013-09-05 05:35:28 +00:00
-> Expression -- ^ A Haskell expression.
-> GhcModT m String
info file expr =
2015-06-01 14:54:50 +00:00
ghandle handler $
runGmlT' [Left file] deferErrors $
withInteractiveContext $ do
convert' =<< body
2014-04-23 07:37:24 +00:00
where
handler (SomeException ex) = do
2015-06-01 14:54:50 +00:00
gmLog GmException "info" $ text "" $$ nest 4 (showDoc ex)
convert' "Cannot show info"
2015-07-04 14:49:48 +00:00
body :: (GhcMonad m, GmState m, GmEnv m) => m String
body = do
2015-07-04 14:49:48 +00:00
m <- mkRevRedirMapFunc
sdoc <- Gap.infoThing m expr
2015-06-01 14:54:50 +00:00
st <- getStyle
dflag <- G.getSessionDynFlags
return $ showPage dflag st sdoc
2011-01-14 02:18:33 +00:00
2012-02-12 12:04:18 +00:00
----------------------------------------------------------------
2013-05-20 05:28:56 +00:00
-- | Obtaining type of a target expression. (GHCi's type:)
types :: IOish m
=> FilePath -- ^ A target file.
2014-04-21 05:04:58 +00:00
-> Int -- ^ Line number.
-> Int -- ^ Column number.
-> GhcModT m String
types file lineNo colNo =
2015-06-01 14:54:50 +00:00
ghandle handler $
runGmlT' [Left file] deferErrors $
withInteractiveContext $ do
2015-06-01 14:54:50 +00:00
crdl <- cradle
2015-07-03 19:31:52 +00:00
modSum <- fileModSummaryWithMapping (cradleCurrentDir crdl </> file)
2014-04-23 07:37:24 +00:00
srcSpanTypes <- getSrcSpanType modSum lineNo colNo
2015-06-01 14:54:50 +00:00
dflag <- G.getSessionDynFlags
st <- getStyle
convert' $ map (toTup dflag st) $ sortBy (cmp `on` fst) srcSpanTypes
where
2015-05-06 14:13:08 +00:00
handler (SomeException ex) = do
gmLog GmException "types" $ showDoc ex
return []
2012-02-15 05:52:48 +00:00
getSrcSpanType :: GhcMonad m => G.ModSummary -> Int -> Int -> m [(SrcSpan, Type)]
2014-04-11 03:19:42 +00:00
getSrcSpanType modSum lineNo colNo = do
2015-06-01 14:54:50 +00:00
p <- G.parseModule modSum
tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p
let bs = listifySpans tcs (lineNo, colNo) :: [LHsBind Id]
es = listifySpans tcs (lineNo, colNo) :: [LHsExpr Id]
ps = listifySpans tcs (lineNo, colNo) :: [LPat Id]
2016-01-18 00:51:03 +00:00
as = concatMap abtoex $ listifyAbsBinds tcs
abtoex (G.L _spn G.AbsBinds{abs_exports = es'})
= liftA2 (,) G.abe_mono (G.varType . G.abe_poly) `map` es'
abtoex _ = []
getType' b = getType tcm b >>= tryGetConstrainedType b
tryGetConstrainedType _ Nothing = return Nothing
tryGetConstrainedType b (Just gt) =
do
ids <- getId tcm b
return $ ct ids <|> Just gt
where
ct [pid] = (,) (fst gt) <$> lookup pid as
-- TODO: A case of multiple ids should probably
-- collect all constraints and then apply
-- them to calculated type. No idea how
-- to do that at the moment.
ct _ = Nothing
ets <- mapM getType' es
bts <- mapM getType' bs
pts <- mapM getType' ps
2015-06-01 14:54:50 +00:00
return $ catMaybes $ concat [ets, bts, pts]