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

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

import GHC (
    GenLocated (L),
    Ghc,
    LHsBind,
    LHsExpr,
    LPat,
    ModSummary,
    SrcSpan,
    Type,
    TypecheckedModule (..),
    mgModSummaries,
    mg_ext,
 )
import qualified GHC as G
import GHC.Core.Utils (exprType)
import GHC.Driver.Session (initSDocContext)
import GHC.Hs.Binds (HsBindLR (..))
import GHC.Hs.Expr (MatchGroupTc (..))
import GHC.Hs.Extension (GhcTc)
import GHC.HsToCore (deSugarExpr)
import GHC.Utils.Monad (liftIO)
import GHC.Utils.Outputable (SDocContext)

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

import Hhp.Doc (getStyle, showOneLine, showPage)
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 -> String -> String -> IO String
infoExpr Options
opt Cradle
cradle String
file String
expr = Ghc String -> IO String
forall a. Ghc a -> IO a
withGHC' (Ghc String -> IO String) -> Ghc String -> IO String
forall a b. (a -> b) -> a -> b
$ do
    Options -> Cradle -> Ghc ()
initializeFlagsWithCradle Options
opt Cradle
cradle
    Options -> String -> String -> Ghc String
info Options
opt String
file String
expr

-- | Obtaining information of a target expression. (GHCi's info:)
info
    :: Options
    -> FilePath
    -- ^ A target file.
    -> Expression
    -- ^ A Haskell expression.
    -> Ghc String
info :: Options -> String -> String -> Ghc String
info Options
opt String
file String
expr = Options -> String -> String
forall a. ToString a => Options -> a -> String
convert Options
opt (String -> String) -> Ghc String -> Ghc String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeException -> Ghc String) -> Ghc String -> Ghc String
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle SomeException -> Ghc String
forall {m :: * -> *}. Monad m => SomeException -> m String
handler Ghc String
body
  where
    body :: Ghc String
body = String -> (SDocContext -> Ghc String) -> Ghc String
forall a. String -> (SDocContext -> Ghc a) -> Ghc a
inModuleContext String
file ((SDocContext -> Ghc String) -> Ghc String)
-> (SDocContext -> Ghc String) -> Ghc String
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> do
        SDoc
sdoc <- String -> Ghc SDoc
infoThing String
expr
        String -> Ghc String
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Ghc String) -> String -> Ghc String
forall a b. (a -> b) -> a -> b
$ SDocContext -> SDoc -> String
showPage SDocContext
ctx SDoc
sdoc
    handler :: SomeException -> m String
handler (SomeException e
_e) = String -> m String
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ String
"Cannot show info: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ e -> String
forall a. Show a => a -> String
show e
_e

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

-- | 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 -> String -> Int -> Int -> IO String
typeExpr Options
opt Cradle
cradle String
file Int
lineNo Int
colNo = Ghc String -> IO String
forall a. Ghc a -> IO a
withGHC' (Ghc String -> IO String) -> Ghc String -> IO String
forall a b. (a -> b) -> a -> b
$ do
    Options -> Cradle -> Ghc ()
initializeFlagsWithCradle Options
opt Cradle
cradle
    Options -> String -> Int -> Int -> Ghc String
types Options
opt String
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 -> String -> Int -> Int -> Ghc String
types Options
opt String
file Int
lineNo Int
colNo = Options -> [((Int, Int, Int, Int), String)] -> String
forall a. ToString a => Options -> a -> String
convert Options
opt ([((Int, Int, Int, Int), String)] -> String)
-> Ghc [((Int, Int, Int, Int), String)] -> Ghc String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SomeException -> Ghc [((Int, Int, Int, Int), String)])
-> Ghc [((Int, Int, Int, Int), String)]
-> Ghc [((Int, Int, Int, Int), String)]
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
handle SomeException -> Ghc [((Int, Int, Int, Int), String)]
forall {m :: * -> *} {a}. Monad m => SomeException -> m [a]
handler Ghc [((Int, Int, Int, Int), String)]
body
  where
    body :: Ghc [((Int, Int, Int, Int), String)]
