Skip to content

Commit 20dd3e0

Browse files
committed
Fix errs, detect splices
1 parent 352488a commit 20dd3e0

File tree

1 file changed

+43
-34
lines changed
  • plugins/hls-splice-plugin/src/Ide/Plugin

1 file changed

+43
-34
lines changed

plugins/hls-splice-plugin/src/Ide/Plugin/Splice.hs

Lines changed: 43 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -57,6 +57,7 @@ import Language.LSP.Server
5757
import Language.LSP.Types
5858
import Language.LSP.Types.Capabilities
5959
import qualified Language.LSP.Types.Lens as J
60+
import qualified GHC.Types.Error as Error
6061

6162
descriptor :: PluginId -> PluginDescriptor IdeState
6263
descriptor plId =
@@ -323,7 +324,7 @@ manualCalcEdit ::
323324
manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _eStyle ExpandSpliceParams {..} = do
324325
(warns, resl) <-
325326
ExceptT $ do
326-
((warns, errs), eresl) <-
327+
(msgs, eresl) <-
327328
initTcWithGbl hscEnv typechkd srcSpan $
328329
case classifyAST spliceContext of
329330
IsHsDecl -> fmap (fmap $ adjustToRange uri ran) $
@@ -352,6 +353,9 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e
352353
)
353354
Just <$> either (pure . L _spn) (unRenamedE dflags) eExpr
354355
_ -> pure Nothing
356+
let
357+
warns = Error.getWarningMessages msgs
358+
errs = Error.getErrorMessages msgs
355359
pure $ (warns,) <$> fromMaybe (Left $ show errs) eresl
356360

357361
unless
@@ -415,41 +419,46 @@ codeAction state plId (CodeActionParams _ _ docId ran _) = liftIO $
415419
RealSrcSpan ->
416420
GenericQ (SearchResult (RealSrcSpan, SpliceContext))
417421
detectSplice spn =
418-
mkQ
422+
let subSpan = RealSrcSpan spn Nothing
423+
in mkQ
419424
Continue
420-
( \case
421-
(L l@(RealSrcSpan spLoc _) expr :: LHsExpr GhcPs)
422-
| RealSrcSpan spn Nothing `isSubspanOf` l ->
423-
case expr of
424-
HsSpliceE {} -> Here (spLoc, Expr)
425-
_ -> Continue
426-
_ -> Stop
425+
( \loced@(L _ expr :: LHsExpr GhcPs) ->
426+
let thisSpan = getLocA loced
427+
in case thisSpan of
428+
RealSrcSpan realSrcSpanLoc _
429+
| subSpan `isSubspanOf` thisSpan
430+
-> case expr of
431+
HsSpliceE {} -> Here (realSrcSpanLoc, Expr)
432+
_ -> Continue
433+
_ -> Stop
427434
)
428-
`extQ` \case
429-
#if __GLASGOW_HASKELL__ == 808
430-
(dL @(Pat GhcPs) -> L l@(RealSrcSpan spLoc _) pat :: Located (Pat GhcPs))
431-
#else
432-
(L l@(RealSrcSpan spLoc _) pat :: LPat GhcPs)
433-
#endif
434-
| RealSrcSpan spn Nothing `isSubspanOf` l ->
435-
case pat of
436-
SplicePat{} -> Here (spLoc, Pat)
437-
_ -> Continue
438-
_ -> Stop
439-
`extQ` \case
440-
(L l@(RealSrcSpan spLoc _) ty :: LHsType GhcPs)
441-
| RealSrcSpan spn Nothing `isSubspanOf` l ->
442-
case ty of
443-
HsSpliceTy {} -> Here (spLoc, HsType)
444-
_ -> Continue
445-
_ -> Stop
446-
`extQ` \case
447-
(L l@(RealSrcSpan spLoc _) decl :: LHsDecl GhcPs)
448-
| RealSrcSpan spn Nothing `isSubspanOf` l ->
449-
case decl of
450-
SpliceD {} -> Here (spLoc, HsDecl)
451-
_ -> Continue
452-
_ -> Stop
435+
`extQ` (\loced@(L _ pat :: LPat GhcPs) ->
436+
let thisSpan = getLocA loced
437+
in case thisSpan of
438+
RealSrcSpan spLoc _
439+
| subSpan `isSubspanOf` thisSpan ->
440+
case pat of
441+
SplicePat{} -> Here (spLoc, Pat)
442+
_ -> Continue
443+
_ -> Stop)
444+
`extQ` (\loced@(L _ ty :: LHsType GhcPs) ->
445+
let thisSpan = getLocA loced
446+
in case thisSpan of
447+
RealSrcSpan spLoc _
448+
| subSpan `isSubspanOf` thisSpan ->
449+
case ty of
450+
HsSpliceTy {} -> Here (spLoc, HsType)
451+
_ -> Continue
452+
_ -> Stop)
453+
`extQ` (\loced@(L _ decl :: LHsDecl GhcPs) ->
454+
let thisSpan = getLocA loced
455+
in case thisSpan of
456+
RealSrcSpan spLoc _
457+
| subSpan `isSubspanOf` thisSpan ->
458+
case decl of
459+
SpliceD {} -> Here (spLoc, HsDecl)
460+
_ -> Continue
461+
_ -> Stop)
453462

454463
-- | Like 'something', but performs top-down searching, cutoffs when 'Stop' received,
455464
-- and picks inenrmost result.

0 commit comments

Comments
 (0)