Skip to content

Commit bfc3120

Browse files
georgefstfendor
georgefst
and
fendor
authored
Update splice plugin (#4915)
* Enable splice plugin on all GHCs * Add failing tests for TH declaration splices * Fix splice plugin on GHC 9.10 by using relative annotations in grafted nodes * Fix splice plugin on GHC 9.14 * Remove redundant constraint * Re-add diagnostics for GHC 9.14 splices * Fix incorrect merge conflict resolution Co-authored-by: fendor <fendor@users.noreply.github.com> * Fix further merge conflict issues Co-authored-by: fendor <fendor@users.noreply.github.com> --------- Co-authored-by: fendor <fendor@users.noreply.github.com>
1 parent b035c21 commit bfc3120

25 files changed

Lines changed: 165 additions & 15 deletions

‎.github/workflows/test.yml‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -162,8 +162,7 @@ jobs:
162162
name: Test hls-eval-plugin
163163
run: cabal test ${CABAL_ARGS} hls-eval-plugin-tests || cabal test ${CABAL_ARGS} hls-eval-plugin-tests
164164

165-
# TODO enable when it supports 9.10
166-
- if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' && matrix.ghc != '9.14' && matrix.ghc != '9.10.2'
165+
- if: matrix.test
167166
name: Test hls-splice-plugin
168167
run: cabal test ${CABAL_ARGS} hls-splice-plugin-tests || cabal test ${CABAL_ARGS} hls-splice-plugin-tests
169168

‎docs/support/plugin-support.md‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -65,6 +65,6 @@ For example, a plugin to provide a formatter which has itself been abandoned has
6565
| `hls-overloaded-record-dot-plugin` | 2 | |
6666
| `hls-semantic-tokens-plugin` | 2 | |
6767
| `hls-stan-plugin` | 3 | 9.12.2, 9.14.1 |
68-
| `hls-splice-plugin` | 3 | 9.10.1, 9.12.2, 9.14.1 |
68+
| `hls-splice-plugin` | 3 | |
6969

7070
[1]: HLint is incompatible with GHC 9.10 series. See the issue [#4674](https://github.com/haskell/haskell-language-server/issues/4674) for discussion and explanation.

‎haskell-language-server.cabal‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -901,13 +901,13 @@ flag splice
901901
manual: True
902902

903903
common splice
904-
if flag(splice) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds))
904+
if flag(splice)
905905
build-depends: haskell-language-server:hls-splice-plugin
906906
cpp-options: -Dhls_splice
907907

908908
library hls-splice-plugin
909909
import: defaults, pedantic, warnings
910-
if !(flag(splice) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds)))
910+
if !(flag(splice))
911911
buildable: False
912912
exposed-modules:
913913
Ide.Plugin.Splice
@@ -935,7 +935,7 @@ library hls-splice-plugin
935935

936936
test-suite hls-splice-plugin-tests
937937
import: defaults, pedantic, test-defaults, warnings
938-
if !(flag(splice) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds)))
938+
if !(flag(splice))
939939
buildable: False
940940
type: exitcode-stdio-1.0
941941
hs-source-dirs: plugins/hls-splice-plugin/test

‎plugins/hls-refactor-plugin/src/Development/IDE/GHC/ExactPrint.hs‎