body = String
-> (SDocContext -> Ghc [((Int, Int, Int, Int), String)])
-> Ghc [((Int, Int, Int, Int), String)]
forall a. String -> (SDocContext -> Ghc a) -> Ghc a
inModuleContext String
file ((SDocContext -> Ghc [((Int, Int, Int, Int), String)])
 -> Ghc [((Int, Int, Int, Int), String)])
-> (SDocContext -> Ghc [((Int, Int, Int, Int), String)])
-> Ghc [((Int, Int, Int, Int), String)]
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx -> do
        ModSummary
modSum <- String -> Ghc ModSummary
fileModSummary String
file
        [(SrcSpan, Type)]
srcSpanTypes <- ModSummary -> Int -> Int -> Ghc [(SrcSpan, Type)]
getSrcSpanType ModSummary
modSum Int
lineNo Int
colNo
        [((Int, Int, Int, Int), String)]
-> Ghc [((Int, Int, Int, Int), String)]
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return ([((Int, Int, Int, Int), String)]
 -> Ghc [((Int, Int, Int, Int), String)])
-> [((Int, Int, Int, Int), String)]
-> Ghc [((Int, Int, Int, Int), String)]
forall a b. (a -> b) -> a -> b
$ ((SrcSpan, Type) -> ((Int, Int, Int, Int), String))
-> [(SrcSpan, Type)] -> [((Int, Int, Int, Int), String)]
forall a b. (a -> b) -> [a] -> [b]
map (SDocContext -> (SrcSpan, Type) -> ((Int, Int, Int, Int), String)
toTup SDocContext
ctx) ([(SrcSpan, Type)] -> [((Int, Int, Int, Int), String)])
-> [(SrcSpan, Type)] -> [((Int, Int, Int, Int), String)]
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []

type LExpression = LHsExpr GhcTc
type LBinding = LHsBind GhcTc
type LPattern = LPat GhcTc

getSrcSpanType :: 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) -> [LOC (HsExpr GhcTc)]
forall a. Typeable a => TypecheckedSource -> (Int, Int) -> [LOC a]
listifySpans TypecheckedSource
tcs (Int
lineNo, Int
colNo) :: [LExpression]
        bs :: [LBinding]
bs = TypecheckedSource -> (Int, Int) -> [LOC (HsBindLR GhcTc GhcTc)]
forall a. Typeable a => TypecheckedSource -> (Int, Int) -> [LOC a]
listifySpans TypecheckedSource
tcs (Int
lineNo, Int
colNo) :: [LBinding]
        ps :: [LPattern]
ps = TypecheckedSource -> (Int, Int) -> [LOC (Pat GhcTc)]
forall a. Typeable a => TypecheckedSource -> (Int, Int) -> [LOC a]
listifySpans TypecheckedSource
tcs (Int
lineNo, Int
colNo) :: [LPattern]
    [Maybe (SrcSpan, Type)]
