module Evoke.Hsc
  ( addWarning
  , throwError
  ) where

import qualified Bag as Ghc
import qualified Control.Monad.IO.Class as IO
import qualified ErrUtils as Ghc
import qualified GhcPlugins as Ghc

-- | Adds a warning, which only causes compilation to fail if @-Werror@ is
-- enabled.
addWarning :: Ghc.SrcSpan -> Ghc.MsgDoc -> Ghc.Hsc ()
addWarning :: SrcSpan -> MsgDoc -> Hsc ()
addWarning SrcSpan
srcSpan MsgDoc
msgDoc = do
  DynFlags
dynFlags <- Hsc DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
Ghc.getDynFlags
  IO () -> Hsc ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
IO.liftIO
    (IO () -> Hsc ()) -> (WarnMsg -> IO ()) -> WarnMsg -> Hsc ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> Bag WarnMsg -> IO ()
Ghc.printOrThrowWarnings DynFlags
dynFlags
    (Bag WarnMsg -> IO ())
-> (WarnMsg -> Bag WarnMsg) -> WarnMsg -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WarnMsg -> Bag WarnMsg
forall a. a -> Bag a
Ghc.unitBag
    (WarnMsg -> Hsc ()) -> WarnMsg -> Hsc ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> SrcSpan -> MsgDoc -> WarnMsg
Ghc.mkPlainWarnMsg DynFlags
dynFlags SrcSpan
srcSpan MsgDoc
msgDoc

-- | Throws an error, which will cause compilation to fail.
throwError :: Ghc.SrcSpan -> Ghc.MsgDoc -> Ghc.Hsc a
throwError :: SrcSpan -> MsgDoc -> Hsc a
throwError SrcSpan
srcSpan MsgDoc
msgDoc = do
  DynFlags
dynFlags <- Hsc DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
Ghc.getDynFlags
  WarnMsg -> Hsc a
forall (io :: * -> *) a. MonadIO io => WarnMsg -> io a
Ghc.throwOneError (WarnMsg -> Hsc a) -> WarnMsg -> Hsc a
forall a b. (a -> b) -> a -> b
$ DynFlags -> SrcSpan -> MsgDoc -> WarnMsg
Ghc.mkPlainErrMsg DynFlags
dynFlags SrcSpan
srcSpan MsgDoc
msgDoc