drop the broken GHC 8 support (#130)

mpickering · Dec 17, 2022 · e467755 · e467755
1 parent 1767e2b
commit e467755
Showing 1 changed file with 10 additions and 199 deletions.
diff --git a/src/Refact/Compat.hs b/src/Refact/Compat.hs
@@ -43,11 +43,7 @@ module Refact.Compat (
   StmtLR (..),
 
   -- * HsSyn / GHC.Hs
-#if __GLASGOW_HASKELL__ >= 810
   module GHC.Hs,
-#else
-  module HsSyn,
-#endif
 
   -- * Name / OccName / GHC.Types.Name
   nameOccName,
@@ -102,163 +98,78 @@ module Refact.Compat (
   initParserOpts,
 ) where
 
-#if __GLASGOW_HASKELL__ >= 900
-import GHC.Data.Bag (unitBag, bagToList )
+import Control.Monad.Trans.State.Strict (StateT)
+import Data.Data (Data)
+import qualified GHC
+import GHC.Data.Bag (unitBag, bagToList)
 import GHC.Data.FastString (FastString, mkFastString)
+import qualified GHC.Data.Strict as Strict
 import GHC.Data.StringBuffer (stringToStringBuffer)
+import GHC.Driver.Errors.Types (ErrorMessages, ghcUnknownMessage)
 import GHC.Driver.Session hiding (initDynFlags)
-import GHC.Parser.Annotation
+import GHC.Hs hiding (Pat, Stmt)
 import GHC.Parser.Header (getOptions)
+import GHC.Types.Error (getMessages)
 import GHC.Types.Fixity  ( Fixity(..) )
-import GHC.Utils.Error
 import GHC.Types.Name (nameOccName, occName, occNameString)
 import GHC.Types.Name.Reader (RdrName (..), rdrNameOcc)
 import GHC.Types.SrcLoc hiding (spans)
 import GHC.Types.SourceText
-import GHC.Utils.Panic (pprPanic)
+import GHC.Utils.Error
 import GHC.Utils.Outputable
   ( ppr,
     showSDocUnsafe,
     text,
     vcat,
   )
-import GHC.Utils.Panic (handleGhcException)
-#else
-import ApiAnnotation
-#if __GLASGOW_HASKELL__ == 810
-import Bag (unitBag)
-#endif
-import BasicTypes (Fixity (..), SourceText (..))
-import ErrUtils
-  ( ErrorMessages,
-    pprErrMsgBagWithLoc,
-#if __GLASGOW_HASKELL__ == 810
-    mkPlainErrMsg,
-#endif
-  )
-import DynFlags hiding (initDynFlags)
-import FastString (FastString, mkFastString)
-import GHC.LanguageExtensions.Type (Extension (..))
-import HeaderInfo (getOptions)
-import Name (nameOccName)
-import OccName (occName, occNameString)
-import Outputable
-  ( ppr,
-    showSDocUnsafe,
-#if __GLASGOW_HASKELL__ == 810
-    pprPanic,
-    text,
-    vcat,
-#endif
-  )
-import Panic (handleGhcException)
-import RdrName (RdrName (..), rdrNameOcc)
-import SrcLoc hiding (spans)
-import StringBuffer (stringToStringBuffer)
-#endif
-
-#if __GLASGOW_HASKELL__ >= 810
-import GHC.Hs hiding (Pat, Stmt)
-#elif __GLASGOW_HASKELL__ <= 808
-import HsSyn hiding (Pat, Stmt)
-#endif
-
-import GHC.Driver.Errors.Types (ErrorMessages, ghcUnknownMessage)
-import GHC.Types.Error(getMessages)
-import qualified GHC.Data.Strict as Strict
+import GHC.Utils.Panic (handleGhcException, pprPanic)
 import GHC.Driver.Config.Parser
-
-import Control.Monad.Trans.State.Strict (StateT)
-import Data.Data (Data)
-import qualified GHC
 import Language.Haskell.GHC.ExactPrint.Parsers (Parser)
 import Language.Haskell.GHC.ExactPrint.Utils
 import Refact.Types (Refactoring)
 
-#if __GLASGOW_HASKELL__ <= 806
-type MonadFail' = Monad
-#else
 type MonadFail' = MonadFail
-#endif
 
-#if __GLASGOW_HASKELL__ >= 900
 type Module = Located HsModule
-#else
-type Module = Located (HsModule GhcPs)
-#endif
 
-#if __GLASGOW_HASKELL__ >= 810
 type Errors = ErrorMessages
 onError :: String -> Errors -> a
 onError s = pprPanic s . vcat . ppp
 ppp :: Errors -> [SDoc]
 ppp pst = concatMap unDecorated $ fmap (diagnosticMessage . errMsgDiagnostic) $ bagToList $ getMessages pst
-#else
-type Errors = (SrcSpan, String)
-onError :: String -> Errors -> a
-onError _ = error . show
-#endif
 
-#if __GLASGOW_HASKELL__ >= 900
 type FunBind = HsMatchContext GhcPs
-#else
-type FunBind = HsMatchContext RdrName
-#endif
 
 pattern RealSrcLoc' :: RealSrcLoc -> SrcLoc
-#if __GLASGOW_HASKELL__ >= 900
 pattern RealSrcLoc' r <- RealSrcLoc r _ where
   RealSrcLoc' r = RealSrcLoc r Strict.Nothing
-#else
-pattern RealSrcLoc' r <- RealSrcLoc r where
-  RealSrcLoc' r = RealSrcLoc r
-#endif
 {-# COMPLETE RealSrcLoc', UnhelpfulLoc #-}
 
 pattern RealSrcSpan' :: RealSrcSpan -> SrcSpan
-#if __GLASGOW_HASKELL__ >= 900
 pattern RealSrcSpan' r <- RealSrcSpan r _ where
   RealSrcSpan' r = RealSrcSpan r Strict.Nothing
-#else
-pattern RealSrcSpan' r <- RealSrcSpan r where
-  RealSrcSpan' r = RealSrcSpan r
-#endif
 {-# COMPLETE RealSrcSpan', UnhelpfulSpan #-}
 
-#if __GLASGOW_HASKELL__ <= 806 || __GLASGOW_HASKELL__ >= 900
 composeSrcSpan :: a -> a
 composeSrcSpan = id
 
 decomposeSrcSpan :: a -> a
 decomposeSrcSpan = id
 
 type SrcSpanLess a = a
-#endif
 
 type AnnSpan = RealSrcSpan
 badAnnSpan :: AnnSpan
 badAnnSpan =
-#if __GLASGOW_HASKELL__ >= 900
   badRealSrcSpan
-#else
-  noSrcSpan
-#endif
 
 srcSpanToAnnSpan :: SrcSpan -> AnnSpan
 srcSpanToAnnSpan =
-#if __GLASGOW_HASKELL__ >= 900
   \case RealSrcSpan l _ -> l; _ -> badRealSrcSpan
-#else
-  id
-#endif
 
 annSpanToSrcSpan :: AnnSpan -> SrcSpan
 annSpanToSrcSpan =
-#if __GLASGOW_HASKELL__ >= 900
   flip RealSrcSpan Strict.Nothing
-#else
-  id
-#endif
 
 setSrcSpanFile :: FastString -> SrcSpan -> SrcSpan
 setSrcSpanFile file s
@@ -279,128 +190,28 @@ setRealSrcSpanFile file s = mkRealSrcSpan start' end'
 
 setAnnSpanFile :: FastString -> AnnSpan -> AnnSpan
 setAnnSpanFile =
-#if __GLASGOW_HASKELL__ >= 900
   setRealSrcSpanFile
-#else
-  setSrcSpanFile
-#endif
 
 mkErr :: DynFlags -> SrcSpan -> String -> Errors
-#if __GLASGOW_HASKELL__ >= 810
 mkErr _df l s = mkMessages $ unitBag (mkPlainErrorMsgEnvelope l (ghcUnknownMessage $ mkDecoratedError [] [text s]))
-#else
-mkErr = const (,)
-#endif
 
 parseModuleName :: SrcSpan -> Parser (LocatedA GHC.ModuleName)
 parseModuleName ss _ _ s =
   let newMN =  GHC.L (GHC.noAnnSrcSpan ss) (GHC.mkModuleName s)
-#if __GLASGOW_HASKELL__ >= 900
-#else
-      newAnns = relativiseApiAnns newMN mempty
-#endif
   in pure newMN
 
-#if __GLASGOW_HASKELL__ <= 806 || __GLASGOW_HASKELL__ >= 900
 type DoGenReplacement an ast a =
   (Data ast, Data a) =>
   a ->
   (LocatedAn an ast -> Bool) ->
   LocatedAn an ast ->
   LocatedAn an ast ->
   StateT Bool IO (LocatedAn an ast)
-#else
-type DoGenReplacement ast a =
-  (Data (SrcSpanLess ast), HasSrcSpan ast, Data a) =>
-  a ->
-  (ast -> Bool) ->
-  ast ->
-  ast ->
-  StateT ((Anns, AnnKeyMap), Bool) IO ast
-#endif
 
-#if __GLASGOW_HASKELL__ <= 806 || __GLASGOW_HASKELL__ >= 900
 type ReplaceWorker a mod =
   (Data a, Data mod) =>
   mod ->
   Parser (GHC.LocatedA a) ->
   Int ->
   Refactoring SrcSpan ->
   IO mod
-#else
-type ReplaceWorker a mod =
-  (Data a, HasSrcSpan a, Data mod, Data (SrcSpanLess a)) =>
-  Anns ->
-  mod ->
-  AnnKeyMap ->
-  Parser a ->
-  Int ->
-  Refactoring SrcSpan ->
-  IO (Anns, mod, AnnKeyMap)
-#endif
-
-#if __GLASGOW_HASKELL__ < 900
--- | Copied from "Language.Haskell.GhclibParserEx.GHC.Driver.Session", in order to
--- support GHC 8.6
-impliedXFlags :: [(Extension, Bool, Extension)]
-impliedXFlags
--- See Note [Updating flag description in the User's Guide]
-  = [ (RankNTypes,                True, ExplicitForAll)
-    , (QuantifiedConstraints,     True, ExplicitForAll)
-    , (ScopedTypeVariables,       True, ExplicitForAll)
-    , (LiberalTypeSynonyms,       True, ExplicitForAll)
-    , (ExistentialQuantification, True, ExplicitForAll)
-    , (FlexibleInstances,         True, TypeSynonymInstances)
-    , (FunctionalDependencies,    True, MultiParamTypeClasses)
-    , (MultiParamTypeClasses,     True, ConstrainedClassMethods)  -- c.f. #7854
-    , (TypeFamilyDependencies,    True, TypeFamilies)
-
-    , (RebindableSyntax, False, ImplicitPrelude)      -- NB: turn off!
-
-    , (DerivingVia, True, DerivingStrategies)
-
-    , (GADTs,            True, GADTSyntax)
-    , (GADTs,            True, MonoLocalBinds)
-    , (TypeFamilies,     True, MonoLocalBinds)
-
-    , (TypeFamilies,     True, KindSignatures)  -- Type families use kind signatures
-    , (PolyKinds,        True, KindSignatures)  -- Ditto polymorphic kinds
-
-    -- TypeInType is now just a synonym for a couple of other extensions.
-    , (TypeInType,       True, DataKinds)
-    , (TypeInType,       True, PolyKinds)
-    , (TypeInType,       True, KindSignatures)
-
-    -- AutoDeriveTypeable is not very useful without DeriveDataTypeable
-    , (AutoDeriveTypeable, True, DeriveDataTypeable)
-
-    -- We turn this on so that we can export associated type
-    -- type synonyms in subordinates (e.g. MyClass(type AssocType))
-    , (TypeFamilies,     True, ExplicitNamespaces)
-    , (TypeOperators, True, ExplicitNamespaces)
-
-    , (ImpredicativeTypes,  True, RankNTypes)
-
-        -- Record wild-cards implies field disambiguation
-        -- Otherwise if you write (C {..}) you may well get
-        -- stuff like " 'a' not in scope ", which is a bit silly
-        -- if the compiler has just filled in field 'a' of constructor 'C'
-    , (RecordWildCards,     True, DisambiguateRecordFields)
-
-    , (ParallelArrays, True, ParallelListComp)
-
-    , (JavaScriptFFI, True, InterruptibleFFI)
-
-    , (DeriveTraversable, True, DeriveFunctor)
-    , (DeriveTraversable, True, DeriveFoldable)
-
-    -- Duplicate record fields require field disambiguation
-    , (DuplicateRecordFields, True, DisambiguateRecordFields)
-
-    , (TemplateHaskell, True, TemplateHaskellQuotes)
-    , (Strict, True, StrictData)
-#if __GLASGOW_HASKELL__ >= 810
-    , (StandaloneKindSignatures, False, CUSKs)
-#endif
-  ]
-#endif