ets <- (LOC (HsExpr GhcTc) -> Ghc (Maybe (SrcSpan, Type)))
-> [LOC (HsExpr GhcTc)] -> Ghc [Maybe (SrcSpan, Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (TypecheckedModule -> LExpression -> Ghc (Maybe (SrcSpan, Type))
getTypeLExpression TypecheckedModule
tcm) [LOC (HsExpr GhcTc)]
es
    [Maybe (SrcSpan, Type)]
bts <- (LOC (HsBindLR GhcTc GhcTc) -> Ghc (Maybe (SrcSpan, Type)))
-> [LOC (HsBindLR GhcTc GhcTc)] -> Ghc [Maybe (SrcSpan, Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (TypecheckedModule -> LBinding -> Ghc (Maybe (SrcSpan, Type))
getTypeLBinding TypecheckedModule
tcm) [LOC (HsBindLR GhcTc GhcTc)]
bs
    [Maybe (SrcSpan, Type)]
pts <- (LOC (Pat GhcTc) -> Ghc (Maybe (SrcSpan, Type)))
-> [LOC (Pat GhcTc)] -> Ghc [Maybe (SrcSpan, Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (TypecheckedModule -> LPattern -> Ghc (Maybe (SrcSpan, Type))
getTypeLPattern TypecheckedModule
tcm) [LOC (Pat GhcTc)]
ps
    [(SrcSpan, Type)] -> Ghc [(SrcSpan, Type)]
forall a. a -> Ghc a
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 :: SDocContext -> (SrcSpan, Type) -> ((Int, Int, Int, Int), String)
toTup :: SDocContext -> (SrcSpan, Type) -> ((Int, Int, Int, Int), String)
toTup SDocContext
ctx (SrcSpan
spn, Type
typ) = (SrcSpan -> (Int, Int, Int, Int)
fourInts SrcSpan
spn, SDocContext -> Type -> String
pretty SDocContext
ctx 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 :: SDocContext -> Type -> String
pretty :: SDocContext -> Type -> String
pretty SDocContext
ctx = SDocContext -> SDoc -> String
showOneLine SDocContext
ctx (SDoc -> String) -> (Type -> SDoc) -> Type -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> SDoc
pprSigmaType

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

inModuleContext :: FilePath -> (SDocContext -> Ghc a) -> Ghc a
inModuleContext :: forall a. String -> (SDocContext -> Ghc a) -> Ghc a
inModuleContext String
file SDocContext -> 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
setNoWarningFlags) (Ghc a -> Ghc a) -> Ghc a -> Ghc a
forall a b. (a -> b) -> a -> b
$ do
        [String] -> Ghc ()
setTargetFiles [String
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 <- Ghc PprStyle
getStyle
            SDocContext -> Ghc a
action (SDocContext -> Ghc a) -> SDocContext -> Ghc a
forall a b. (a -> b) -> a -> b
$ DynFlags -> PprStyle -> SDocContext
initSDocContext DynFlags
dflag PprStyle
style

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

fileModSummary :: FilePath -> Ghc ModSummary
fileModSummary :: String -> Ghc ModSummary
fileModSummary String
file = do
    [ModSummary]
mss <- ModuleGraph -> [ModSummary]
mgModSummaries (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 xs :: [ModSummary]
xs = (ModSummary -> Bool) -> [ModSummary] -> [ModSummary]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ModSummary
m -> ModLocation -> Maybe String
G.ml_hs_file (ModSummary -> ModLocation
G.ms_location ModSummary
m) Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
file) [ModSummary]
mss
    case [ModSummary]
xs of
        [ModSummary
ms] -> ModSummary -> Ghc ModSummary
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return ModSummary
ms
        [ModSummary]
_ -> String -> Ghc ModSummary
forall a. HasCallStack => String -> a
error String
"fileModSummary"

withContext :: Ghc a -> Ghc a
withContext :: forall a. Ghc a -> Ghc a
withContext Ghc a
action = Ghc [InteractiveImport]
-> ([InteractiveImport] -> Ghc ())
-> ([InteractiveImport] -> Ghc a)
-> Ghc a
forall (m :: * -> *) a c b.
(HasCallStack, MonadMask m) =>
m a -> (a -> m c) -> (a -> m b) -> m b
bracket 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 a b. Ghc a -> (a -> Ghc b) -> Ghc b
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]
mgModSummaries (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 a. Ghc a -> Ghc a -> Ghc a
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 a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    returnFalse :: Ghc Bool
returnFalse = Bool -> Ghc Bool
forall a. a -> Ghc a
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
forall unit. GenModule unit -> 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

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

getTypeLExpression
    :: TypecheckedModule -> LExpression -> Ghc (Maybe (SrcSpan, Type))
getTypeLExpression :: TypecheckedModule -> LExpression -> Ghc (Maybe (SrcSpan, Type))
getTypeLExpression TypecheckedModule
_ e :: LExpression
e@(L SrcSpanAnn' (EpAnn AnnListItem)
spnA HsExpr GhcTc
_) = do
    HscEnv
hs_env <- Ghc HscEnv
forall (m :: * -> *). GhcMonad m => m HscEnv
G.getSession
    (Messages DsMessage
_, Maybe CoreExpr
mbc) <- IO (Messages DsMessage, Maybe CoreExpr)
-> Ghc (Messages DsMessage, Maybe CoreExpr)
forall a. IO a -> Ghc a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Messages DsMessage, Maybe CoreExpr)
 -> Ghc (Messages DsMessage, Maybe CoreExpr))
-> IO (Messages DsMessage, Maybe CoreExpr)
-> Ghc (Messages DsMessage, Maybe CoreExpr)
forall a b. (a -> b) -> a -> b
$ HscEnv -> LExpression -> IO (Messages DsMessage, Maybe CoreExpr)
deSugarExpr HscEnv
hs_env LExpression
e
    let spn :: SrcSpan
spn = SrcSpanAnn' (EpAnn AnnListItem) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn AnnListItem)
spnA
    Maybe (SrcSpan, Type) -> Ghc (Maybe (SrcSpan, Type))
forall a. a -> Ghc a
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
spn,) (Type -> (SrcSpan, Type))
-> (CoreExpr -> Type) -> CoreExpr -> (SrcSpan, Type)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() :: Constraint) => CoreExpr -> Type
CoreExpr -> Type
exprType (CoreExpr -> (SrcSpan, Type))
-> Maybe CoreExpr -> Maybe (SrcSpan, Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe CoreExpr
mbc

getTypeLBinding :: TypecheckedModule -> LBinding -> Ghc (Maybe (SrcSpan, Type))
getTypeLBinding :: TypecheckedModule -> LBinding -> Ghc (Maybe (SrcSpan, Type))
getTypeLBinding TypecheckedModule
_ (L SrcSpanAnn' (EpAnn AnnListItem)
spnA 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 a. a -> Ghc a
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 :: [Scaled Type]
in_tys = MatchGroupTc -> [Scaled Type]
mg_arg_tys (MatchGroupTc -> [Scaled Type]) -> MatchGroupTc -> [Scaled Type]
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcTc LExpression -> XMG GhcTc LExpression
forall p body. MatchGroup p body -> XMG p body
mg_ext MatchGroup GhcTc LExpression
m
    out_typ :: Type
out_typ = MatchGroupTc -> Type
mg_res_ty (MatchGroupTc -> Type) -> MatchGroupTc -> Type
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcTc LExpression -> XMG GhcTc LExpression
forall p body. MatchGroup p body -> XMG p body
mg_ext MatchGroup GhcTc LExpression
m
    typ :: Type
typ = [Scaled Type] -> Type -> Type
mkScaledFunctionTys [Scaled Type]
in_tys Type
out_typ
    spn :: SrcSpan
spn = SrcSpanAnn' (EpAnn AnnListItem) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn AnnListItem)
spnA
getTypeLBinding TypecheckedModule
_ LBinding
_ = Maybe (SrcSpan, Type) -> Ghc (Maybe (SrcSpan, Type))
forall a. a -> Ghc a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (SrcSpan, Type)
forall a. Maybe a
Nothing

getTypeLPattern :: TypecheckedModule -> LPattern -> Ghc (Maybe (SrcSpan, Type))
getTypeLPattern :: TypecheckedModule -> LPattern -> Ghc (Maybe (SrcSpan, Type))
getTypeLPattern TypecheckedModule
_ (L SrcSpanAnn' (EpAnn AnnListItem)
spnA Pat GhcTc
pat) = Maybe (SrcSpan, Type) -> Ghc (Maybe (SrcSpan, Type))
forall a. a -> Ghc a
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 (SrcSpanAnn' (EpAnn AnnListItem) -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
locA SrcSpanAnn' (EpAnn AnnListItem)
spnA, Pat GhcTc -> Type
hsPatType Pat GhcTc
pat)