Fix backcompat

haskell · Apr 3, 2022 · 6b00690 · 6b00690
1 parent 20dd3e0
commit 6b00690
Showing 1 changed file with 28 additions and 12 deletions.
diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs
@@ -57,7 +57,9 @@ import           Language.LSP.Server
 import           Language.LSP.Types
 import           Language.LSP.Types.Capabilities
 import qualified Language.LSP.Types.Lens         as J
+#if __GLASGOW_HASKELL__ >= 902
 import qualified GHC.Types.Error as Error
+#endif
 
 descriptor :: PluginId -> PluginDescriptor IdeState
 descriptor plId =
@@ -122,13 +124,13 @@ expandTHSplice _eStyle ideState params@ExpandSpliceParams {..} = do
         withTypeChecked fp TcModuleResult {..} = do
             (ps, _hscEnv, dflags) <- setupHscEnv ideState fp tmrParsed
             let Splices {..} = tmrTopLevelSplices
-            let
+            let exprSuperSpans =
+                    listToMaybe $ findSubSpansDesc srcSpan exprSplices
                 _patSuperSpans =
+#if __GLASGOW_HASKELL__ == 808
+                    fmap (second dL) $
+#endif
                     listToMaybe $ findSubSpansDesc srcSpan patSplices
-
-                exprSuperSpans =
-                    listToMaybe $ findSubSpansDesc srcSpan exprSplices
-
                 typeSuperSpans =
                     listToMaybe $ findSubSpansDesc srcSpan typeSplices
                 declSuperSpans =
@@ -269,8 +271,7 @@ findSubSpansDesc :: SrcSpan -> [(LHsExpr GhcTc, a)] -> [(SrcSpan, a)]
 findSubSpansDesc srcSpan =
     sortOn (Down . SubSpan . fst)
         . mapMaybe
-            ( \(lcted, e) -> do
-                let spn = getLocA lcted
+            ( \(getLocA -> spn, e) -> do
                 guard (spn `isSubspanOf` srcSpan)
                 pure (spn, e)
             )
@@ -353,9 +354,12 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e
                                                     )
                                         Just <$> either (pure . L _spn) (unRenamedE dflags) eExpr
                                     _ -> pure Nothing
-            let
-                warns = Error.getWarningMessages msgs
-                errs = Error.getErrorMessages msgs
+            let (warns, errs) =
+#if __GLASGOW_HASKELL__ >= 902
+                    (Error.getWarningMessages msgs, Error.getErrorMessages msgs)
+#else
+                    msgs
+#endif
             pure $ (warns,) <$> fromMaybe (Left $ show errs) eresl
 
     unless
@@ -379,10 +383,17 @@ unRenamedE ::
     TransformT m (LocatedAn l (ast GhcPs))
 unRenamedE dflags expr = do
     uniq <- show <$> uniqueSrcSpanT
-    either (fail . show) pure $
+    r <- either (fail . show) pure $
         parseAST @_ @(ast GhcPs) dflags uniq $
             showSDoc dflags $ ppr expr
 
+#if __GLASGOW_HASKELL__ >= 902
+    pure r
+#else
+    let (_anns, expr') = r
+    pure expr'
+#endif
+
 data SearchResult r =
     Continue | Stop | Here r
     deriving (Read, Show, Eq, Ord, Data, Typeable)
@@ -432,7 +443,12 @@ codeAction state plId (CodeActionParams _ _ docId ran _) = liftIO $
                                         _            -> Continue
                             _ -> Stop
                 )
-                `extQ` (\loced@(L _ pat :: LPat GhcPs) ->
+                `extQ` (
+#if __GLASGOW_HASKELL__ == 808
+                    \dL @(Pat GhcPs) -> loced@(L _ pat :: Located (Pat GhcPs)) ->
+#else
+                    \loced@(L _ pat :: LPat GhcPs) ->
+#endif
                         let thisSpan = getLocA loced
                         in case thisSpan of
                             RealSrcSpan spLoc _