{-# LANGUAGE CPP, PackageImports #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module HsDev.Tools.Ghc.Compat (
	pkgDatabase,
	TcId,
	UnitId, InstalledUnitId, toInstalledUnitId,
	unitId, moduleUnitId, depends, getPackageDetails, patSynType, cleanupHandler, renderStyle,
	LogAction, setLogAction, addLogAction,
	languages, flags,
	recSelParent, recSelCtors,
	getFixity,
	unqualStyle,
	exposedModuleName,
	exprType,
	modSummaries,
	lookupModule,
	cleanTemps,
	mgArgTys, mgResTy,
	mkFunTy, mkFunTys
	) where

import qualified "ghc" BasicTypes
import qualified "ghc" DynFlags as GHC
import qualified "ghc" ErrUtils
import qualified "ghc" InteractiveEval as Eval
import qualified "ghc" GHC
import qualified "ghc" Module
import qualified "ghc" Name
import qualified "ghc" Packages as GHC
import qualified "ghc" PatSyn as GHC
import qualified "ghc" Pretty
import qualified "ghc" TyCoRep
import qualified "ghc" GhcPlugins as GHC
import "ghc" Outputable

#if __GLASGOW_HASKELL__ >= 810
import qualified "ghc-boot" GHC.Platform as GHC
#endif

#if __GLASGOW_HASKELL__ >= 804
import "ghc" FileCleanup (cleanTempDirs, cleanTempFiles)
#else
import "ghc" SysTools (cleanTempDirs, cleanTempFiles)
#endif

#if __GLASGOW_HASKELL__ >= 800
import Data.List (nub)
import qualified "ghc" IdInfo
import "ghc" TcRnDriver
#endif

#if __GLASGOW_HASKELL__ == 710
import "ghc" Exception (ExceptionMonad)
import Control.Monad.Reader
#endif

#if __GLASGOW_HASKELL__ <= 800
import qualified "ghc" GHC.PackageDb as GHC
#endif

