{- FOURMOLU_DISABLE -}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module ImportStylePlugin.Compat where

#if __GLASGOW_HASKELL__ >= 908 && __GLASGOW_HASKELL__ < 910
import qualified GHC as Ghc
import qualified GHC.Utils.Outputable as Ghc
import qualified GHC.Types.Error as Ghc
import qualified GHC.Tc.Utils.Monad as Ghc
import qualified GHC.Tc.Errors.Types as Ghc
import qualified GHC.Unit.Module.Warnings as Ghc
#endif

#if __GLASGOW_HASKELL__ >= 906 && __GLASGOW_HASKELL__ < 908
import qualified GHC as Ghc
import qualified GHC.Types.Error as Ghc
import qualified GHC.Tc.Utils.Monad as Ghc
import qualified GHC.Tc.Errors.Types as Ghc
import qualified GHC.Utils.Outputable as Ghc
#endif

#if __GLASGOW_HASKELL__ >= 904 && __GLASGOW_HASKELL__ < 906
import qualified GHC as Ghc
import qualified GHC.Tc.Types as Ghc
import qualified GHC.Utils.Error as Ghc
import qualified GHC.Tc.Utils.Monad as Ghc
import qualified GHC.Tc.Errors.Types as Ghc
import qualified GHC.Types.Error as Ghc
import qualified GHC.Driver.Ppr as Ghc
#endif

#if __GLASGOW_HASKELL__ >= 902 && __GLASGOW_HASKELL__ < 904
import qualified GHC as Ghc
import qualified GHC.Utils.Outputable as Ghc
import qualified GHC.Tc.Utils.Monad as Ghc
import qualified GHC.Driver.Flags as Ghc
#endif

import ImportStylePlugin.Config as Cfg

getRawNames :: [Ghc.GenLocated l (Ghc.IE Ghc.GhcRn)] -> [String]
getRawNames :: forall l. [GenLocated l (IE GhcRn)] -> [String]
getRawNames [GenLocated l (IE GhcRn)]
names =
  [ IE GhcRn -> String
forall a. Outputable a => a -> String
Ghc.showPprUnsafe  IE GhcRn
n
  | Ghc.L
      l
_
      IE GhcRn
n <-
      [GenLocated l (IE GhcRn)]
names
  ] 

getExplicitlyImportedNames :: Ghc.ImportDecl Ghc.GhcRn -> Maybe [String]
getExplicitlyImportedNames :: ImportDecl GhcRn -> Maybe [String]
getExplicitlyImportedNames Ghc.ImportDecl {Bool
Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
Maybe (XRec GhcRn ModuleName)
ImportDeclPkgQual GhcRn
XCImportDecl GhcRn
XRec GhcRn ModuleName
IsBootInterface
ImportDeclQualifiedStyle
ideclExt :: XCImportDecl GhcRn
ideclName :: XRec GhcRn ModuleName
ideclPkgQual :: ImportDeclPkgQual GhcRn
ideclSource :: IsBootInterface
ideclSafe :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclAs :: Maybe (XRec GhcRn ModuleName)
ideclImportList :: Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclPkgQual :: forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
..} =
  case 
#if __GLASGOW_HASKELL__ >= 906 
    Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
ideclImportList 
#else 
    ideclHiding
#endif
  of
    Just 
      (
#if __GLASGOW_HASKELL__ >= 906 
        ImportListInterpretation
Ghc.Exactly
#else 
        False
#endif
      , Ghc.L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcRn)]
