2017-01-12 16:36:47 +01:00
|
|
|
module GhcMod.Info (
|
2014-07-11 03:10:37 +02:00
|
|
|
info
|
2014-04-21 14:04:58 +09:00
|
|
|
, types
|
2013-05-20 14:28:56 +09:00
|
|
|
) where
|
2010-11-12 16:27:50 +09:00
|
|
|
|
2014-01-08 12:03:32 +09:00
|
|
|
import Data.Function (on)
|
2014-06-21 11:38:44 +02:00
|
|
|
import Data.List (sortBy)
|
2015-03-03 21:12:43 +01:00
|
|
|
import System.FilePath
|
2014-04-11 11:51:25 +09:00
|
|
|
import Exception (ghandle, SomeException(..))
|
2016-01-19 22:50:14 +03:00
|
|
|
import GHC (GhcMonad, SrcSpan)
|
2015-08-03 03:09:56 +02:00
|
|
|
import Prelude
|
2014-03-27 15:56:14 +09:00
|
|
|
import qualified GHC as G
|
2015-03-03 21:12:43 +01:00
|
|
|
|
2017-01-12 16:36:47 +01:00
|
|
|
import qualified Language.Haskell.GhcMod.Gap as Gap
|
2015-03-03 21:12:43 +01:00
|
|
|
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
|
2014-06-28 21:43:51 +02:00
|
|
|
import Language.Haskell.GhcMod.Monad
|
2014-06-21 11:38:44 +02:00
|
|
|
import Language.Haskell.GhcMod.SrcUtils
|
2013-05-17 10:00:01 +09:00
|
|
|
import Language.Haskell.GhcMod.Types
|
2015-07-04 17:49:48 +03:00
|
|
|
import Language.Haskell.GhcMod.Utils (mkRevRedirMapFunc)
|
2015-07-03 22:31:52 +03:00
|
|
|
import Language.Haskell.GhcMod.FileMapping (fileModSummaryWithMapping)
|
2010-11-17 17:07:33 +09:00
|
|
|
|
2012-02-14 16:09:53 +09:00
|
|
|
----------------------------------------------------------------
|
2011-08-24 15:58:12 +09:00
|
|
|
|
2013-05-20 14:28:56 +09:00
|
|
|
-- | Obtaining information of a target expression. (GHCi's info:)
|
2014-07-12 11:16:16 +02:00
|
|
|
info :: IOish m
|
|
|
|
|
=> FilePath -- ^ A target file.
|
2013-09-05 14:35:28 +09:00
|
|
|
-> Expression -- ^ A Haskell expression.
|
2014-07-12 11:16:16 +02:00
|
|
|
-> GhcModT m String
|
2015-03-09 22:04:04 +01:00
|
|
|
info file expr =
|
2015-06-01 17:54:50 +03:00
|
|
|
ghandle handler $
|
|
|
|
|
runGmlT' [Left file] deferErrors $
|
2015-09-01 10:27:12 +02:00
|
|
|
withInteractiveContext $ do
|
|
|
|
|
convert' =<< body
|
2014-04-23 16:37:24 +09:00
|
|
|
where
|
2015-03-03 21:12:43 +01:00
|
|
|
handler (SomeException ex) = do
|
2016-12-15 19:16:37 +01:00
|
|
|
gmLog GmException "info" $ text "" $$ nest 4 (showToDoc ex)
|
2015-06-01 17:54:50 +03:00
|
|
|
convert' "Cannot show info"
|
2015-03-03 21:12:43 +01:00
|
|
|
|
2015-07-04 17:49:48 +03:00
|
|
|
body :: (GhcMonad m, GmState m, GmEnv m) => m String
|
2015-03-03 21:12:43 +01:00
|
|
|
body = do
|
2015-07-04 17:49:48 +03:00
|
|
|
m <- mkRevRedirMapFunc
|
|
|
|
|
sdoc <- Gap.infoThing m expr
|
2015-06-01 17:54:50 +03:00
|
|
|
st <- getStyle
|
|
|
|
|
dflag <- G.getSessionDynFlags
|
|
|
|
|
return $ showPage dflag st sdoc
|
2011-01-14 11:18:33 +09:00
|
|
|
|
2012-02-12 21:04:18 +09:00
|
|
|
----------------------------------------------------------------
|
|
|
|
|
|
2013-05-20 14:28:56 +09:00
|
|
|
-- | Obtaining type of a target expression. (GHCi's type:)
|
2014-07-12 11:16:16 +02:00
|
|
|
types :: IOish m
|
2016-01-20 01:29:33 +03:00
|
|
|
=> Bool -- ^ Include constraints into type signature
|
|
|
|
|
-> FilePath -- ^ A target file.
|
2014-04-21 14:04:58 +09:00
|
|
|
-> Int -- ^ Line number.
|
|
|
|
|
-> Int -- ^ Column number.
|
2014-07-12 11:16:16 +02:00
|
|
|
-> GhcModT m String
|
2016-01-20 01:29:33 +03:00
|
|
|
types withConstraints file lineNo colNo =
|
2015-06-01 17:54:50 +03:00
|
|
|
ghandle handler $
|
|
|
|
|
runGmlT' [Left file] deferErrors $
|
2015-08-21 04:12:53 +02:00
|
|
|
withInteractiveContext $ do
|
2015-06-01 17:54:50 +03:00
|
|
|
crdl <- cradle
|
2015-07-03 22:31:52 +03:00
|
|
|
modSum <- fileModSummaryWithMapping (cradleCurrentDir crdl </> file)
|
2016-01-20 01:29:33 +03:00
|
|
|
srcSpanTypes <- getSrcSpanType withConstraints modSum lineNo colNo
|
2015-06-01 17:54:50 +03:00
|
|
|
dflag <- G.getSessionDynFlags
|
|
|
|
|
st <- getStyle
|
2015-03-03 21:12:43 +01:00
|
|
|
convert' $ map (toTup dflag st) $ sortBy (cmp `on` fst) srcSpanTypes
|
|
|
|
|
where
|
2015-05-06 16:13:08 +02:00
|
|
|
handler (SomeException ex) = do
|
2016-12-15 19:16:37 +01:00
|
|
|
gmLog GmException "types" $ showToDoc ex
|
2015-05-06 16:13:08 +02:00
|
|
|
return []
|
2012-02-15 14:52:48 +09:00
|
|
|
|
2016-01-20 01:29:33 +03:00
|
|
|
getSrcSpanType :: (GhcMonad m) => Bool -> G.ModSummary -> Int -> Int -> m [(SrcSpan, G.Type)]
|
|
|
|
|
getSrcSpanType withConstraints modSum lineNo colNo =
|
2016-01-19 22:50:14 +03:00
|
|
|
G.parseModule modSum
|
|
|
|
|
>>= G.typecheckModule
|
2016-01-20 01:29:33 +03:00
|
|
|
>>= flip (collectSpansTypes withConstraints) (lineNo, colNo)
|