{-# LANGUAGE CPP #-}

-- | Thin shim around the GHC API
--
-- For the typechecker part we have the excellent @ghc-tcplugin-api@ library;
-- unfortunately, we have no such library for source plugins. We could reuse a
-- small part of @ghc-tcplugin-api@ here, but there isn't too much point: source
-- plugins need quite a different subset of the GHC API than typechecker plugins
-- do.
module Data.Record.Anon.Internal.Plugin.Source.GhcShim (
    -- * Extensions
    HasDefaultExt(..)

    -- * Miscellaneous
  , importDecl
  , issueWarning
#if __GLASGOW_HASKELL__ < 900
  , mkHsApps
#endif

    -- * Re-exports
#if __GLASGOW_HASKELL__ < 900
  , module BasicTypes
  , module FastString
  , module GHC
  , module HscMain
  , module HscTypes
  , module Name
  , module NameCache
  , module OccName
  , module Outputable
  , module RdrName
  , module UniqSupply
#else
  , module GHC
  , module GHC.Data.FastString
  , module GHC.Driver.Main
  , module GHC.Driver.Types
  , module GHC.Types.Name
  , module GHC.Types.Name.Cache
  , module GHC.Types.Name.Occurrence
  , module GHC.Types.Name.Reader
  , module GHC.Types.Unique.Supply
  , module GHC.Utils.Outputable
#endif
  ) where

#if __GLASGOW_HASKELL__ < 900

import Data.List (foldl')

import Bag (listToBag)
import BasicTypes (Origin(Generated), PromotionFlag(NotPromoted))
import ErrUtils (mkWarnMsg)
import FastString (FastString)
import GHC
import GhcPlugins
import HscMain (getHscEnv)
import HscTypes
import Name (mkInternalName)
import NameCache (NameCache(nsUniqs))
import OccName
import Outputable
import RdrName (RdrName(Exact), rdrNameOcc, mkRdrQual, mkRdrUnqual)
import UniqSupply (takeUniqFromSupply)

#else

import GHC
import GHC.Data.Bag (listToBag)
import GHC.Data.FastString (FastString)
import GHC.Driver.Main (getHscEnv)
import GHC.Driver.Types
import GHC.Plugins
import GHC.Types.Name (mkInternalName)
import GHC.Types.Name.Cache (NameCache(nsUniqs))
import GHC.Types.Name.Occurrence
import GHC.Types.Name.Reader (RdrName(Exact), rdrNameOcc, mkRdrQual, mkRdrUnqual)
import GHC.Types.Unique.Supply (takeUniqFromSupply)
import GHC.Utils.Error (mkWarnMsg)
import GHC.Utils.Outputable

#endif

{-------------------------------------------------------------------------------
  Miscellaneous
-------------------------------------------------------------------------------}

-- | Optionally @qualified@ import declaration
importDecl :: Bool -> ModuleName -> LImportDecl GhcPs
importDecl :: Bool -> ModuleName -> LImportDecl GhcPs
importDecl Bool
qualified ModuleName
name = SrcSpanLess (LImportDecl GhcPs) -> LImportDecl GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LImportDecl GhcPs) -> LImportDecl GhcPs)
-> SrcSpanLess (LImportDecl GhcPs) -> LImportDecl GhcPs
forall a b. (a -> b) -> a -> b
$ ImportDecl :: forall pass.
XCImportDecl pass
-> SourceText
-> Located ModuleName
-> Maybe StringLiteral
-> Bool
-> Bool
-> ImportDeclQualifiedStyle
-> Bool
-> Maybe (Located ModuleName)
-> Maybe (Bool, Located [LIE pass])
-> ImportDecl pass
ImportDecl {
      ideclExt :: XCImportDecl GhcPs
ideclExt       = XCImportDecl GhcPs
forall a. HasDefaultExt a => a
defExt
    , ideclSourceSrc :: SourceText
ideclSourceSrc = SourceText
NoSourceText
    , ideclName :: Located ModuleName
ideclName      = SrcSpanLess (Located ModuleName) -> Located ModuleName
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (Located ModuleName)
ModuleName
name
    , ideclPkgQual :: Maybe StringLiteral
ideclPkgQual   = Maybe StringLiteral
forall a. Maybe a
Nothing
    , ideclSafe :: Bool
ideclSafe      = Bool
False
    , ideclImplicit :: Bool
ideclImplicit  = Bool
False
    , ideclAs :: Maybe (Located ModuleName)
ideclAs        = Maybe (Located ModuleName)
forall a. Maybe a
Nothing
    , ideclHiding :: Maybe (Bool, Located [LIE GhcPs])
ideclHiding    = Maybe (Bool, Located [LIE GhcPs])
forall a. Maybe a
Nothing
#if __GLASGOW_HASKELL__ < 810
    , ideclQualified = qualified
#else
    , ideclQualified :: ImportDeclQualifiedStyle
ideclQualified = if Bool
qualified then ImportDeclQualifiedStyle
QualifiedPre else ImportDeclQualifiedStyle
NotQualified
#endif
#if __GLASGOW_HASKELL__ < 900
    , ideclSource :: Bool
ideclSource    = Bool
False
#else
    , ideclSource    = NotBoot
#endif
    }

issueWarning :: SrcSpan -> SDoc -> Hsc ()
issueWarning :: SrcSpan -> SDoc -> Hsc ()
issueWarning SrcSpan
l SDoc
errMsg = do
    DynFlags
dynFlags <- Hsc DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
    IO () -> Hsc ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Hsc ()) -> IO () -> Hsc ()
forall a b. (a -> b) -> a -> b
$ DynFlags -> Bag WarnMsg -> IO ()
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
listToBag ([WarnMsg] -> Bag WarnMsg)
-> (WarnMsg -> [WarnMsg]) -> WarnMsg -> Bag WarnMsg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (WarnMsg -> [WarnMsg] -> [WarnMsg]
forall a. a -> [a] -> [a]
:[]) (WarnMsg -> IO ()) -> WarnMsg -> IO ()
forall a b. (a -> b) -> a -> b
$
      DynFlags -> SrcSpan -> PrintUnqualified -> SDoc -> WarnMsg
mkWarnMsg DynFlags
dynFlags SrcSpan
l PrintUnqualified
neverQualify SDoc
errMsg

#if __GLASGOW_HASKELL__ < 900
mkHsApps ::
     LHsExpr (GhcPass id)
  -> [LHsExpr (GhcPass id)]
  -> LHsExpr (GhcPass id)
mkHsApps :: LHsExpr (GhcPass id)
-> [LHsExpr (GhcPass id)] -> LHsExpr (GhcPass id)
mkHsApps = (LHsExpr (GhcPass id)
 -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id))
-> LHsExpr (GhcPass id)
-> [LHsExpr (GhcPass id)]
-> LHsExpr (GhcPass id)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
forall (id :: Pass).
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
mkHsApp
#endif

{-------------------------------------------------------------------------------
  Extensions
-------------------------------------------------------------------------------}

class HasDefaultExt a where
  defExt :: a

#if __GLASGOW_HASKELL__ < 810
instance HasDefaultExt NoExt where
  defExt = noExt
#else
instance HasDefaultExt NoExtField where
  defExt :: NoExtField
defExt = NoExtField
noExtField
#endif

#if __GLASGOW_HASKELL__ >= 900
instance HasDefaultExt LayoutInfo where
  defExt = NoLayoutInfo
#endif