Update splice plugin

.github/workflows/test.yml

@@ -162,8 +162,7 @@ jobs:
         name: Test hls-eval-plugin
         run: cabal test ${CABAL_ARGS} hls-eval-plugin-tests || cabal test ${CABAL_ARGS} hls-eval-plugin-tests
 
-      # TODO enable when it supports 9.10
-      - if: matrix.test && matrix.ghc != '9.10' && matrix.ghc != '9.12' && matrix.ghc != '9.14' && matrix.ghc != '9.10.2'
+      - if: matrix.test
         name: Test hls-splice-plugin
         run: cabal test ${CABAL_ARGS} hls-splice-plugin-tests || cabal test ${CABAL_ARGS} hls-splice-plugin-tests
 

docs/support/plugin-support.md

@@ -66,6 +66,6 @@ For example, a plugin to provide a formatter which has itself been abandoned has
 | `hls-semantic-tokens-plugin`         | 2    |                          |
 | `hls-stan-plugin`                    | 3    | 9.12.2, 9.14.1           |
 | `hls-retrie-plugin`                  | 3    | 9.10.1, 9.12.2, 9.14.1   |
-| `hls-splice-plugin`                  | 3    | 9.10.1, 9.12.2, 9.14.1   |
+| `hls-splice-plugin`                  | 3    |                          |
 
 [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

@@ -961,13 +961,13 @@ flag splice
   manual:      True
 
 common splice
-  if flag(splice) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds))
+  if flag(splice)
     build-depends: haskell-language-server:hls-splice-plugin
     cpp-options: -Dhls_splice
 
 library hls-splice-plugin
   import:           defaults, pedantic, warnings
-  if !(flag(splice) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds)))
+  if !(flag(splice))
     buildable: False
   exposed-modules:
     Ide.Plugin.Splice
@@ -995,7 +995,7 @@ library hls-splice-plugin
 
 test-suite hls-splice-plugin-tests
   import:           defaults, pedantic, test-defaults, warnings
-  if !(flag(splice) && (impl(ghc < 9.10) || flag(ignore-plugins-ghc-bounds)))
+  if !(flag(splice))
     buildable: False
   type:             exitcode-stdio-1.0
   hs-source-dirs:   plugins/hls-splice-plugin/test

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

@@ -301,7 +301,7 @@ graft' ::
     LocatedAn l ast ->
     Graft (Either String) a
 graft' needs_space dst val = Graft $ \dflags a -> do
