1{-# LANGUAGE FlexibleInstances, CPP #-}
2-- | All the CPP for GHC version compability should live in this module.
3module HIE.Bios.Ghc.Gap (
4    WarnFlags
5  , emptyWarnFlags
6  , makeUserStyle
7  , getModuleName
8  , getTyThing
9  , fixInfo
10  , getModSummaries
11  , mapOverIncludePaths
12  , LExpression
13  , LBinding
14  , LPattern
15  , inTypes
16  , outType
17  , mapMG
18  , mgModSummaries
19  , numLoadedPlugins
20  , initializePlugins
21  , unsetLogAction
22  ) where
23
24import DynFlags (DynFlags, includePaths)
25import GHC(LHsBind, LHsExpr, LPat, Type, ModSummary, ModuleGraph, HscEnv, setLogAction, GhcMonad)
26import Outputable (PrintUnqualified, PprStyle, Depth(AllTheWay), mkUserStyle)
27
28#if __GLASGOW_HASKELL__ >= 808
29import qualified DynamicLoading (initializePlugins)
30import qualified Plugins (plugins)
31#endif
32
33
34
35
36
37----------------------------------------------------------------
38----------------------------------------------------------------
39
40#if __GLASGOW_HASKELL__ >= 804
41import DynFlags (WarningFlag)
42import qualified EnumSet as E (EnumSet, empty)
43import GHC (mgModSummaries, mapMG)
44#endif
45
46#if __GLASGOW_HASKELL__ >= 806
47import DynFlags (IncludeSpecs(..))
48#endif
49
50#if __GLASGOW_HASKELL__ >= 810
51import GHC.Hs.Extension (GhcTc)
52import GHC.Hs.Expr (MatchGroup, MatchGroupTc(..), mg_ext)
53#elif __GLASGOW_HASKELL__ >= 806
54import HsExtension (GhcTc)
55import HsExpr (MatchGroup, MatchGroupTc(..))
56import GHC (mg_ext)
57#elif __GLASGOW_HASKELL__ >= 804
58import HsExtension (GhcTc)
59import HsExpr (MatchGroup)
60import GHC (mg_res_ty, mg_arg_tys)
61#else
62import HsExtension (GhcTc)
63import HsExpr (MatchGroup)
64#endif
65
66----------------------------------------------------------------
67----------------------------------------------------------------
68
69makeUserStyle :: DynFlags -> PrintUnqualified -> PprStyle
70#if __GLASGOW_HASKELL__ >= 804
71makeUserStyle dflags style = mkUserStyle dflags style AllTheWay
72#endif
73
74#if __GLASGOW_HASKELL__ >= 804
75getModuleName :: (a, b) -> a
76getModuleName = fst
77#endif
78
79----------------------------------------------------------------
80
81#if __GLASGOW_HASKELL__ >= 804
82type WarnFlags = E.EnumSet WarningFlag
83emptyWarnFlags :: WarnFlags
84emptyWarnFlags = E.empty
85#endif
86
87#if __GLASGOW_HASKELL__ >= 804
88getModSummaries :: ModuleGraph -> [ModSummary]
89getModSummaries = mgModSummaries
90
91getTyThing :: (a, b, c, d, e) -> a
92getTyThing (t,_,_,_,_) = t
93
94fixInfo :: (a, b, c, d, e) -> (a, b, c, d)
95fixInfo (t,f,cs,fs,_) = (t,f,cs,fs)
96#endif
97
98----------------------------------------------------------------
99
100mapOverIncludePaths :: (FilePath -> FilePath) -> DynFlags -> DynFlags
101mapOverIncludePaths f df = df
102  { includePaths =
103#if __GLASGOW_HASKELL__ > 804
104      IncludeSpecs
105          (map f $ includePathsQuote  (includePaths df))
106          (map f $ includePathsGlobal (includePaths df))
107#else
108      map f (includePaths df)
109#endif
110  }
111
112----------------------------------------------------------------
113
114#if __GLASGOW_HASKELL__ >= 806
115type LExpression = LHsExpr GhcTc
116type LBinding    = LHsBind GhcTc
117type LPattern    = LPat    GhcTc
118
119inTypes :: MatchGroup GhcTc LExpression -> [Type]
120inTypes = mg_arg_tys . mg_ext
121outType :: MatchGroup GhcTc LExpression -> Type
122outType = mg_res_ty . mg_ext
123#elif __GLASGOW_HASKELL__ >= 804
124type LExpression = LHsExpr GhcTc
125type LBinding    = LHsBind GhcTc
126type LPattern    = LPat    GhcTc
127
128inTypes :: MatchGroup GhcTc LExpression -> [Type]
129inTypes = mg_arg_tys
130outType :: MatchGroup GhcTc LExpression -> Type
131outType = mg_res_ty
132#endif
133
134numLoadedPlugins :: DynFlags -> Int
135#if __GLASGOW_HASKELL__ >= 808
136numLoadedPlugins = length . Plugins.plugins
137#else
138-- Plugins are loaded just as they are used
139numLoadedPlugins _ = 0
140#endif
141
142initializePlugins :: HscEnv -> DynFlags -> IO DynFlags
143#if __GLASGOW_HASKELL__ >= 808
144initializePlugins = DynamicLoading.initializePlugins
145#else
146-- In earlier versions of GHC plugins are just loaded before they are used.
147initializePlugins _ df = return df
148#endif
149
150unsetLogAction :: GhcMonad m => m ()
151unsetLogAction =
152    setLogAction (\_df _wr _s _ss _pp _m -> return ())
153#if __GLASGOW_HASKELL__ < 806
154        (\_df -> return ())
155#endif