{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module AutoInstrument.Internal.GhcFacade
  ( module Ghc
  , mkParseError
  ) where

#if MIN_VERSION_ghc(9,6,0)
import           GHC.Plugins as Ghc hiding (getHscEnv, putMsg, fatalErrorMsg, errorMsg, debugTraceMsg)
import           GHC.Fingerprint as Ghc
import           GHC.Iface.Env as Ghc
import           GHC.Unit.Finder as Ghc
import           GHC.Driver.Main as Ghc
import           Language.Haskell.Syntax as Ghc
import           GHC.Hs as Ghc (HsParsedModule(..))
import           GHC.Hs.Extension as Ghc
import           GHC.Parser.Annotation as Ghc (SrcSpanAnn'(..), SrcSpanAnnA, noAnn, noSrcSpanA, realSrcSpan)
import           GHC.Parser.Errors.Types as Ghc
import           GHC.Types.SourceText as Ghc
import           GHC.Types.Error as Ghc
import           GHC.Utils.Error as Ghc
#elif MIN_VERSION_ghc(9,4,0)
import           GHC.Plugins as Ghc hiding (getHscEnv, putMsg, fatalErrorMsg, errorMsg, debugTraceMsg)
import           GHC.Fingerprint as Ghc
import           GHC.Iface.Env as Ghc
import           GHC.Unit.Finder as Ghc
import           GHC.Driver.Main as Ghc
import           Language.Haskell.Syntax as Ghc
import           GHC.Hs as Ghc (HsParsedModule(..), HsModule(..))
import           GHC.Hs.Extension as Ghc
import           GHC.Parser.Annotation as Ghc (SrcSpanAnn'(..), SrcSpanAnnA, noAnn, noSrcSpanA, realSrcSpan)
import           GHC.Parser.Errors.Types as Ghc
import           GHC.Types.SourceText as Ghc
import           GHC.Types.Error as Ghc
import           GHC.Utils.Error as Ghc
#endif

mkParseError :: String -> MsgEnvelope PsMessage
mkParseError :: String -> MsgEnvelope PsMessage
mkParseError
  = SrcSpan -> PsMessage -> MsgEnvelope PsMessage
forall e. Diagnostic e => SrcSpan -> e -> MsgEnvelope e
Ghc.mkPlainErrorMsgEnvelope (FastString -> SrcSpan
Ghc.mkGeneralSrcSpan FastString
"plugin")
  (PsMessage -> MsgEnvelope PsMessage)
-> (String -> PsMessage) -> String -> MsgEnvelope PsMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnknownDiagnostic -> PsMessage
Ghc.PsUnknownMessage
#if MIN_VERSION_ghc (9,8,0)
  . Ghc.mkUnknownDiagnostic
#elif MIN_VERSION_ghc (9,6,0)
  (UnknownDiagnostic -> PsMessage)
-> (String -> UnknownDiagnostic) -> String -> PsMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiagnosticMessage -> UnknownDiagnostic
forall a.
(DiagnosticOpts a ~ NoDiagnosticOpts, Diagnostic a, Typeable a) =>
a -> UnknownDiagnostic
Ghc.UnknownDiagnostic
#endif
  (DiagnosticMessage -> UnknownDiagnostic)
-> (String -> DiagnosticMessage) -> String -> UnknownDiagnostic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GhcHint] -> SDoc -> DiagnosticMessage
Ghc.mkPlainError [GhcHint]
Ghc.noHints
  (SDoc -> DiagnosticMessage)
-> (String -> SDoc) -> String -> DiagnosticMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SDoc
forall doc. IsLine doc => String -> doc
Ghc.text