{-# LANGUAGE TupleSections, FlexibleInstances, Rank2Types #-}

module Hhp.Info (
    infoExpr
  , info
  , typeExpr
  , types
  ) where

import CoreMonad (liftIO)
import CoreUtils (exprType)
import Desugar (deSugarExpr)
import Exception (ghandle, SomeException(..))
import GHC (Ghc, TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
import qualified GHC as G

import HscTypes (ModSummary)
import Outputable (PprStyle)
import PprTyThing
import TcHsSyn (hsPatType)

import Control.Applicative ((<|>))
import Control.Monad (filterM)
import Data.Function (on)
import Data.List (sortBy)
import Data.Maybe (catMaybes, fromMaybe)
import Data.Ord as O

import Hhp.Doc (showPage, showOneLine, getStyle)
import Hhp.GHCApi
import Hhp.Gap
import Hhp.Logger (getSrcSpan)
import Hhp.Syb
import Hhp.Things
import Hhp.Types

----------------------------------------------------------------

-- | Obtaining information of a target expression. (GHCi's info:)
infoExpr :: Options
         -> Cradle
         -> FilePath     -- ^ A target file.
         -> Expression   -- ^ A Haskell expression.
         -> IO String
infoExpr :: Options -> Cradle -> FilePath -> FilePath -> IO FilePath
infoExpr Options
opt Cradle
cradle FilePath
file FilePath
expr = Ghc FilePath -> IO FilePath
forall a. Ghc a -> IO a
withGHC' (Ghc FilePath -> IO FilePath) -> Ghc FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ do
    Options -> Cradle -> Ghc ()
initializeFlagsWithCradle Options
opt Cradle
cradle
    Options -> FilePath -> FilePath -> Ghc FilePath
info Options
opt FilePath
file FilePath
expr

-- | Obtaining information of a target expression. (GHCi's info:)
info :: Options
     -> FilePath     -- ^ A target file.
     -> Expression   -- ^ A Haskell expression.
     -> Ghc String
info :: Options -> FilePath -> FilePath -> Ghc FilePath
info Options
opt FilePath
file FilePath
expr = Options -> FilePath -> FilePath
forall a. ToString a => Options -> a -> FilePath
convert Options
opt (FilePath -> FilePath) -> Ghc FilePath -> Ghc FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeException -> Ghc FilePath) -> Ghc FilePath -> Ghc FilePath
forall (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
(e -> m a) -> m a -> m a
ghandle SomeException -> Ghc FilePath
forall (m :: * -> *). Monad m => SomeException -> m FilePath
handler Ghc FilePath
body
  where
    body :: Ghc FilePath
body = FilePath -> (DynFlags -> PprStyle -> Ghc FilePath) -> Ghc FilePath
forall a. FilePath -> (DynFlags -> PprStyle -> Ghc a) -> Ghc a
inModuleContext FilePath
file ((DynFlags -> PprStyle -> Ghc FilePath) -> Ghc FilePath)
-> (DynFlags -> PprStyle -> Ghc FilePath) -> Ghc FilePath
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflag PprStyle
style -> do
        SDoc
sdoc <- FilePath -> Ghc SDoc
infoThing FilePath
expr
        FilePath -> Ghc FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Ghc FilePath) -> FilePath -> Ghc FilePath
forall a b. (a -> b) -> a -> b
$ DynFlags -> PprStyle -> SDoc -> FilePath
showPage DynFlags
dflag PprStyle
style SDoc
sdoc
    handler :: SomeException -> m FilePath
handler (SomeException e
_) = FilePath -> m FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
"Cannot show info"

----------------------------------------------------------------

-- | Obtaining type of a target expression. (GHCi's type:)
typeExpr :: Options
         -> Cradle
         -> FilePath     -- ^ A target file.
         -> Int          -- ^ Line number.
         -> Int          -- ^ Column number.
         -> IO String
typeExpr :: Options -> Cradle -> FilePath -> Int -> Int -> IO FilePath
typeExpr Options
opt Cradle
cradle FilePath
file Int
lineNo Int
colNo = Ghc FilePath -> IO FilePath
forall a. Ghc a -> IO a
withGHC' (Ghc FilePath -> IO FilePath) -> Ghc FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ do
    Options -> Cradle -> Ghc ()
initializeFlagsWithCradle Options
opt Cradle
cradle
    Options -> FilePath -> Int -> Int -> Ghc FilePath
types Options
opt FilePath
file Int
lineNo Int
colNo

-- | Obtaining type of a target expression. (GHCi's type:)
types :: Options
      -> FilePath     -- ^ A target file.
      -> Int          -- ^ Line number.
      -> Int          -- ^ Column number.
      -> Ghc String
types :: Options -> FilePath -> Int -> Int -> Ghc FilePath
types Options
opt FilePath
file Int
lineNo Int
colNo = Options -> [((Int, Int, Int, Int), FilePath)] -> FilePath
forall a. ToString a => Options -> a -> FilePath
convert Options
opt ([((Int, Int, Int, Int), FilePath)] -> FilePath)
-> Ghc [((Int, Int, Int, Int), FilePath)] -> Ghc FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeException -> Ghc [((Int, Int, Int, Int), FilePath)])
-> Ghc [((Int, Int, Int, Int), FilePath)]
-> Ghc [((Int, Int, Int, Int), FilePath)]
forall (m :: * -> *) e a.
(ExceptionMonad m, Exception e) =>
(e -> m a) -> m a -> m a
ghandle SomeException -> Ghc [((Int, Int, Int, Int), FilePath)]
forall (m :: * -> *) a. Monad m => SomeException -> m [a]
handler Ghc [((Int, Int, Int, Int), FilePath)]
body
  where
    body :: Ghc [((Int, Int, Int, Int), FilePath)]
body = FilePath
-> (DynFlags -> PprStyle -> Ghc [((Int, Int, Int, Int), FilePath)])
-> Ghc [((Int, Int, Int, Int), FilePath)]
forall a. FilePath -> (DynFlags -> PprStyle -> Ghc a) -> Ghc a
inModuleContext FilePath
file ((DynFlags -> PprStyle -> Ghc [((Int, Int, Int, Int), FilePath)])
 -> Ghc [((Int, Int, Int, Int), FilePath)])
-> (DynFlags -> PprStyle -> Ghc [((Int, Int, Int, Int), FilePath)])
-> Ghc [((Int, Int, Int, Int), FilePath)]
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflag PprStyle
style -> do
        ModSummary
modSum <- FilePath -> Ghc ModSummary
fileModSummary FilePath
file
        [(SrcSpan, Type)]
srcSpanTypes <- ModSummary -> Int -> Int -> Ghc [(SrcSpan, Type)]
getSrcSpanType ModSummary
modSum Int
lineNo Int
colNo
        [((Int, Int, Int, Int), FilePath)]
-> Ghc [((Int, Int, Int, Int), FilePath)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([((Int, Int, Int, Int), FilePath)]
 -> Ghc [((Int, Int, Int, Int), FilePath)])
-> [((Int, Int, Int, Int), FilePath)]
-> Ghc [((Int, Int, Int, Int), FilePath)]
forall a b. (a -> b) -> a -> b
$ ((SrcSpan, Type) -> ((Int, Int, Int, Int), FilePath))
-> [(SrcSpan, Type)] -> [((Int, Int, Int, Int), FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (DynFlags
-> PprStyle -> (SrcSpan, Type) -> ((Int, Int, Int, Int), FilePath)
toTup DynFlags
dflag PprStyle
style) ([(SrcSpan, Type)] -> [((Int, Int, Int, Int), FilePath)])
-> [(SrcSpan, Type)] -> [((Int, Int, Int, Int), FilePath)]
forall a b. (a -> b) -> a -> b
$ ((SrcSpan, Type) -> (SrcSpan, Type) -> Ordering)
-> [(SrcSpan, Type)] -> [(SrcSpan, Type)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (SrcSpan -> SrcSpan -> Ordering
cmp (SrcSpan -> SrcSpan -> Ordering)
-> ((SrcSpan, Type) -> SrcSpan)
-> (SrcSpan, Type)
-> (SrcSpan, Type)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (SrcSpan, Type) -> SrcSpan
forall a b. (a, b) -> a
fst) [(SrcSpan, Type)]
srcSpanTypes
    handler :: SomeException -> m [a]
handler (SomeException e
_) = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return []

getSrcSpanType :: G.ModSummary -> Int -> Int -> Ghc [(SrcSpan, Type)]
getSrcSpanType :: ModSummary -> Int -> Int -> Ghc [(SrcSpan, Type)]
getSrcSpanType ModSummary
modSum Int
lineNo Int
colNo = do
    ParsedModule
p <- ModSummary -> Ghc ParsedModule
forall (m :: * -> *). GhcMonad m => ModSummary -> m ParsedModule
G.parseModule ModSummary
modSum
    tcm :: TypecheckedModule
tcm@TypecheckedModule{tm_typechecked_source :: TypecheckedModule -> TypecheckedSource
tm_typechecked_source = TypecheckedSource
tcs} <- ParsedModule -> Ghc TypecheckedModule
forall (m :: * -> *).
GhcMonad m =>
ParsedModule -> m TypecheckedModule
G.typecheckModule ParsedModule
p
    let es :: [LExpression]
es = TypecheckedSource -> (Int, Int) -> [LExpression]
forall a.
Typeable a =>
TypecheckedSource -> (Int, Int) -> [Located a]
listifySpans TypecheckedSource
tcs (Int
lineNo, Int
colNo) :: [LExpression]
        bs :: [LBinding]
bs = TypecheckedSource -> (Int, Int) -> [LBinding]
forall a.
Typeable a =>
TypecheckedSource -> (Int, Int) -> [Located a]
listifySpans TypecheckedSource
tcs (Int
lineNo, Int
colNo) :: [LBinding]
        ps :: [LPattern]
ps = TypecheckedSource -> (Int, Int) -> [LPattern]
forall a.
Typeable a =>
TypecheckedSource -> (Int, Int) -> [Located a]
listifySpans TypecheckedSource
tcs (Int
lineNo, Int
colNo) :: [LPattern]
    [Maybe (SrcSpan, Type)]
ets <- (LExpression -> Ghc (Maybe (SrcSpan, Type)))
-> [LExpression] -> Ghc [Maybe (SrcSpan, Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TypecheckedModule -> LExpression -> Ghc (Maybe (SrcSpan, Type))
forall a.
HasType a =>
TypecheckedModule -> a -> Ghc (Maybe (SrcSpan, Type))
getType TypecheckedModule
tcm) [LExpression]
es
    [Maybe (SrcSpan, Type)]
bts <- (LBinding -> Ghc (Maybe (SrcSpan, Type)))
-> [LBinding] -> Ghc [Maybe (SrcSpan, Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TypecheckedModule -> LBinding -> Ghc (Maybe (SrcSpan, Type))
forall a.
HasType a =>
TypecheckedModule -> a -> Ghc (Maybe (SrcSpan, Type))
getType TypecheckedModule
tcm) [LBinding]
bs
    [Maybe (SrcSpan, Type)]
pts <- (LPattern -> Ghc (Maybe (SrcSpan, Type)))
-> [LPattern] -> Ghc [Maybe (SrcSpan, Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (TypecheckedModule -> LPattern -> Ghc (Maybe (SrcSpan, Type))
forall a.
HasType a =>
TypecheckedModule -> a -> Ghc (Maybe (SrcSpan, Type))
getType TypecheckedModule
tcm) [LPattern]
ps
    [(SrcSpan, Type)] -> Ghc [(SrcSpan, Type)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(SrcSpan, Type)] -> Ghc [(SrcSpan, Type)])
-> [(SrcSpan, Type)] -> Ghc [(SrcSpan, Type)]
forall a b. (a -> b) -> a -> b
$ [Maybe (SrcSpan, Type)] -> [(SrcSpan, Type)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (SrcSpan, Type)] -> [(SrcSpan, Type)])
-> [Maybe (SrcSpan, Type)] -> [(SrcSpan, Type)]
forall a b. (a -> b) -> a -> b
$ [[Maybe (SrcSpan, Type)]] -> [Maybe (SrcSpan, Type)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Maybe (SrcSpan, Type)]
ets, [Maybe (SrcSpan, Type)]
bts, [Maybe (SrcSpan, Type)]
pts]

cmp :: SrcSpan -> SrcSpan -> Ordering
cmp :: SrcSpan -> SrcSpan -> Ordering
cmp SrcSpan
a SrcSpan
b
  | SrcSpan
a SrcSpan -> SrcSpan -> Bool
`G.isSubspanOf` SrcSpan
b = Ordering
O.LT
  | SrcSpan
b SrcSpan -> SrcSpan -> Bool
`G.isSubspanOf` SrcSpan
a = Ordering
O.GT
  | Bool
otherwise           = Ordering
O.EQ

toTup :: DynFlags -> PprStyle -> (SrcSpan, Type) -> ((Int,Int,Int,Int),String)
toTup :: DynFlags
-> PprStyle -> (SrcSpan, Type) -> ((Int, Int, Int, Int), FilePath)
toTup DynFlags
dflag PprStyle
style (SrcSpan
spn, Type
typ) = (SrcSpan -> (Int, Int, Int, Int)
fourInts SrcSpan
spn, DynFlags -> PprStyle -> Type -> FilePath
pretty DynFlags
dflag PprStyle
style Type
typ)

fourInts :: SrcSpan -> (Int,Int,Int,Int)
fourInts :: SrcSpan -> (Int, Int, Int, Int)
fourInts = (Int, Int, Int, Int)
-> Maybe (Int, Int, Int, Int) -> (Int, Int, Int, Int)
forall a. a -> Maybe a -> a
fromMaybe (Int
0,Int
0,Int
0,Int
0) (Maybe (Int, Int, Int, Int) -> (Int, Int, Int, Int))
-> (SrcSpan -> Maybe (Int, Int, Int, Int))
-> SrcSpan
-> (Int, Int, Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> Maybe (Int, Int, Int, Int)
getSrcSpan

pretty :: DynFlags -> PprStyle -> Type -> String
pretty :: DynFlags -> PprStyle -> Type -> FilePath
pretty DynFlags
dflag PprStyle
style = DynFlags -> PprStyle -> SDoc -> FilePath
showOneLine DynFlags
dflag PprStyle
style (SDoc -> FilePath) -> (Type -> SDoc) -> Type -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> SDoc
pprTypeForUser

----------------------------------------------------------------

inModuleContext :: FilePath -> (DynFlags -> PprStyle -> Ghc a) -> Ghc a
inModuleContext :: FilePath -> (DynFlags -> PprStyle -> Ghc a) -> Ghc a
inModuleContext FilePath
file DynFlags -> PprStyle -> Ghc a
action =
    (DynFlags -> DynFlags) -> Ghc a -> Ghc a
forall a. (DynFlags -> DynFlags) -> Ghc a -> Ghc a
withDynFlags (DynFlags -> DynFlags
setWarnTypedHoles (DynFlags -> DynFlags)
-> (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> DynFlags
setDeferTypeErrors (DynFlags -> DynFlags)
-> (DynFlags -> DynFlags) -> DynFlags -> DynFlags
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> DynFlags
setNoWaringFlags) (Ghc a -> Ghc a) -> Ghc a -> Ghc a
forall a b. (a -> b) -> a -> b
$ do
    [FilePath] -> Ghc ()
setTargetFiles [FilePath
file]
    Ghc a -> Ghc a
forall a. Ghc a -> Ghc a
withContext (Ghc a -> Ghc a) -> Ghc a -> Ghc a
forall a b. (a -> b) -> a -> b
$ do
        DynFlags
dflag <- Ghc DynFlags
forall (m :: * -> *). GhcMonad m => m DynFlags
G.getSessionDynFlags
        PprStyle
style <- DynFlags -> Ghc PprStyle
getStyle DynFlags
dflag
        DynFlags -> PprStyle -> Ghc a
action DynFlags
dflag PprStyle
style

----------------------------------------------------------------

fileModSummary :: FilePath -> Ghc ModSummary
fileModSummary :: FilePath -> Ghc ModSummary
fileModSummary FilePath
file = do
    [ModSummary]
mss <- ModuleGraph -> [ModSummary]
getModSummaries (ModuleGraph -> [ModSummary])
-> Ghc ModuleGraph -> Ghc [ModSummary]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ghc ModuleGraph
forall (m :: * -> *). GhcMonad m => m ModuleGraph
G.getModuleGraph
    let [ModSummary
ms] = (ModSummary -> Bool) -> [ModSummary] -> [ModSummary]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ModSummary
m -> ModLocation -> Maybe FilePath
G.ml_hs_file (ModSummary -> ModLocation
G.ms_location ModSummary
m) Maybe FilePath -> Maybe FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
file) [ModSummary]
mss
    ModSummary -> Ghc ModSummary
forall (m :: * -> *) a. Monad m => a -> m a
return ModSummary
ms

withContext :: Ghc a -> Ghc a
withContext :: Ghc a -> Ghc a
withContext Ghc a
action = Ghc [InteractiveImport]
-> ([InteractiveImport] -> Ghc ())
-> ([InteractiveImport] -> Ghc a)
-> Ghc a
forall (m :: * -> *) a b c.
ExceptionMonad m =>
m a -> (a -> m b) -> (a -> m c) -> m c
G.gbracket Ghc [InteractiveImport]
setup [InteractiveImport] -> Ghc ()
teardown [InteractiveImport] -> Ghc a
forall p. p -> Ghc a
body
  where
    setup :: Ghc [InteractiveImport]
setup = Ghc [InteractiveImport]
forall (m :: * -> *). GhcMonad m => m [InteractiveImport]
G.getContext
    teardown :: [InteractiveImport] -> Ghc ()
teardown = [InteractiveImport] -> Ghc ()
setCtx
    body :: p -> Ghc a
body p
_ = do
        Ghc [InteractiveImport]
topImports Ghc [InteractiveImport]
-> ([InteractiveImport] -> Ghc ()) -> Ghc ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [InteractiveImport] -> Ghc ()
setCtx
        Ghc a
action
    topImports :: Ghc [InteractiveImport]
topImports = do
        [ModSummary]
mss <- ModuleGraph -> [ModSummary]
getModSummaries (ModuleGraph -> [ModSummary])
-> Ghc ModuleGraph -> Ghc [ModSummary]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ghc ModuleGraph
forall (m :: * -> *). GhcMonad m => m ModuleGraph
G.getModuleGraph
        (ModSummary -> InteractiveImport)
-> [ModSummary] -> [InteractiveImport]
forall a b. (a -> b) -> [a] -> [b]
map ModSummary -> InteractiveImport
modName ([ModSummary] -> [InteractiveImport])
-> Ghc [ModSummary] -> Ghc [InteractiveImport]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ModSummary -> Ghc Bool) -> [ModSummary] -> Ghc [ModSummary]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ModSummary -> Ghc Bool
isTop [ModSummary]
mss
    isTop :: ModSummary -> Ghc Bool
isTop ModSummary
mos = ModSummary -> Ghc Bool
forall (m :: * -> *). GhcMonad m => ModSummary -> m Bool
lookupMod ModSummary
mos Ghc Bool -> Ghc Bool -> Ghc Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Ghc Bool
returnFalse
    lookupMod :: ModSummary -> m Bool
lookupMod ModSummary
mos = ModuleName -> Maybe FastString -> m Module
forall (m :: * -> *).
GhcMonad m =>
ModuleName -> Maybe FastString -> m Module
G.lookupModule (ModSummary -> ModuleName
G.ms_mod_name ModSummary
mos) Maybe FastString
forall a. Maybe a
Nothing m Module -> m Bool -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    returnFalse :: Ghc Bool
returnFalse = Bool -> Ghc Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    modName :: ModSummary -> InteractiveImport
modName = ModuleName -> InteractiveImport
G.IIModule (ModuleName -> InteractiveImport)
-> (ModSummary -> ModuleName) -> ModSummary -> InteractiveImport
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> ModuleName
G.moduleName (Module -> ModuleName)
-> (ModSummary -> Module) -> ModSummary -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModSummary -> Module
G.ms_mod
    setCtx :: [InteractiveImport] -> Ghc ()
setCtx = [InteractiveImport] -> Ghc ()
forall (m :: * -> *). GhcMonad m => [InteractiveImport] -> m ()
G.setContext

----------------------------------------------------------------

class HasType a where
    getType :: TypecheckedModule -> a -> Ghc (Maybe (SrcSpan, Type))

instance HasType LExpression where
    getType :: TypecheckedModule -> LExpression -> Ghc (Maybe (SrcSpan, Type))
getType TypecheckedModule
_ LExpression
e = do
        HscEnv
hs_env <- Ghc HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
G.getSession
        Maybe CoreExpr
mbe <- IO (Maybe CoreExpr) -> Ghc (Maybe CoreExpr)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe CoreExpr) -> Ghc (Maybe CoreExpr))
-> IO (Maybe CoreExpr) -> Ghc (Maybe CoreExpr)
forall a b. (a -> b) -> a -> b
$ (Messages, Maybe CoreExpr) -> Maybe CoreExpr
forall a b. (a, b) -> b
snd ((Messages, Maybe CoreExpr) -> Maybe CoreExpr)
-> IO (Messages, Maybe CoreExpr) -> IO (Maybe CoreExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HscEnv -> LExpression -> IO (Messages, Maybe CoreExpr)
deSugarExpr HscEnv
hs_env LExpression
e
        Maybe (SrcSpan, Type) -> Ghc (Maybe (SrcSpan, Type))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SrcSpan, Type) -> Ghc (Maybe (SrcSpan, Type)))
-> Maybe (SrcSpan, Type) -> Ghc (Maybe (SrcSpan, Type))
forall a b. (a -> b) -> a -> b
$ (LExpression -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
G.getLoc LExpression
e, ) (Type -> (SrcSpan, Type))
-> (CoreExpr -> Type) -> CoreExpr -> (SrcSpan, Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CoreExpr -> Type
CoreUtils.exprType (CoreExpr -> (SrcSpan, Type))
-> Maybe CoreExpr -> Maybe (SrcSpan, Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CoreExpr
mbe

instance HasType LBinding where
    getType :: TypecheckedModule -> LBinding -> Ghc (Maybe (SrcSpan, Type))
getType TypecheckedModule
_ (L SrcSpan
spn FunBind{fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MatchGroup GhcTc LExpression
m}) = Maybe (SrcSpan, Type) -> Ghc (Maybe (SrcSpan, Type))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SrcSpan, Type) -> Ghc (Maybe (SrcSpan, Type)))
-> Maybe (SrcSpan, Type) -> Ghc (Maybe (SrcSpan, Type))
forall a b. (a -> b) -> a -> b
$ (SrcSpan, Type) -> Maybe (SrcSpan, Type)
forall a. a -> Maybe a
Just (SrcSpan
spn, Type
typ)
      where
        in_tys :: [Type]
in_tys  = MatchGroup GhcTc LExpression -> [Type]
inTypes MatchGroup GhcTc LExpression
m
        out_typ :: Type
out_typ = MatchGroup GhcTc LExpression -> Type
outType MatchGroup GhcTc LExpression
m
        typ :: Type
typ = [Type] -> Type -> Type
mkFunTys [Type]
in_tys Type
out_typ
    getType TypecheckedModule
_ LBinding
_ = Maybe (SrcSpan, Type) -> Ghc (Maybe (SrcSpan, Type))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SrcSpan, Type)
forall a. Maybe a
Nothing

instance HasType LPattern where
    getType :: TypecheckedModule -> LPattern -> Ghc (Maybe (SrcSpan, Type))
getType TypecheckedModule
_ (G.L SrcSpan
spn Pat GhcTc
pat) = Maybe (SrcSpan, Type) -> Ghc (Maybe (SrcSpan, Type))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (SrcSpan, Type) -> Ghc (Maybe (SrcSpan, Type)))
-> Maybe (SrcSpan, Type) -> Ghc (Maybe (SrcSpan, Type))
forall a b. (a -> b) -> a -> b
$ (SrcSpan, Type) -> Maybe (SrcSpan, Type)
forall a. a -> Maybe a
Just (SrcSpan
spn, Pat GhcTc -> Type
hsPatType Pat GhcTc
pat)