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

import GHC.Prelude

import GHC.Driver.Env
import GHC.Driver.DynFlags
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)
  = () -> IO ()
forall a. a -> IO a
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 ([CoreBndr] -> LintConfig) -> [CoreBndr] -> LintConfig
forall a b. (a -> b) -> a -> b
$ InteractiveContext -> [CoreBndr]
interactiveInScope (InteractiveContext -> [CoreBndr])
-> InteractiveContext -> [CoreBndr]
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 (CoreExpr -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr CoreExpr
expr) (Bag SDoc
forall a. Bag a
emptyBag, Bag SDoc
err)
  | Bool
otherwise
  = () -> IO ()
forall a. a -> IO a
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