module GHC.Driver.Config.Core.Lint.Interactive
  ( lintInteractiveExpr
  ) where

import GHC.Prelude

import GHC.Driver.Env
import GHC.Driver.Session
import GHC.Driver.Config.Core.Lint

import GHC.Core
import GHC.Core.Ppr

import GHC.Core.Lint
import GHC.Core.Lint.Interactive

--import GHC.Runtime.Context

import GHC.Data.Bag

import GHC.Utils.Outputable as Outputable

lintInteractiveExpr :: SDoc -- ^ The source of the linted expression
                    -> HscEnv
                    -> CoreExpr -> IO ()
lintInteractiveExpr :: SDoc -> HscEnv -> CoreExpr -> IO ()
lintInteractiveExpr SDoc
what HscEnv
hsc_env CoreExpr
expr
  | Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_DoCoreLinting DynFlags
dflags)
  = forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Just Bag SDoc
err <- LintConfig -> CoreExpr -> Maybe (Bag SDoc)
lintExpr (DynFlags -> [CoreBndr] -> LintConfig
initLintConfig DynFlags
dflags forall a b. (a -> b) -> a -> b
$ InteractiveContext -> [CoreBndr]
interactiveInScope forall a b. (a -> b) -> a -> b
$ HscEnv -> InteractiveContext
hsc_IC HscEnv
hsc_env) CoreExpr
expr
  = Logger -> Bool -> SDoc -> SDoc -> WarnsAndErrs -> IO ()
displayLintResults Logger
logger Bool
False SDoc
what (forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr CoreExpr
expr) (forall a. Bag a
emptyBag, Bag SDoc
err)
  | Bool
otherwise
  = forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
    logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env