Lines changed: 18 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -301,7 +301,7 @@ graft' ::
301301
LocatedAn l ast ->
302302
Graft (Either String) a
303303
graft' needs_space dst val = Graft $ \dflags a -> do
304-
val' <- annotate dflags needs_space val
304+
val' <- annotate dflags needs_space dst val
305305
pure $
306306
everywhere'
307307
( mkT $
@@ -371,7 +371,7 @@ graftExprWithM dst trans = Graft $ \dflags a -> do
371371
Just val' -> do
372372
val'' <-
373373
hoistTransform (either Fail.fail pure)
374-
(annotate @AnnListItem @(HsExpr GhcPs) dflags needs_space (mk_parens val'))
374+
(annotate @AnnListItem @(HsExpr GhcPs) dflags needs_space dst (mk_parens val'))
375375
pure val''
376376
Nothing -> pure val
377377
l -> pure l
@@ -395,7 +395,7 @@ graftWithM dst trans = Graft $ \dflags a -> do
395395
Just val' -> do
396396
val'' <-
397397
hoistTransform (either Fail.fail pure) $
398-
annotate dflags False $ maybeParensAST val'
398+
annotate dflags False dst $ maybeParensAST val'
399399
pure val''
400400
Nothing -> pure val
401401
l -> pure l
@@ -667,6 +667,7 @@ class
667667
, Typeable l
668668
, Outputable l
669669
, Outputable ast
670+
, ExactPrint (LocatedAn l ast)
670671
#if !MIN_VERSION_ghc(9,9,0)
671672
, Default l
672673
#endif
@@ -719,20 +720,30 @@ instance ASTElement NameAnn RdrName where
719720
-- | Given an 'LHSExpr', compute its exactprint annotations.
720721
-- Note that this function will throw away any existing annotations (and format)
721722
annotate :: ASTElement l ast
722-
=> DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast)
723-
annotate dflags needs_space ast = do
723+
=> DynFlags -> Bool -> SrcSpan -> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast)
724+
annotate dflags _needs_space _loc ast = do
724725
uniq <- show <$> uniqueSrcSpanT
725726
let rendered = render dflags ast
726727
expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseAST dflags uniq rendered
727-
pure $ setPrecedingLines expr' 0 (bool 0 1 needs_space)
728+
#if MIN_VERSION_ghc(9,9,0)
729+
let L l e = makeDeltaAst expr'
730+
pure $ L l{entry = spanAsAnchor _loc} e
731+
#else
732+
pure $ setPrecedingLines expr' 0 (bool 0 1 _needs_space)
733+
#endif
728734

729735
-- | Given an 'LHsDecl', compute its exactprint annotations.
730736
annotateDecl :: DynFlags -> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
731737
annotateDecl dflags ast = do
732738
uniq <- show <$> uniqueSrcSpanT
733739
let rendered = render dflags ast
734740
expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseDecl dflags uniq rendered
735-
pure $ setPrecedingLines expr' 1 0
741+
#if MIN_VERSION_ghc(9,9,0)
742+
let expr'' = makeDeltaAst expr'
743+
#else
744+
let expr'' = expr'
745+
#endif
746+
pure $ setPrecedingLines expr'' 1 0
736747

737748
------------------------------------------------------------------------------
738749

‎plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -243,7 +243,7 @@ moveCommentsToTheEnd (EpAnn entry anns (EpaCommentsBalanced priors following)) =
243243
#endif
244244

245245
liftParseAST
246-
:: forall ast l. (ASTElement l ast, ExactPrint (LocatedAn l ast))
246+
:: forall ast l. (ASTElement l ast)
247247
=> DynFlags -> String -> TransformT (Either String) (LocatedAn l ast)
248248
liftParseAST df s = case parseAST df "" s of
249249
Right x -> pure (makeDeltaAst x)

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

Lines changed: 19 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,9 @@ import Data.Foldable (Foldable (foldl'))
6060

6161
import GHC.Data.Bag (Bag)
6262

63-
#if MIN_VERSION_ghc(9,9,0)
63+
#if MIN_VERSION_ghc(9,13,0)
64+
import GHC.Parser.Annotation (EpAnn (..), EpToken (..))
65+
#elif MIN_VERSION_ghc(9,9,0)
6466
import GHC.Parser.Annotation (EpAnn (..))
6567
#else
6668
import GHC.Parser.Annotation (SrcSpanAnn' (..))
@@ -305,10 +307,18 @@ class (Outputable (ast GhcRn), ASTElement l (ast GhcPs)) => HasSplice l ast wher
305307
instance HasSplice AnnListItem HsExpr where
306308
type SpliceOf HsExpr = HsSpliceCompat
307309
matchSplice _ (HsUntypedSplice _ spl) = Just (UntypedSplice spl)
310+
#if MIN_VERSION_ghc(9,13,0)
311+
matchSplice _ (HsTypedSplice _ (HsTypedSpliceExpr _ spl)) = Just (TypedSplice spl)
312+
#else
308313
matchSplice _ (HsTypedSplice _ spl) = Just (TypedSplice spl)
314+
#endif
309315
matchSplice _ _ = Nothing
310316
expandSplice _ (UntypedSplice e) = fmap (first Right) $ rnUntypedSpliceExpr e
317+
#if MIN_VERSION_ghc(9,13,0)
318+
expandSplice _ (TypedSplice e) = fmap (first Right) $ rnTypedSplice (HsTypedSpliceExpr NoEpTok e)
319+
#else
311320
expandSplice _ (TypedSplice e) = fmap (first Right) $ rnTypedSplice e
321+
#endif
312322

313323
instance HasSplice AnnListItem Pat where
314324
type SpliceOf Pat = HsUntypedSplice
@@ -397,10 +407,18 @@ manualCalcEdit clientCapabilities reportEditor ran ps hscEnv typechkd srcSpan _e
397407
dflags = hsc_dflags hscEnv
398408
showErrors = showBag
399409

410+
#if MIN_VERSION_ghc(9,13,0)
411+
showBag :: (Error.Diagnostic a, Error.DiagnosticHint a ~ Error.GhcHint) => Bag (Error.MsgEnvelope a) -> String
412+
#else
400413
showBag :: Error.Diagnostic a => Bag (Error.MsgEnvelope a) -> String
414+
#endif
401415
showBag = show . fmap (fmap toDiagnosticMessage)
402416

417+
#if MIN_VERSION_ghc(9,13,0)
418+
toDiagnosticMessage :: forall a. (Error.Diagnostic a, Error.DiagnosticHint a ~ Error.GhcHint) => a -> Error.DiagnosticMessage
419+
#else
403420
toDiagnosticMessage :: forall a. Error.Diagnostic a => a -> Error.DiagnosticMessage
421+
#endif
404422
toDiagnosticMessage message =
405423
Error.DiagnosticMessage
406424
{ diagMessage = Error.diagnosticMessage

‎plugins/hls-splice-plugin/test/Main.hs‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -54,6 +54,14 @@ tests = testGroup "splice"
5454
, goldenTest "TQQTypeTypeError" Inplace 8 28
5555
, goldenTest "TSimpleDecl" Inplace 8 1
5656
, goldenTest "TQQDecl" Inplace 5 1
57+
, testGroup "Declaration Splices"
58+
[ goldenTest "TDeclForeignImport" Inplace 5 1
59+
, goldenTest "TDeclData" Inplace 5 1
60+
, goldenTest "TDeclNewtype" Inplace 5 1
61+
, goldenTest "TDeclInstance" Inplace 5 1
62+
, goldenTest "TDeclPatSyn" Inplace 6 1
63+
, goldenTest "TDeclPragma" Inplace 5 1
64+
]
5765
, goldenTestWithEdit "TTypeKindError" (
5866
if ghcVersion >= GHC96 then
5967
"96-expected"

‎plugins/hls-splice-plugin/test/testdata/TDeclData.expected.hs‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
{-# LANGUAGE TemplateHaskell #-}
2+
module TDeclData where
3+
import Language.Haskell.TH
4+
5+
data MyData
6+
= MyConA Int | MyConB String
7+
deriving (Show, Eq)

‎plugins/hls-splice-plugin/test/testdata/TDeclData.hs‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
{-# LANGUAGE TemplateHaskell #-}
2+
module TDeclData where
3+
import Language.Haskell.TH
4+
5+
$(pure <$> dataD (pure []) (mkName "MyData") [] Nothing
6+
[ normalC (mkName "MyConA") [bangType (bang noSourceUnpackedness noSourceStrictness) [t|Int|]]
7+
, normalC (mkName "MyConB") [bangType (bang noSourceUnpackedness noSourceStrictness) [t|String|]]
8+
]
9+
[derivClause Nothing [conT ''Show, conT ''Eq]])

‎plugins/hls-splice-plugin/test/testdata/TDeclForeignImport.expected.hs‎

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
{-# LANGUAGE TemplateHaskell #-}
2+
module TDeclForeignImport where
3+
import Language.Haskell.TH
4+
5+
foreign import ccall unsafe "math.h sin" c_sin :: Double -> Double

0 commit comments

Comments
 (0)