names
      ) -> [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([GenLocated SrcSpanAnnA (IE GhcRn)] -> [String]
forall l. [GenLocated l (IE GhcRn)] -> [String]
getRawNames [GenLocated SrcSpanAnnA (IE GhcRn)]
names)
    Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
_ -> Maybe [String]
forall a. Maybe a
Nothing

getExplicitlyHiddenNames :: Ghc.ImportDecl Ghc.GhcRn -> Maybe [String]
getExplicitlyHiddenNames :: ImportDecl GhcRn -> Maybe [String]
getExplicitlyHiddenNames Ghc.ImportDecl {Bool
Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
Maybe (XRec GhcRn ModuleName)
ImportDeclPkgQual GhcRn
XCImportDecl GhcRn
XRec GhcRn ModuleName
IsBootInterface
ImportDeclQualifiedStyle
ideclImportList :: forall pass.
ImportDecl pass
-> Maybe (ImportListInterpretation, XRec pass [LIE pass])
ideclAs :: forall pass. ImportDecl pass -> Maybe (XRec pass ModuleName)
ideclQualified :: forall pass. ImportDecl pass -> ImportDeclQualifiedStyle
ideclSafe :: forall pass. ImportDecl pass -> Bool
ideclSource :: forall pass. ImportDecl pass -> IsBootInterface
ideclPkgQual :: forall pass. ImportDecl pass -> ImportDeclPkgQual pass
ideclName :: forall pass. ImportDecl pass -> XRec pass ModuleName
ideclExt :: forall pass. ImportDecl pass -> XCImportDecl pass
ideclExt :: XCImportDecl GhcRn
ideclName :: XRec GhcRn ModuleName
ideclPkgQual :: ImportDeclPkgQual GhcRn
ideclSource :: IsBootInterface
ideclSafe :: Bool
ideclQualified :: ImportDeclQualifiedStyle
ideclAs :: Maybe (XRec GhcRn ModuleName)
ideclImportList :: Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
..} =
  case 
#if __GLASGOW_HASKELL__ >= 906 
    Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
ideclImportList 
#else 
    ideclHiding
#endif
  of
    Just 
      ( 
#if __GLASGOW_HASKELL__ >= 906 
        ImportListInterpretation
Ghc.EverythingBut
#else 
        True
#endif
      , Ghc.L SrcSpanAnnL
_ [GenLocated SrcSpanAnnA (IE GhcRn)]
names) -> [String] -> Maybe [String]
forall a. a -> Maybe a
Just ([GenLocated SrcSpanAnnA (IE GhcRn)] -> [String]
forall l. [GenLocated l (IE GhcRn)] -> [String]
getRawNames [GenLocated SrcSpanAnnA (IE GhcRn)]
names)
    Maybe (ImportListInterpretation, XRec GhcRn [LIE GhcRn])
_ -> Maybe [String]
forall a. Maybe a
Nothing



#if __GLASGOW_HASKELL__ >= 908 && __GLASGOW_HASKELL__ < 910
report :: Severity -> Ghc.SDoc -> Maybe Ghc.SrcSpan -> Ghc.TcRn ()
report :: Severity -> SDoc -> Maybe SrcSpan -> TcRn ()
report Severity
severity SDoc
msg Maybe SrcSpan
loc =
  (TcRnMessage -> TcRn ())
-> (SrcSpan -> TcRnMessage -> TcRn ())
-> Maybe SrcSpan
-> TcRnMessage
-> TcRn ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TcRnMessage -> TcRn ()
Ghc.addDiagnostic SrcSpan -> TcRnMessage -> TcRn ()
Ghc.addDiagnosticAt Maybe SrcSpan
loc
    (TcRnMessage -> TcRn ())
-> (DiagnosticMessage -> TcRnMessage)
-> DiagnosticMessage
-> TcRn ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnknownDiagnostic (DiagnosticOpts TcRnMessage) -> TcRnMessage
UnknownDiagnostic TcRnMessageOpts -> TcRnMessage
Ghc.TcRnUnknownMessage
    (UnknownDiagnostic TcRnMessageOpts -> TcRnMessage)
-> (DiagnosticMessage -> UnknownDiagnostic TcRnMessageOpts)
-> DiagnosticMessage
-> TcRnMessage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiagnosticMessage -> UnknownDiagnostic TcRnMessageOpts
forall a b.
(Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) =>
a -> UnknownDiagnostic b
Ghc.mkSimpleUnknownDiagnostic
    (DiagnosticMessage -> TcRn ()) -> DiagnosticMessage -> TcRn ()
forall a b. (a -> b) -> a -> b
$ Ghc.DiagnosticMessage
      { diagMessage :: DecoratedSDoc
Ghc.diagMessage = SDoc -> DecoratedSDoc
Ghc.mkSimpleDecorated SDoc
msg
      , diagReason :: DiagnosticReason
Ghc.diagReason = case Severity
severity of
          Severity
Error -> DiagnosticReason
Ghc.ErrorWithoutFlag
          Severity
Warning -> WarningCategory -> DiagnosticReason
Ghc.WarningWithCategory (FastString -> WarningCategory
Ghc.WarningCategory FastString
"x-import-style")
      , diagHints :: [GhcHint]
Ghc.diagHints = []
      }
#endif

#if __GLASGOW_HASKELL__ >= 906 && __GLASGOW_HASKELL__ < 908
report :: Severity -> Ghc.SDoc -> Maybe Ghc.SrcSpan -> Ghc.TcRn ()
report severity msg loc =
  maybe Ghc.addDiagnostic Ghc.addDiagnosticAt loc
    . Ghc.TcRnUnknownMessage
    . Ghc.UnknownDiagnostic
    $ Ghc.DiagnosticMessage
      { Ghc.diagMessage = Ghc.mkSimpleDecorated msg
      , Ghc.diagReason = case severity of
          Error -> Ghc.ErrorWithoutFlag
          Warning -> Ghc.WarningWithoutFlag 
      , Ghc.diagHints = []
      }
#endif

    
#if __GLASGOW_HASKELL__ >= 904 && __GLASGOW_HASKELL__ < 906
report :: Severity -> Ghc.SDoc -> Maybe Ghc.SrcSpan -> Ghc.TcRn ()
report severity msg loc = 
  maybe Ghc.addDiagnostic Ghc.addDiagnosticAt loc
    . Ghc.TcRnUnknownMessage
    $ Ghc.DiagnosticMessage
      { Ghc.diagMessage = Ghc.mkSimpleDecorated msg
      , Ghc.diagReason = case severity of
          Error -> Ghc.ErrorWithoutFlag
          Warning -> Ghc.WarningWithoutFlag
      , Ghc.diagHints = []
      }
#endif


#if __GLASGOW_HASKELL__ >= 902 && __GLASGOW_HASKELL__ < 904
report :: Severity -> Ghc.SDoc -> Maybe Ghc.SrcSpan -> Ghc.TcRn ()
report severity msg loc = 
  maybe 
    do case severity of
        Error -> Ghc.addErr msg
        Warning -> Ghc.addWarn Ghc.NoReason msg
    do \l -> case severity of
        Error -> Ghc.addErrAt l msg
        Warning -> Ghc.addWarnAt Ghc.NoReason l msg
    do loc 
#endif