pkgDatabase :: GHC.DynFlags -> Maybe [GHC.PackageConfig]
#if __GLASGOW_HASKELL__ >= 800
pkgDatabase :: DynFlags -> Maybe [PackageConfig]
pkgDatabase = ([(FilePath, [PackageConfig])] -> [PackageConfig])
-> Maybe [(FilePath, [PackageConfig])] -> Maybe [PackageConfig]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([PackageConfig] -> [PackageConfig]
forall a. Eq a => [a] -> [a]
nub ([PackageConfig] -> [PackageConfig])
-> ([(FilePath, [PackageConfig])] -> [PackageConfig])
-> [(FilePath, [PackageConfig])]
-> [PackageConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((FilePath, [PackageConfig]) -> [PackageConfig])
-> [(FilePath, [PackageConfig])] -> [PackageConfig]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (FilePath, [PackageConfig]) -> [PackageConfig]
forall a b. (a, b) -> b
snd) (Maybe [(FilePath, [PackageConfig])] -> Maybe [PackageConfig])
-> (DynFlags -> Maybe [(FilePath, [PackageConfig])])
-> DynFlags
-> Maybe [PackageConfig]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> Maybe [(FilePath, [PackageConfig])]
GHC.pkgDatabase
#elif __GLASGOW_HASKELL__ == 710
pkgDatabase = GHC.pkgDatabase
#endif

#if __GLASGOW_HASKELL__ >= 804
type TcId = GHC.GhcTc
#else
type TcId = GHC.Id
#endif

#if __GLASGOW_HASKELL__ >= 800
type UnitId = Module.UnitId
#elif __GLASGOW_HASKELL__ == 710
type UnitId = Module.PackageKey
#endif

#if __GLASGOW_HASKELL__ >= 802
type InstalledUnitId = Module.InstalledUnitId
#else
type InstalledUnitId = UnitId
#endif

toInstalledUnitId :: UnitId -> InstalledUnitId
#if __GLASGOW_HASKELL__ >= 802
toInstalledUnitId :: UnitId -> InstalledUnitId
toInstalledUnitId = UnitId -> InstalledUnitId
Module.toInstalledUnitId
#else
toInstalledUnitId = id
#endif

unitId :: GHC.PackageConfig -> InstalledUnitId
#if __GLASGOW_HASKELL__ >= 800
unitId :: PackageConfig -> InstalledUnitId
unitId = PackageConfig -> InstalledUnitId
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> instunitid
GHC.unitId
#elif __GLASGOW_HASKELL__ == 710
unitId = GHC.packageKey
#endif

moduleUnitId :: GHC.Module -> UnitId
#if __GLASGOW_HASKELL__ >= 800
moduleUnitId :: Module -> UnitId
moduleUnitId = Module -> UnitId
GHC.moduleUnitId
#elif __GLASGOW_HASKELL__ == 710
moduleUnitId = GHC.modulePackageKey
#endif

depends :: GHC.DynFlags -> GHC.PackageConfig -> [InstalledUnitId]
#if __GLASGOW_HASKELL__ >= 800
depends :: DynFlags -> PackageConfig -> [InstalledUnitId]
depends DynFlags
_ = PackageConfig -> [InstalledUnitId]
forall compid srcpkgid srcpkgname instunitid unitid modulename mod.
InstalledPackageInfo
  compid srcpkgid srcpkgname instunitid unitid modulename mod
-> [instunitid]
GHC.depends
#elif __GLASGOW_HASKELL__ == 710
depends df = map (GHC.resolveInstalledPackageId df) . GHC.depends
#endif

getPackageDetails :: GHC.DynFlags -> InstalledUnitId -> GHC.PackageConfig
#if __GLASGOW_HASKELL__ >= 802
getPackageDetails :: DynFlags -> InstalledUnitId -> PackageConfig
getPackageDetails = DynFlags -> InstalledUnitId -> PackageConfig
GHC.getInstalledPackageDetails
#else
getPackageDetails = GHC.getPackageDetails
#endif

patSynType :: GHC.PatSyn -> GHC.Type
patSynType :: PatSyn -> Type
patSynType PatSyn
p = PatSyn -> [Type] -> Type
GHC.patSynInstResTy PatSyn
p (PatSyn -> [Type]
GHC.patSynArgs PatSyn
p)

#if __GLASGOW_HASKELL__ >= 800
cleanupHandler :: GHC.DynFlags -> m a -> m a
cleanupHandler :: DynFlags -> m a -> m a
cleanupHandler DynFlags
_ = m a -> m a
forall a. a -> a
id
#elif __GLASGOW_HASKELL__ == 710
cleanupHandler :: (ExceptionMonad m) => GHC.DynFlags -> m a -> m a
cleanupHandler = GHC.defaultCleanupHandler
#endif

renderStyle :: Pretty.Mode -> Int -> Pretty.Doc -> String
#if __GLASGOW_HASKELL__ >= 800
renderStyle :: Mode -> Int -> Doc -> FilePath
renderStyle Mode
m Int
cols = Style -> Doc -> FilePath
Pretty.renderStyle (Mode -> Int -> Float -> Style
Pretty.Style Mode
m Int
cols Float
1.5)
#elif __GLASGOW_HASKELL__ == 710
renderStyle = Pretty.showDoc
#endif

type LogAction = GHC.DynFlags -> GHC.Severity -> GHC.SrcSpan -> ErrUtils.MsgDoc -> IO ()

setLogAction :: LogAction -> GHC.DynFlags -> GHC.DynFlags
setLogAction :: LogAction -> DynFlags -> DynFlags
setLogAction LogAction
act DynFlags
fs = DynFlags
fs { log_action :: LogAction
GHC.log_action = LogAction
act' } where
	act' :: GHC.LogAction
#if __GLASGOW_HASKELL__ >= 800
	act' :: LogAction
act' DynFlags
df WarnReason
_ Severity
sev SrcSpan
src PprStyle
_ MsgDoc
msg = LogAction
act DynFlags
df Severity
sev SrcSpan
src MsgDoc
msg
#elif __GLASGOW_HASKELL__ == 710
	act' df sev src _ msg = act df sev src msg
#endif

addLogAction :: LogAction -> GHC.DynFlags -> GHC.DynFlags
addLogAction :: LogAction -> DynFlags -> DynFlags
addLogAction LogAction
act DynFlags
fs = DynFlags
fs { log_action :: LogAction
GHC.log_action = LogAction
logBoth } where
	logBoth :: GHC.LogAction
#if __GLASGOW_HASKELL__ >= 800
	logBoth :: LogAction
logBoth DynFlags
df WarnReason
wreason Severity
sev SrcSpan
src PprStyle
style MsgDoc
msg = do
		DynFlags -> LogAction
GHC.log_action DynFlags
fs DynFlags
df WarnReason
wreason Severity
sev SrcSpan
src PprStyle
style MsgDoc
msg
		DynFlags -> LogAction
GHC.log_action (LogAction -> DynFlags -> DynFlags
setLogAction LogAction
act DynFlags
fs) DynFlags
df WarnReason
wreason Severity
sev SrcSpan
src PprStyle
style MsgDoc
msg
#elif __GLASGOW_HASKELL__ == 710
	logBoth df sev src style ms = do
		GHC.log_action fs df sev src style msg
		GHC.log_action (setLogAction act fs) df sev src style msg
#endif

#if __GLASGOW_HASKELL__ == 710
instance (Monad m, GHC.HasDynFlags m) => GHC.HasDynFlags (ReaderT r m) where
	getDynFlags = lift GHC.getDynFlags
#endif

flags :: [String]
#if __GLASGOW_HASKELL__ >= 800
flags :: [FilePath]
flags = [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
	[FilePath
option | (GHC.FlagSpec FilePath
option GeneralFlag
_ TurnOnFlag -> DynP ()
_ GhcFlagMode
_) <- [FlagSpec GeneralFlag]
GHC.fFlags],
	[FilePath
"warn-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
option | (GHC.FlagSpec FilePath
option WarningFlag
_ TurnOnFlag -> DynP ()
_ GhcFlagMode
_) <- [FlagSpec WarningFlag]
GHC.wWarningFlags],
	[FilePath
option | (GHC.FlagSpec FilePath
option Extension
_ TurnOnFlag -> DynP ()
_ GhcFlagMode
_) <- [FlagSpec Extension]
GHC.fLangFlags]]
#elif __GLASGOW_HASKELL__ >= 710
flags = concat [
	[option | (GHC.FlagSpec option _ _ _) <- GHC.fFlags],
	[option | (GHC.FlagSpec option _ _ _) <- GHC.fWarningFlags],
	[option | (GHC.FlagSpec option _ _ _) <- GHC.fLangFlags]]
#elif __GLASGOW_HASKELL__ >= 704
flags = concat [
	[option | (option, _, _) <- GHC.fFlags],
	[option | (option, _, _) <- GHC.fWarningFlags],
	[option | (option, _, _) <- GHC.fLangFlags]]
#endif

#if __GLASGOW_HASKELL__ >= 800
recSelParent :: IdInfo.RecSelParent -> String
recSelParent :: RecSelParent -> FilePath
recSelParent (IdInfo.RecSelData TyCon
p) = TyCon -> FilePath
forall a. NamedThing a => a -> FilePath
Name.getOccString TyCon
p
recSelParent (IdInfo.RecSelPatSyn PatSyn
p) = PatSyn -> FilePath
forall a. NamedThing a => a -> FilePath
Name.getOccString PatSyn
p
#else
recSelParent :: GHC.TyCon -> String
recSelParent = Name.getOccString
#endif

#if __GLASGOW_HASKELL__ >= 800
recSelCtors :: IdInfo.RecSelParent -> [String]
recSelCtors :: RecSelParent -> [FilePath]
recSelCtors (IdInfo.RecSelData TyCon
p) = (DataCon -> FilePath) -> [DataCon] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map DataCon -> FilePath
forall a. NamedThing a => a -> FilePath
Name.getOccString (TyCon -> [DataCon]
GHC.tyConDataCons TyCon
p)
recSelCtors (IdInfo.RecSelPatSyn PatSyn
p) = [PatSyn -> FilePath
forall a. NamedThing a => a -> FilePath
Name.getOccString PatSyn
p]
#else
recSelCtors :: GHC.TyCon -> [String]
recSelCtors = return . Name.getOccString
#endif

getFixity :: BasicTypes.Fixity -> (Int, BasicTypes.FixityDirection)
#if __GLASGOW_HASKELL__ >= 800
getFixity :: Fixity -> (Int, FixityDirection)
getFixity (BasicTypes.Fixity SourceText
_ Int
i FixityDirection
d) = (Int
i, FixityDirection
d)
#else
getFixity (BasicTypes.Fixity i d) = (i, d)
#endif

languages :: [String]
#if __GLASGOW_HASKELL__ >= 810
languages :: [FilePath]
languages = PlatformMini -> [FilePath]
GHC.supportedLanguagesAndExtensions (PlatformMini -> [FilePath]) -> PlatformMini -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Arch -> OS -> PlatformMini
GHC.PlatformMini Arch
GHC.ArchUnknown OS
GHC.OSUnknown
#else
languages = GHC.supportedLanguagesAndExtensions
#endif

unqualStyle :: GHC.DynFlags -> PprStyle
#if __GLASGOW_HASKELL__ >= 802
unqualStyle :: DynFlags -> PprStyle
unqualStyle DynFlags
df = DynFlags -> PrintUnqualified -> Depth -> PprStyle
mkUserStyle DynFlags
df PrintUnqualified
neverQualify Depth
AllTheWay
#else
unqualStyle _ = mkUserStyle neverQualify AllTheWay
#endif

#if __GLASGOW_HASKELL__ > 800
exposedModuleName :: (a, Maybe b) -> a
exposedModuleName :: (a, Maybe b) -> a
exposedModuleName = (a, Maybe b) -> a
forall a b. (a, b) -> a
fst
#else
exposedModuleName :: GHC.ExposedModule unit mname -> mname
exposedModuleName = GHC.exposedName
#endif

exprType :: GHC.GhcMonad m => String -> m GHC.Type
#if __GLASGOW_HASKELL__ > 800
exprType :: FilePath -> m Type
exprType = TcRnExprMode -> FilePath -> m Type
forall (m :: * -> *).
GhcMonad m =>
TcRnExprMode -> FilePath -> m Type
Eval.exprType TcRnExprMode
TM_Inst
#else
exprType = Eval.exprType
#endif

modSummaries :: GHC.ModuleGraph -> [GHC.ModSummary]
#if __GLASGOW_HASKELL__ >= 804
modSummaries :: ModuleGraph -> [ModSummary]
modSummaries = ModuleGraph -> [ModSummary]
GHC.mgModSummaries
#else
modSummaries = id
#endif

-- Lookup module everywhere
lookupModule :: GHC.DynFlags -> GHC.ModuleName -> [GHC.Module]
lookupModule :: DynFlags -> ModuleName -> [Module]
lookupModule DynFlags
d ModuleName
mn = case DynFlags -> ModuleName -> Maybe FastString -> LookupResult
GHC.lookupModuleWithSuggestions DynFlags
d ModuleName
mn Maybe FastString
forall a. Maybe a
Nothing of
	GHC.LookupFound Module
m' PackageConfig
_ -> [Module
m']
	GHC.LookupMultiple [(Module, ModuleOrigin)]
ms -> ((Module, ModuleOrigin) -> Module)
-> [(Module, ModuleOrigin)] -> [Module]
forall a b. (a -> b) -> [a] -> [b]
map (Module, ModuleOrigin) -> Module
forall a b. (a, b) -> a
fst [(Module, ModuleOrigin)]
ms
	GHC.LookupHidden [(Module, ModuleOrigin)]
ls [(Module, ModuleOrigin)]
rs -> ((Module, ModuleOrigin) -> Module)
-> [(Module, ModuleOrigin)] -> [Module]
forall a b. (a -> b) -> [a] -> [b]
map (Module, ModuleOrigin) -> Module
forall a b. (a, b) -> a
fst ([(Module, ModuleOrigin)] -> [Module])
-> [(Module, ModuleOrigin)] -> [Module]
forall a b. (a -> b) -> a -> b
$ [(Module, ModuleOrigin)]
ls [(Module, ModuleOrigin)]
-> [(Module, ModuleOrigin)] -> [(Module, ModuleOrigin)]
forall a. [a] -> [a] -> [a]
++ [(Module, ModuleOrigin)]
rs
	GHC.LookupNotFound [ModuleSuggestion]
_ -> []
#if __GLASGOW_HASKELL__ >= 806
	GHC.LookupUnusable [(Module, ModuleOrigin)]
_ -> []
#endif

cleanTemps :: GHC.DynFlags -> IO ()
cleanTemps :: DynFlags -> IO ()
cleanTemps DynFlags
df = do
	DynFlags -> IO ()
cleanTempFiles DynFlags
df
	DynFlags -> IO ()
cleanTempDirs DynFlags
df

mgArgTys :: GHC.MatchGroup TcId (GHC.LHsExpr TcId) -> Maybe [GHC.Type]
#if __GLASGOW_HASKELL__ >= 806
mgArgTys :: MatchGroup TcId (LHsExpr TcId) -> Maybe [Type]
mgArgTys (GHC.MG{mg_ext :: forall p body. MatchGroup p body -> XMG p body
GHC.mg_ext=XMG TcId (LHsExpr TcId)
ext}) = [Type] -> Maybe [Type]
forall a. a -> Maybe a
Just ([Type] -> Maybe [Type]) -> [Type] -> Maybe [Type]
forall a b. (a -> b) -> a -> b
$ MatchGroupTc -> [Type]
GHC.mg_arg_tys MatchGroupTc
XMG TcId (LHsExpr TcId)
ext
mgArgTys MatchGroup TcId (LHsExpr TcId)
_ = Maybe [Type]
forall a. Maybe a
Nothing
#else
mgArgTys = Just . GHC.mg_arg_tys
#endif

mgResTy :: GHC.MatchGroup TcId (GHC.LHsExpr TcId) -> Maybe GHC.Type
#if __GLASGOW_HASKELL__ >= 806
mgResTy :: MatchGroup TcId (LHsExpr TcId) -> Maybe Type
mgResTy (GHC.MG{mg_ext :: forall p body. MatchGroup p body -> XMG p body
GHC.mg_ext=XMG TcId (LHsExpr TcId)
ext}) = Type -> Maybe Type
forall a. a -> Maybe a
Just (Type -> Maybe Type) -> Type -> Maybe Type
forall a b. (a -> b) -> a -> b
$ MatchGroupTc -> Type
GHC.mg_res_ty MatchGroupTc
XMG TcId (LHsExpr TcId)
ext
mgResTy MatchGroup TcId (LHsExpr TcId)
_ = Maybe Type
forall a. Maybe a
Nothing
#else
mgResTy = Just . GHC.mg_res_ty
#endif

mkFunTy :: GHC.Type -> GHC.Type -> GHC.Type
#if __GLASGOW_HASKELL__ >= 810
mkFunTy :: Type -> Type -> Type
mkFunTy = Type -> Type -> Type
TyCoRep.mkVisFunTy
#else
mkFunTy = TyCoRep.mkFunTy
#endif

mkFunTys :: [GHC.Type] -> GHC.Type -> GHC.Type
#if __GLASGOW_HASKELL__ >= 810
mkFunTys :: [Type] -> Type -> Type
mkFunTys = [Type] -> Type -> Type
TyCoRep.mkVisFunTys
#else
mkFunTys = GHC.mkFunTys
#endif