Fix errs, detect splices

haskell · Apr 3, 2022 · 20dd3e0 · 20dd3e0
1 parent 352488a
commit 20dd3e0
Showing 1 changed file with 43 additions and 34 deletions.
diff --git a/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs b/plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs
@@ -57,6 +57,7 @@ import           Language.LSP.Server
 import           Language.LSP.Types
 import           Language.LSP.Types.Capabilities
 import qualified Language.LSP.Types.Lens         as J
+import qualified GHC.Types.Error as Error
 
 descriptor :: PluginId -> PluginDescriptor IdeState
 descriptor plId =
@@ -323,7 +324,7 @@ manualCalcEdit ::
 manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _eStyle ExpandSpliceParams {..} = do
     (warns, resl) <-
         ExceptT $ do
-            ((warns, errs), eresl) <-
+            (msgs, eresl) <-
                 initTcWithGbl hscEnv typechkd srcSpan $
                     case classifyAST spliceContext of
                         IsHsDecl -> fmap (fmap $ adjustToRange uri ran) $
@@ -352,6 +353,9 @@ 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
             pure $ (warns,) <$> fromMaybe (Left $ show errs) eresl
 
     unless
@@ -415,41 +419,46 @@ codeAction state plId (CodeActionParams _ _ docId ran _) = liftIO $
             RealSrcSpan ->
             GenericQ (SearchResult (RealSrcSpan, SpliceContext))
         detectSplice spn =
-            mkQ
+            let subSpan = RealSrcSpan spn Nothing
+            in mkQ
                 Continue
-                ( \case
-                    (L l@(RealSrcSpan spLoc _) expr :: LHsExpr GhcPs)
-                        | RealSrcSpan spn Nothing `isSubspanOf` l ->
-                            case expr of
-                                HsSpliceE {} -> Here (spLoc, Expr)
-                                _            -> Continue
-                    _ -> Stop
+                ( \loced@(L _ expr :: LHsExpr GhcPs) ->
+                        let thisSpan = getLocA loced
+                        in case thisSpan of
+                            RealSrcSpan realSrcSpanLoc _
+                                | subSpan `isSubspanOf` thisSpan
+                                    -> case expr of
+                                        HsSpliceE {} -> Here (realSrcSpanLoc, Expr)
+                                        _            -> Continue
+                            _ -> Stop
                 )
-                `extQ` \case
-#if __GLASGOW_HASKELL__ == 808
-                    (dL @(Pat GhcPs) -> L l@(RealSrcSpan spLoc _) pat :: Located (Pat GhcPs))
-#else
-                    (L l@(RealSrcSpan spLoc _) pat :: LPat GhcPs)
-#endif
-                        | RealSrcSpan spn Nothing `isSubspanOf` l ->
-                            case pat of
-                                SplicePat{} -> Here (spLoc, Pat)
-                                _           -> Continue
-                    _ -> Stop
-                `extQ` \case
-                    (L l@(RealSrcSpan spLoc _) ty :: LHsType GhcPs)
-                        | RealSrcSpan spn Nothing `isSubspanOf` l ->
-                            case ty of
-                                HsSpliceTy {} -> Here (spLoc, HsType)
-                                _             -> Continue
-                    _ -> Stop
-                `extQ` \case
-                    (L l@(RealSrcSpan spLoc _) decl :: LHsDecl GhcPs)
-                        | RealSrcSpan spn Nothing `isSubspanOf` l ->
-                            case decl of
-                                SpliceD {} -> Here (spLoc, HsDecl)
-                                _          -> Continue
-                    _ -> Stop
+                `extQ` (\loced@(L _ pat :: LPat GhcPs) ->
+                        let thisSpan = getLocA loced
+                        in case thisSpan of
+                            RealSrcSpan spLoc _
+                                | subSpan `isSubspanOf` thisSpan ->
+                                    case pat of
+                                        SplicePat{} -> Here (spLoc, Pat)
+                                        _           -> Continue
+                            _ -> Stop)
+                `extQ` (\loced@(L _ ty :: LHsType GhcPs) ->
+                        let thisSpan = getLocA loced
+                        in case thisSpan of
+                            RealSrcSpan spLoc _
+                                | subSpan `isSubspanOf` thisSpan ->
+                                    case ty of
+                                        HsSpliceTy {} -> Here (spLoc, HsType)
+                                        _             -> Continue
+                            _ -> Stop)
+                `extQ` (\loced@(L _ decl :: LHsDecl GhcPs) ->
+                        let thisSpan = getLocA loced
+                        in case thisSpan of
+                            RealSrcSpan spLoc _
+                                | subSpan `isSubspanOf` thisSpan ->
+                                    case decl of
+                                        SpliceD {} -> Here (spLoc, HsDecl)
+                                        _          -> Continue
+                            _ -> Stop)
 
 -- | Like 'something', but performs top-down searching, cutoffs when 'Stop' received,
 --   and picks inenrmost result.