module Evoke.Hsc
  ( addWarning,
    throwError,
  )
where

import qualified Control.Monad.IO.Class as IO
import qualified GHC as Ghc
import qualified GHC.Data.Bag as Ghc
import qualified GHC.Driver.Errors as Ghc
import qualified GHC.Plugins as Ghc
import qualified GHC.Utils.Error as Ghc

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

-- | Throws an error, which will cause compilation to fail.
throwError :: Ghc.SrcSpan -> Ghc.SDoc -> Ghc.Hsc a
throwError :: forall a. SrcSpan -> SDoc -> Hsc a
throwError SrcSpan
srcSpan SDoc
msgDoc = do
  forall (io :: * -> *) a.
MonadIO io =>
MsgEnvelope DecoratedSDoc -> io a
Ghc.throwOneError forall a b. (a -> b) -> a -> b
$ SrcSpan -> SDoc -> MsgEnvelope DecoratedSDoc
Ghc.mkPlainWarnMsg SrcSpan
srcSpan SDoc
msgDoc