Compatibility with GHC 8.2.1

core/GhcMod/Doc.hs

@@ -1,8 +1,13 @@
+{-# LANGUAGE CPP #-}
+
 module GhcMod.Doc where
 
 import GHC
 import GhcMod.Gap (withStyle, showDocWith)
 import Outputable
+#if __GLASGOW_HASKELL__ >= 802
+import DynFlags
+#endif
 import Pretty (Mode(..))
 
 showPage :: DynFlags -> PprStyle -> SDoc -> String
@@ -14,7 +19,17 @@ showOneLine dflag style = showDocWith dflag OneLineMode . withStyle dflag style
 getStyle :: GhcMonad m => m PprStyle
 getStyle = do
     unqual <- getPrintUnqual
+#if __GLASGOW_HASKELL__ >= 802
+    dflags <- getDynFlags
+    return $ mkUserStyle dflags unqual AllTheWay
+#else
     return $ mkUserStyle unqual AllTheWay
+#endif
 
-styleUnqualified :: PprStyle
-styleUnqualified = mkUserStyle neverQualify AllTheWay
+styleUnqualified :: DynFlags -> PprStyle
+styleUnqualified dflags =
+#if __GLASGOW_HASKELL__ >= 802
+    mkUserStyle dflags neverQualify AllTheWay
+#else
+    mkUserStyle neverQualify AllTheWay
+#endif

core/GhcMod/DynFlags.hs

@@ -1,4 +1,6 @@
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE CPP #-}
 
 module GhcMod.DynFlags where
 
@@ -14,6 +16,12 @@ import GhcMod.DynFlagsTH
 import System.IO.Unsafe (unsafePerformIO)
 import Prelude
 
+-- For orphans
+#if __GLASGOW_HASKELL__ == 802
+import Util (OverridingBool(..))
+import PprColour
+#endif
+
 setEmptyLogger :: DynFlags -> DynFlags
 setEmptyLogger df =
     Gap.setLogAction df $ \_ _ _ _ _ _ -> return ()
@@ -102,6 +110,12 @@ deferErrors df = return $
 
 ----------------------------------------------------------------
 
+#if __GLASGOW_HASKELL__ == 802
+deriving instance Eq OverridingBool
+deriving instance Eq PprColour.Scheme
+deriving instance Eq PprColour.PprColour
+#endif
+
 deriveEqDynFlags [d|
   eqDynFlags :: DynFlags -> DynFlags -> [[(Bool, String)]]
   eqDynFlags = undefined

core/GhcMod/DynFlagsTH.hs

@@ -76,7 +76,9 @@ deriveEqDynFlags qds = do
                       ]
        ignoredTypeNames =
            [ "LogAction"
+           , "LogFinaliser"
            , "PackageState"
+           , "IO"
            , "Hooks"
            , "FlushOut"
            , "FlushErr"

core/GhcMod/Gap.hs

@@ -5,7 +5,7 @@ module GhcMod.Gap (
   , mkTarget
   , withStyle
   , GmLogAction
-  , setLogAction
+  , GhcMod.Gap.setLogAction
   , getSrcSpan
   , getSrcFile
   , withInteractiveContext
@@ -87,6 +87,9 @@ import qualified StringBuffer as SB
 #if __GLASGOW_HASKELL__ >= 710
 import CoAxiom (coAxiomTyCon)
 #endif
+#if __GLASGOW_HASKELL__ >= 802
+import IfaceSyn (showToIface)
+#endif
 
 #if __GLASGOW_HASKELL__ >= 708
 import FamInstEnv
@@ -442,7 +445,11 @@ pprInfo m pefas (thing, fixity, insts)
       | fx == defaultFixity = Outputable.empty
       | otherwise           = ppr fx <+> ppr (getName thing)
 #if __GLASGOW_HASKELL__ >= 708
+#if __GLASGOW_HASKELL__ >= 802
+    pprTyThingInContextLoc' thing' = showWithLoc (pprDefinedAt' thing') (pprTyThingInContext showToIface thing')
+#else
     pprTyThingInContextLoc' thing' = showWithLoc (pprDefinedAt' thing') (pprTyThingInContext thing')
+#endif
 #if __GLASGOW_HASKELL__ >= 710
     pprFamInst' (FamInst { fi_flavor = DataFamilyInst rep_tc })
       = pprTyThingInContextLoc (ATyCon rep_tc)
@@ -570,7 +577,12 @@ type GLMatchI = LMatch Id
 #endif
 
 getClass :: [LInstDecl Name] -> Maybe (Name, SrcSpan)
-#if __GLASGOW_HASKELL__ >= 800
+#if __GLASGOW_HASKELL__ >= 802
+-- Instance declarations of sort 'instance F (G a)'
+getClass [L loc (ClsInstD (ClsInstDecl {cid_poly_ty = HsIB _ (L _ (HsForAllTy _ (L _ (HsAppTy (L _ (HsTyVar _ (L _ className))) _)))) _}))] = Just (className, loc)
+-- Instance declarations of sort 'instance F G' (no variables)
+getClass [L loc (ClsInstD (ClsInstDecl {cid_poly_ty = HsIB _ (L _ (HsAppTy (L _ (HsTyVar _ (L _ className))) _)) _}))] = Just (className, loc)
+#elif __GLASGOW_HASKELL__ >= 800
 -- Instance declarations of sort 'instance F (G a)'
 getClass [L loc (ClsInstD (ClsInstDecl {cid_poly_ty = HsIB _ (L _ (HsForAllTy _ (L _ (HsAppTy (L _ (HsTyVar (L _ className))) _))))}))] = Just (className, loc)
 -- Instance declarations of sort 'instance F G' (no variables)
@@ -668,7 +680,11 @@ parseModuleHeader str dflags filename =
 #endif
 
      POk pst rdr_module ->
+#if __GLASGOW_HASKELL__ >= 802
+         let (warns,_) = getMessages pst dflags in
+#else
          let (warns,_) = getMessages pst in
+#endif
          Right (warns, rdr_module)
 
 mkErrStyle' :: DynFlags -> PrintUnqualified -> PprStyle

core/GhcMod/LightGhc.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 module GhcMod.LightGhc where
 
 import Control.Monad
@@ -6,7 +8,9 @@ import Data.IORef
 
 import GHC
 import GHC.Paths (libdir)
+#if __GLASGOW_HASKELL__ < 802
 import StaticFlags
+#endif
 import SysTools
 import DynFlags
 import HscMain
@@ -17,6 +21,11 @@ import GhcMod.Monad.Types
 import GhcMod.DynFlags
 import qualified GhcMod.Gap as Gap
 
+#if __GLASGOW_HASKELL__ >= 802
+initStaticOpts :: Monad m => m ()
+initStaticOpts = return ()
+#endif
+
 -- We have to be more careful about tearing down 'HscEnv's since GHC 8 added an
 -- out of process GHCI server which has to be shutdown.
 newLightEnv :: IOish m => (DynFlags -> LightGhc DynFlags) -> m HscEnv

core/GhcMod/Pretty.hs

@@ -14,6 +14,8 @@
 -- You should have received a copy of the GNU Affero General Public License
 -- along with this program.  If not, see <http://www.gnu.org/licenses/>.
 
+{-# LANGUAGE CPP #-}
+
 module GhcMod.Pretty
   ( renderGm
   , renderSDoc
@@ -47,8 +49,14 @@ renderSDoc sdoc = do
 
 gmComponentNameDoc :: ChComponentName -> Doc
 gmComponentNameDoc ChSetupHsName   = text $ "Setup.hs"
+#if MIN_VERSION_cabal_helper(0,8,0)
+gmComponentNameDoc ChLibName       = text $ "library"
+gmComponentNameDoc (ChSubLibName _)= text $ "library"
+gmComponentNameDoc (ChFLibName _)  = text $ "flibrary"
+#else
 gmComponentNameDoc (ChLibName "")  = text $ "library"
 gmComponentNameDoc (ChLibName n)   = text $ "library:" ++ n
+#endif
 gmComponentNameDoc (ChExeName n)   = text $ "exe:" ++ n
 gmComponentNameDoc (ChTestName n)  = text $ "test:" ++ n
 gmComponentNameDoc (ChBenchName n) = text $ "bench:" ++ n