{-# 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
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