Regression tests for Declaration splice and kind-error ones

Author: konn

test/functional/Splice.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -8,6 +9,7 @@ import Control.Monad
 import Control.Monad.IO.Class
 import Data.List (find)
 import Data.Text (Text)
+import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Ide.Plugin.Splice.Types
 import Language.Haskell.LSP.Test
@@ -17,9 +19,12 @@ import Language.Haskell.LSP.Types
       CodeAction (..),
       Position (..),
       Range (..),
+      TextDocumentContentChangeEvent (..),
+      TextEdit (..),
     )
 import System.Directory
 import System.FilePath
+import System.Time.Extra (sleep)
 import Test.Hls.Util
 import Test.Tasty
 import Test.Tasty.HUnit
@@ -55,6 +60,9 @@ tests =
         , goldenTest "TQQTypeTypeError.hs" Inplace 8 19
         , goldenTest "TQQTypeTypeError.hs" Inplace 8 28
         , goldenTest "TSimpleDecl.hs" Inplace 8 1
+        , goldenTest "TQQDecl.hs" Inplace 5 1
+        , goldenTestWithEdit "TTypeKindError.hs" Inplace 7 9
+        , goldenTestWithEdit "TDeclKindError.hs" Inplace 8 1
         ]
 
 goldenTest :: FilePath -> ExpandStyle -> Int -> Int -> TestTree
@@ -78,6 +86,38 @@ goldenTest input tc line col =
             expected <- liftIO $ T.readFile expected_name
             liftIO $ edited @?= expected
 
+goldenTestWithEdit :: FilePath -> ExpandStyle -> Int -> Int -> TestTree
+goldenTestWithEdit input tc line col =
+    testCase (input <> " (golden)") $ do
+        runSession hlsCommand fullCaps spliceTestPath $ do
+            doc <- openDoc input "haskell"
+            orig <- documentContents doc
+            let lns = T.lines orig
+                theRange =
+                    Range
+                        { _start = Position 0 0
+                        , _end = Position (length lns + 1) 1
+                        }
+            liftIO $ sleep 1
+            alt <- liftIO $ T.readFile (spliceTestPath </> input <.> "error")
+            void $ applyEdit doc $ TextEdit theRange alt
+            changeDoc doc [TextDocumentContentChangeEvent (Just theRange) Nothing alt]
+            void waitForDiagnostics
+            actions <- getCodeActions doc $ pointRange line col
+            Just (CACodeAction CodeAction {_command = Just c}) <-
+                pure $ find ((== Just (toExpandCmdTitle tc)) . codeActionTitle) actions
+            executeCommand c
+            _resp :: ApplyWorkspaceEditRequest <- skipManyTill anyMessage message
+            edited <- documentContents doc
+            let expected_name = spliceTestPath </> input <.> "expected"
+            -- Write golden tests if they don't already exist
+            liftIO $
+                (doesFileExist expected_name >>=) $
+                    flip unless $ do
+                        T.writeFile expected_name edited
+            expected <- liftIO $ T.readFile expected_name
+            liftIO $ edited @?= expected
+
 spliceTestPath :: FilePath
 spliceTestPath = "test/testdata/splice"
 

test/testdata/splice/TDeclKindError.hs

@@ -0,0 +1,15 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+module TSimpleDecl where
+import Language.Haskell.TH ( mkName, clause, normalB, funD, sigD )
+
+-- Foo
+--  Bar
+$(sequence
+    [sigD (mkName "foo") [t|Int|]
+    ,funD (mkName "foo") [clause [] (normalB [|42|]) []]
+    ]
+    )
+-- Bar
+-- ee
+-- dddd

test/testdata/splice/TDeclKindError.hs.error

@@ -0,0 +1,16 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+module TSimpleDecl where
+import Language.Haskell.TH ( mkName, clause, normalB, funD, sigD )
+
+-- Foo
+--  Bar
+$(sequence
+    [sigD (mkName "foo") [t|Int|]
+    ,funD (mkName "foo") [clause [] (normalB [|42|]) []]
+    ,sigD (mkName "bar") [t|Int|]
+    ]
+    )
+-- Bar
+-- ee
+-- dddd

test/testdata/splice/TDeclKindError.hs.expected

@@ -0,0 +1,13 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+module TSimpleDecl where
+import Language.Haskell.TH ( mkName, clause, normalB, funD, sigD )
+
+-- Foo
+--  Bar
+foo :: Int
+foo = 42
+bar :: Int
+-- Bar
+-- ee
+-- dddd

test/testdata/splice/TQQDecl.hs

@@ -0,0 +1,5 @@
+{-# LANGUAGE QuasiQuotes #-}
+module TQQDecl where
+import QQ (str)
+
+[str|foo|]

test/testdata/splice/TQQDecl.hs.expected

@@ -0,0 +1,6 @@
+{-# LANGUAGE QuasiQuotes #-}
+module TQQDecl where
+import QQ (str)
+
+foo :: String
+foo = "foo"

test/testdata/splice/TTypeKindError.hs

@@ -4,5 +4,5 @@ module TTypeKindError where
 import Language.Haskell.TH ( numTyLit, litT )
 import Data.Proxy ( Proxy )
 
-main :: $(litT (numTyLit 42))
+main :: IO ()
 main = return ()

test/testdata/splice/TTypeKindError.hs.error

@@ -0,0 +1,8 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TemplateHaskell #-}
+module TTypeKindError where
+import Language.Haskell.TH ( numTyLit, litT )
+import Data.Proxy ( Proxy )
+
+main :: $(litT (numTyLit 42))
+main = return ()

test/testdata/splice/TTypeKindError.hs.expected

@@ -4,5 +4,5 @@ module TTypeKindError where
 import Language.Haskell.TH ( numTyLit, litT )
 import Data.Proxy ( Proxy )
 
-main :: 42
+main :: (42)
 main = return ()