-    val' <- annotate dflags needs_space val
+    val' <- annotate dflags needs_space dst val
     pure $
         everywhere'
             ( mkT $
@@ -371,7 +371,7 @@ graftExprWithM dst trans = Graft $ \dflags a -> do
                             Just val' -> do
                                 val'' <-
                                     hoistTransform (either Fail.fail pure)
-                                        (annotate @AnnListItem @(HsExpr GhcPs) dflags needs_space (mk_parens val'))
+                                        (annotate @AnnListItem @(HsExpr GhcPs) dflags needs_space dst (mk_parens val'))
                                 pure val''
                             Nothing -> pure val
                 l -> pure l
@@ -395,7 +395,7 @@ graftWithM dst trans = Graft $ \dflags a -> do
                             Just val' -> do
                                 val'' <-
                                     hoistTransform (either Fail.fail pure) $
-                                        annotate dflags False $ maybeParensAST val'
+                                        annotate dflags False dst $ maybeParensAST val'
                                 pure val''
                             Nothing -> pure val
                 l -> pure l
@@ -667,6 +667,7 @@ class
     , Typeable l
     , Outputable l
     , Outputable ast
+    , ExactPrint (LocatedAn l ast)
 #if !MIN_VERSION_ghc(9,9,0)
     , Default l
 #endif
@@ -719,20 +720,30 @@ instance ASTElement NameAnn RdrName where
 -- | Given an 'LHSExpr', compute its exactprint annotations.
 --   Note that this function will throw away any existing annotations (and format)
 annotate :: ASTElement l ast
-    => DynFlags -> Bool -> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast)
-annotate dflags needs_space ast = do
+    => DynFlags -> Bool -> SrcSpan -> LocatedAn l ast -> TransformT (Either String) (LocatedAn l ast)
+annotate dflags _needs_space _loc ast = do
     uniq <- show <$> uniqueSrcSpanT
     let rendered = render dflags ast
     expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseAST dflags uniq rendered
-    pure $ setPrecedingLines expr' 0 (bool 0 1 needs_space)
+#if MIN_VERSION_ghc(9,9,0)
+    let L l e = makeDeltaAst expr'
+    pure $ L l{entry = spanAsAnchor _loc} e
+#else
+    pure $ setPrecedingLines expr' 0 (bool 0 1 _needs_space)
+#endif
 
 -- | Given an 'LHsDecl', compute its exactprint annotations.
 annotateDecl :: DynFlags -> LHsDecl GhcPs -> TransformT (Either String) (LHsDecl GhcPs)
 annotateDecl dflags ast = do
     uniq <- show <$> uniqueSrcSpanT
     let rendered = render dflags ast
     expr' <- TransformT $ lift $ mapLeft (showSDoc dflags . ppr) $ parseDecl dflags uniq rendered
-    pure $ setPrecedingLines expr' 1 0
+#if MIN_VERSION_ghc(9,9,0)
+    let expr'' = makeDeltaAst expr'
+#else
+    let expr'' = expr'
+#endif
+    pure $ setPrecedingLines expr'' 1 0
 
 ------------------------------------------------------------------------------
 

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

@@ -60,7 +60,9 @@ import           Data.Foldable                         (Foldable (foldl'))
 
 import           GHC.Data.Bag                          (Bag)
 
-#if MIN_VERSION_ghc(9,9,0)
+#if MIN_VERSION_ghc(9,13,0)
+import           GHC.Parser.Annotation                 (EpAnn (..), EpToken (..))
+#elif MIN_VERSION_ghc(9,9,0)
 import           GHC.Parser.Annotation                 (EpAnn (..))
 #else
 import           GHC.Parser.Annotation                 (SrcSpanAnn' (..))
@@ -305,10 +307,18 @@ class (Outputable (ast GhcRn), ASTElement l (ast GhcPs)) => HasSplice l ast wher
 instance HasSplice AnnListItem HsExpr where
     type SpliceOf HsExpr = HsSpliceCompat
     matchSplice _ (HsUntypedSplice _ spl) = Just (UntypedSplice spl)
+#if MIN_VERSION_ghc(9,13,0)
+    matchSplice _ (HsTypedSplice _ (HsTypedSpliceExpr _ spl)) = Just (TypedSplice spl)
+#else
     matchSplice _ (HsTypedSplice _ spl)   = Just (TypedSplice spl)
+#endif
     matchSplice _ _                       = Nothing
     expandSplice _ (UntypedSplice e) = fmap (first Right) $ rnUntypedSpliceExpr e
+#if MIN_VERSION_ghc(9,13,0)
+    expandSplice _ (TypedSplice e) = fmap (first Right) $ rnTypedSplice (HsTypedSpliceExpr NoEpTok e)
+#else
     expandSplice _ (TypedSplice e) = fmap (first Right) $ rnTypedSplice e
+#endif
 
 instance HasSplice AnnListItem Pat where
     type SpliceOf Pat = HsUntypedSplice
@@ -408,7 +418,11 @@ toDiagnosticMessage message =
                           message
 
         , diagReason  = Error.diagnosticReason  message
+#if MIN_VERSION_ghc(9,13,0)
+        , diagHints   = []
+#else
         , diagHints   = Error.diagnosticHints   message
+#endif
         }
 
 -- | FIXME:  Is thereAny "clever" way to do this exploiting TTG?

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

@@ -54,6 +54,14 @@ tests = testGroup "splice"
   , goldenTest "TQQTypeTypeError" Inplace 8 28
   , goldenTest "TSimpleDecl" Inplace 8 1
   , goldenTest "TQQDecl" Inplace 5 1
+  , testGroup "Declaration Splices"
+      [ goldenTest "TDeclForeignImport" Inplace 5 1
+      , goldenTest "TDeclData" Inplace 5 1
+      , goldenTest "TDeclNewtype" Inplace 5 1
+      , goldenTest "TDeclInstance" Inplace 5 1
+      , goldenTest "TDeclPatSyn" Inplace 6 1
+      , goldenTest "TDeclPragma" Inplace 5 1
+      ]
   , goldenTestWithEdit "TTypeKindError" (
         if ghcVersion >= GHC96 then
           "96-expected"

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

@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+module TDeclData where
+import Language.Haskell.TH
+
+data MyData
+  = MyConA Int | MyConB String
+  deriving (Show, Eq)

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

@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+module TDeclData where
+import Language.Haskell.TH
+
+$(pure <$> dataD (pure []) (mkName "MyData") [] Nothing
+    [ normalC (mkName "MyConA") [bangType (bang noSourceUnpackedness noSourceStrictness) [t|Int|]]
+    , normalC (mkName "MyConB") [bangType (bang noSourceUnpackedness noSourceStrictness) [t|String|]]
+    ]
+    [derivClause Nothing [conT ''Show, conT ''Eq]])

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

@@ -0,0 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+module TDeclForeignImport where
+import Language.Haskell.TH
+
+foreign import ccall unsafe "math.h sin" c_sin :: Double -> Double

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

@@ -0,0 +1,5 @@
+{-# LANGUAGE TemplateHaskell #-}
+module TDeclForeignImport where
+import Language.Haskell.TH
+
+$(pure <$> forImpD cCall unsafe "math.h sin" (mkName "c_sin") [t|Double -> Double|])

plugins/hls-splice-plugin/test/testdata/TDeclInstance.expected.hs

@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+module TDeclInstance where
+import Language.Haskell.TH
+
+data Wrapper = MkWrapper Int
+instance Show Wrapper where
+  show (MkWrapper n) = ("Wrapper:" ++ show n)

plugins/hls-splice-plugin/test/testdata/TDeclInstance.hs

@@ -0,0 +1,12 @@
+{-# LANGUAGE TemplateHaskell #-}
+module TDeclInstance where
+import Language.Haskell.TH
+
+$(do dataDec <- dataD (pure []) (mkName "Wrapper") [] Nothing
+       [normalC (mkName "MkWrapper") [bangType (bang noSourceUnpackedness noSourceStrictness) [t|Int|]]]
+       []
+     instDec <- instanceD (pure []) (appT (conT ''Show) (conT (mkName "Wrapper")))
+       [ funD (mkName "show") [clause [conP (mkName "MkWrapper") [varP (mkName "n")]]
+           (normalB [|"Wrapper:" ++ show n|]) []]
+       ]
+     pure [dataDec, instDec])

plugins/hls-splice-plugin/test/testdata/TDeclNewtype.expected.hs

@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+module TDeclNewtype where
+import Language.Haskell.TH
+
+newtype MyNewtype
+  = MkMyNewtype Int
+  deriving Show

plugins/hls-splice-plugin/test/testdata/TDeclNewtype.hs

@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+module TDeclNewtype where
+import Language.Haskell.TH
+
+$(pure <$> newtypeD (pure []) (mkName "MyNewtype") [] Nothing
+    (normalC (mkName "MkMyNewtype") [bangType (bang noSourceUnpackedness noSourceStrictness) [t|Int|]])
+    [derivClause Nothing [conT ''Show]])

plugins/hls-splice-plugin/test/testdata/TDeclPatSyn.expected.hs

@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE PatternSynonyms #-}
+module TDeclPatSyn where
+import Language.Haskell.TH
+
+pattern MyPattern <- 42

plugins/hls-splice-plugin/test/testdata/TDeclPatSyn.hs

@@ -0,0 +1,6 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE PatternSynonyms #-}
+module TDeclPatSyn where
+import Language.Haskell.TH
+
+$(pure <$> patSynD (mkName "MyPattern") (prefixPatSyn []) unidir (litP (integerL 42)))

plugins/hls-splice-plugin/test/testdata/TDeclPragma.expected.hs

@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+module TDeclPragma where
+import Language.Haskell.TH
+
+myId :: Int -> Int
+{-# INLINE myId #-}
+myId x = x

plugins/hls-splice-plugin/test/testdata/TDeclPragma.hs

@@ -0,0 +1,9 @@
+{-# LANGUAGE TemplateHaskell #-}
+module TDeclPragma where
+import Language.Haskell.TH
+
+$(sequence
+    [ sigD (mkName "myId") [t|Int -> Int|]
+    , pragInlD (mkName "myId") Inline FunLike AllPhases
+    , funD (mkName "myId") [clause [varP (mkName "x")] (normalB (varE (mkName "x"))) []]
+    ])

test/testdata/schema/ghc910/default-config.golden.json

@@ -148,6 +148,9 @@
         "signatureHelp": {
             "globalOn": true
         },
+        "splice": {
+            "globalOn": true
+        },
         "stan": {
             "globalOn": false
         }

test/testdata/schema/ghc910/vscode-extension-schema.golden.json

@@ -1037,6 +1037,12 @@
         "scope": "resource",
         "type": "boolean"
     },
+    "haskell.plugin.splice.globalOn": {
+        "default": true,
+        "description": "Enables splice plugin",
+        "scope": "resource",
+        "type": "boolean"
+    },
     "haskell.plugin.stan.globalOn": {
         "default": false,
         "description": "Enables stan plugin",

test/testdata/schema/ghc912/default-config.golden.json

@@ -154,6 +154,9 @@
         },
         "signatureHelp": {
             "globalOn": true
+        },
+        "splice": {
+            "globalOn": true
         }
     },
     "sessionLoading": "singleComponent"

test/testdata/schema/ghc912/vscode-extension-schema.golden.json

@@ -1054,5 +1054,11 @@
         "description": "Enables signatureHelp plugin",
         "scope": "resource",
         "type": "boolean"
+    },
+    "haskell.plugin.splice.globalOn": {
+        "default": true,
+        "description": "Enables splice plugin",
+        "scope": "resource",
+        "type": "boolean"
     }
 }

test/testdata/schema/ghc914/default-config.golden.json

@@ -136,6 +136,9 @@
         },
         "signatureHelp": {
             "globalOn": true
+        },
+        "splice": {
+            "globalOn": true
         }
     },
     "sessionLoading": "singleComponent"

test/testdata/schema/ghc914/vscode-extension-schema.golden.json

@@ -1018,5 +1018,11 @@
         "description": "Enables signatureHelp plugin",
         "scope": "resource",
         "type": "boolean"
+    },
+    "haskell.plugin.splice.globalOn": {
+        "default": true,
+        "description": "Enables splice plugin",
+        "scope": "resource",
+        "type": "boolean"
     }
 }