diff --git a/haskell-language-server.cabal b/haskell-language-server.cabal index bfb3916baf..187d75e6b5 100644 --- a/haskell-language-server.cabal +++ b/haskell-language-server.cabal @@ -246,6 +246,7 @@ test-suite func-test , ghcide:ghcide-test-preprocessor build-depends: base >=4.7 && <5 , aeson + , bytestring , data-default , directory , filepath @@ -258,6 +259,7 @@ test-suite func-test , tasty , tasty-ant-xml >= 1.1.6 , tasty-expected-failure + , tasty-golden , tasty-hunit , tasty-rerun , text diff --git a/test/functional/Format.hs b/test/functional/Format.hs index e23c5a6eb1..bffaa596a5 100644 --- a/test/functional/Format.hs +++ b/test/functional/Format.hs @@ -3,25 +3,28 @@ module Format (tests) where import Control.Monad.IO.Class import Data.Aeson +import qualified Data.ByteString.Lazy as BS import qualified Data.Text as T +import qualified Data.Text.Encoding as T import Language.Haskell.LSP.Test import Language.Haskell.LSP.Types import Test.Hls.Util import Test.Tasty import Test.Tasty.ExpectedFailure (ignoreTestBecause) +import Test.Tasty.Golden import Test.Tasty.HUnit import Test.Hspec.Expectations tests :: TestTree tests = testGroup "format document" [ - ignoreTestBecause "Broken" $ testCase "works" $ runSession hieCommand fullCaps "test/testdata" $ do + goldenVsStringDiff "works" goldenGitDiff "test/testdata/Format.formatted_document.hs" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "Format.hs" "haskell" formatDoc doc (FormattingOptions 2 True) - documentContents doc >>= liftIO . (`shouldBe` formattedDocTabSize2) - , ignoreTestBecause "Broken" $ testCase "works with custom tab size" $ runSession hieCommand fullCaps "test/testdata" $ do + BS.fromStrict . T.encodeUtf8 <$> documentContents doc + , goldenVsStringDiff "works with custom tab size" goldenGitDiff "test/testdata/Format.formatted_document_with_tabsize.hs" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "Format.hs" "haskell" formatDoc doc (FormattingOptions 5 True) - documentContents doc >>= liftIO . (`shouldBe` formattedDocTabSize5) + BS.fromStrict . T.encodeUtf8 <$> documentContents doc , rangeTests , providerTests , stylishHaskellTests @@ -31,14 +34,14 @@ tests = testGroup "format document" [ rangeTests :: TestTree rangeTests = testGroup "format range" [ - ignoreTestBecause "Broken" $ testCase "works" $ runSession hieCommand fullCaps "test/testdata" $ do + goldenVsStringDiff "works" goldenGitDiff "test/testdata/Format.formatted_range.hs" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "Format.hs" "haskell" formatRange doc (FormattingOptions 2 True) (Range (Position 1 0) (Position 3 10)) - documentContents doc >>= liftIO . (`shouldBe` formattedRangeTabSize2) - , ignoreTestBecause "Broken" $ testCase "works with custom tab size" $ runSession hieCommand fullCaps "test/testdata" $ do + BS.fromStrict . T.encodeUtf8 <$> documentContents doc + , goldenVsStringDiff "works with custom tab size" goldenGitDiff "test/testdata/Format.formatted_range_with_tabsize.hs" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "Format.hs" "haskell" formatRange doc (FormattingOptions 5 True) (Range (Position 4 0) (Position 7 19)) - documentContents doc >>= liftIO . (`shouldBe` formattedRangeTabSize5) + BS.fromStrict . T.encodeUtf8 <$> documentContents doc ] providerTests :: TestTree @@ -58,7 +61,7 @@ providerTests = testGroup "formatting provider" [ sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany")) formatDoc doc (FormattingOptions 2 True) - documentContents doc >>= liftIO . (`shouldBe` formattedDocTabSize2) + documentContents doc >>= liftIO . (`shouldBe` formattedBrittany) sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "floskell")) formatDoc doc (FormattingOptions 2 True) @@ -71,84 +74,58 @@ providerTests = testGroup "formatting provider" [ stylishHaskellTests :: TestTree stylishHaskellTests = testGroup "stylish-haskell" [ - testCase "formats a file" $ runSession hieCommand fullCaps "test/testdata" $ do + goldenVsStringDiff "formats a document" goldenGitDiff "test/testdata/StylishHaksell.formatted_document.hs" $ runSession hieCommand fullCaps "test/testdata" $ do sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "stylish-haskell")) doc <- openDoc "StylishHaskell.hs" "haskell" formatDoc doc (FormattingOptions 2 True) - contents <- documentContents doc - liftIO $ contents `shouldBe` - "import Data.Char\n\ - \import qualified Data.List\n\ - \import Data.String\n\ - \\n\ - \bar :: Maybe (Either String Integer) -> Integer\n\ - \bar Nothing = 0\n\ - \bar (Just (Left _)) = 0\n\ - \bar (Just (Right x)) = x\n" - , testCase "formats a range" $ runSession hieCommand fullCaps "test/testdata" $ do + BS.fromStrict . T.encodeUtf8 <$> documentContents doc + , goldenVsStringDiff "formats a range" goldenGitDiff "test/testdata/StylishHaksell.formatted_range.hs" $ runSession hieCommand fullCaps "test/testdata" $ do sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "stylish-haskell")) doc <- openDoc "StylishHaskell.hs" "haskell" formatRange doc (FormattingOptions 2 True) (Range (Position 0 0) (Position 2 21)) - contents <- documentContents doc - liftIO $ contents `shouldBe` - "import Data.Char\n\ - \import qualified Data.List\n\ - \import Data.String\n\ - \\n\ - \bar :: Maybe (Either String Integer) -> Integer\n\ - \bar Nothing = 0\n\ - \bar (Just (Left _)) = 0\n\ - \bar (Just (Right x)) = x\n" + BS.fromStrict . T.encodeUtf8 <$> documentContents doc ] brittanyTests :: TestTree brittanyTests = testGroup "brittany" [ - ignoreTestBecause "Broken" $ testCase "formats a document with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do + goldenVsStringDiff "formats a document with LF endings" goldenGitDiff "test/testdata/BrittanyLF.formatted_document.hs" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "BrittanyLF.hs" "haskell" - let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing - ResponseMessage _ _ (Right edits) <- request TextDocumentFormatting opts - liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 3 0)) - "foo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return 42\n"] + formatDoc doc (FormattingOptions 4 True) + BS.fromStrict . T.encodeUtf8 <$> documentContents doc - , ignoreTestBecause "Broken" $ testCase "formats a document with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do + , goldenVsStringDiff "formats a document with CRLF endings" goldenGitDiff "test/testdata/BrittanyCRLF.formatted_document.hs" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "BrittanyCRLF.hs" "haskell" - let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing - ResponseMessage _ _ (Right edits) <- request TextDocumentFormatting opts - liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 3 0)) - "foo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return 42\n"] + formatDoc doc (FormattingOptions 4 True) + BS.fromStrict . T.encodeUtf8 <$> documentContents doc - , ignoreTestBecause "Broken" $ testCase "formats a range with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do + , goldenVsStringDiff "formats a range with LF endings" goldenGitDiff "test/testdata/BrittanyLF.formatted_range.hs" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "BrittanyLF.hs" "haskell" let range = Range (Position 1 0) (Position 2 22) - opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing - ResponseMessage _ _ (Right edits) <- request TextDocumentRangeFormatting opts - liftIO $ edits `shouldBe` [TextEdit (Range (Position 1 0) (Position 3 0)) - "foo x y = do\n print x\n return 42\n"] + formatRange doc (FormattingOptions 4 True) range + BS.fromStrict . T.encodeUtf8 <$> documentContents doc - , ignoreTestBecause "Broken" $ testCase "formats a range with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do + , goldenVsStringDiff "formats a range with CRLF endings" goldenGitDiff "test/testdata/BrittanyCRLF.formatted_range.hs" $ runSession hieCommand fullCaps "test/testdata" $ do doc <- openDoc "BrittanyCRLF.hs" "haskell" let range = Range (Position 1 0) (Position 2 22) - opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing - ResponseMessage _ _ (Right edits) <- request TextDocumentRangeFormatting opts - liftIO $ edits `shouldBe` [TextEdit (Range (Position 1 0) (Position 3 0)) - "foo x y = do\n print x\n return 42\n"] + formatRange doc (FormattingOptions 4 True) range + BS.fromStrict . T.encodeUtf8 <$> documentContents doc ] ormoluTests :: TestTree ormoluTests = testGroup "ormolu" [ - ignoreTestBecause "Broken" $ testCase "formats correctly" $ runSession hieCommand fullCaps "test/testdata" $ do + goldenVsStringDiff "formats correctly" goldenGitDiff ("test/testdata/Format.ormolu." ++ ormoluGoldenSuffix ++ ".hs") $ runSession hieCommand fullCaps "test/testdata" $ do let formatLspConfig provider = object [ "languageServerHaskell" .= object ["formattingProvider" .= (provider :: Value)] ] sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu")) doc <- openDoc "Format.hs" "haskell" formatDoc doc (FormattingOptions 2 True) - docContent <- documentContents doc - let formatted = liftIO $ docContent `shouldBe` formattedOrmolu - case ghcVersion of - GHC88 -> formatted - GHC86 -> formatted - _ -> liftIO $ docContent `shouldBe` unchangedOrmolu + BS.fromStrict . T.encodeUtf8 <$> documentContents doc ] + where + ormoluGoldenSuffix = case ghcVersion of + GHC88 -> "formatted" + GHC86 -> "formatted" + _ -> "unchanged" formatLspConfig :: Value -> Value @@ -157,9 +134,12 @@ formatLspConfig provider = object [ "languageServerHaskell" .= object ["formatti formatConfig :: Value -> SessionConfig formatConfig provider = defaultConfig { lspConfig = Just (formatLspConfig provider) } +goldenGitDiff :: FilePath -> FilePath -> [String] +goldenGitDiff fRef fNew = ["git", "diff", "--no-index", "--text", "--exit-code", fRef, fNew] -formattedDocTabSize2 :: T.Text -formattedDocTabSize2 = + +formattedBrittany :: T.Text +formattedBrittany = "module Format where\n\ \foo :: Int -> Int\n\ \foo 3 = 2\n\ @@ -170,44 +150,6 @@ formattedDocTabSize2 = \ return \"asdf\"\n\n\ \data Baz = Baz { a :: Int, b :: String }\n\n" -formattedDocTabSize5 :: T.Text -formattedDocTabSize5 = - "module Format where\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\n\ - \data Baz = Baz { a :: Int, b :: String }\n\n" - -formattedRangeTabSize2 :: T.Text -formattedRangeTabSize2 = - "module Format where\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\ - \\n\ - \data Baz = Baz { a :: Int, b :: String }\n\n" - -formattedRangeTabSize5 :: T.Text -formattedRangeTabSize5 = - "module Format where\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\ - \\n\ - \data Baz = Baz { a :: Int, b :: String }\n\n" - formattedFloskell :: T.Text formattedFloskell = "module Format where\n\ @@ -235,30 +177,3 @@ formattedBrittanyPostFloskell = \ x <- return \"hello\"\n\ \ return \"asdf\"\n\n\ \data Baz = Baz { a :: Int, b :: String }\n\n" - -formattedOrmolu :: T.Text -formattedOrmolu = - "module Format where\n\ - \\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\n\ - \data Baz = Baz {a :: Int, b :: String}\n" - -unchangedOrmolu :: T.Text -unchangedOrmolu = - "module Format where\n\ - \foo :: Int -> Int\n\ - \foo 3 = 2\n\ - \foo x = x\n\ - \bar :: String -> IO String\n\ - \bar s = do\n\ - \ x <- return \"hello\"\n\ - \ return \"asdf\"\n\ - \\n\ - \data Baz = Baz { a :: Int, b :: String }\n\n" diff --git a/test/testdata/BrittanyCRLF.formatted_document.hs b/test/testdata/BrittanyCRLF.formatted_document.hs new file mode 100644 index 0000000000..13250a383e --- /dev/null +++ b/test/testdata/BrittanyCRLF.formatted_document.hs @@ -0,0 +1,4 @@ +foo :: Int -> String -> IO () +foo x y = do + print x + return 42 \ No newline at end of file diff --git a/test/testdata/BrittanyCRLF.formatted_range.hs b/test/testdata/BrittanyCRLF.formatted_range.hs new file mode 100644 index 0000000000..13250a383e --- /dev/null +++ b/test/testdata/BrittanyCRLF.formatted_range.hs @@ -0,0 +1,4 @@ +foo :: Int -> String -> IO () +foo x y = do + print x + return 42 \ No newline at end of file diff --git a/test/testdata/BrittanyLF.formatted_document.hs b/test/testdata/BrittanyLF.formatted_document.hs new file mode 100644 index 0000000000..13250a383e --- /dev/null +++ b/test/testdata/BrittanyLF.formatted_document.hs @@ -0,0 +1,4 @@ +foo :: Int -> String -> IO () +foo x y = do + print x + return 42 \ No newline at end of file diff --git a/test/testdata/BrittanyLF.formatted_range.hs b/test/testdata/BrittanyLF.formatted_range.hs new file mode 100644 index 0000000000..13250a383e --- /dev/null +++ b/test/testdata/BrittanyLF.formatted_range.hs @@ -0,0 +1,4 @@ +foo :: Int -> String -> IO () +foo x y = do + print x + return 42 \ No newline at end of file diff --git a/test/testdata/Format.formatted_document.hs b/test/testdata/Format.formatted_document.hs new file mode 100644 index 0000000000..ec1ce57379 --- /dev/null +++ b/test/testdata/Format.formatted_document.hs @@ -0,0 +1,12 @@ +module Format where + +foo :: Int -> Int +foo 3 = 2 +foo x = x +bar :: String -> IO String +bar s = do + x <- return "hello" + return "asdf" + +data Baz = Baz {a :: Int, b :: String} + diff --git a/test/testdata/Format.formatted_document_with_tabsize.hs b/test/testdata/Format.formatted_document_with_tabsize.hs new file mode 100644 index 0000000000..ec1ce57379 --- /dev/null +++ b/test/testdata/Format.formatted_document_with_tabsize.hs @@ -0,0 +1,12 @@ +module Format where + +foo :: Int -> Int +foo 3 = 2 +foo x = x +bar :: String -> IO String +bar s = do + x <- return "hello" + return "asdf" + +data Baz = Baz {a :: Int, b :: String} + diff --git a/test/testdata/Format.formatted_range.hs b/test/testdata/Format.formatted_range.hs new file mode 100644 index 0000000000..393584a9e4 --- /dev/null +++ b/test/testdata/Format.formatted_range.hs @@ -0,0 +1,12 @@ +module Format where + +foo :: Int -> Int +foo 3 = 2 +foo x = x +bar :: String -> IO String +bar s = do + x <- return "hello" + return "asdf" + +data Baz = Baz { a :: Int, b :: String } + diff --git a/test/testdata/Format.formatted_range_with_tabsize.hs b/test/testdata/Format.formatted_range_with_tabsize.hs new file mode 100644 index 0000000000..0a98f42e8f --- /dev/null +++ b/test/testdata/Format.formatted_range_with_tabsize.hs @@ -0,0 +1,12 @@ +module Format where +foo :: Int -> Int +foo 3 = 2 +foo x = x +bar :: String -> IO String +bar s = do + x <- return "hello" + return "asdf" + + +data Baz = Baz { a :: Int, b :: String } + diff --git a/test/testdata/Format.ormolu.formatted.hs b/test/testdata/Format.ormolu.formatted.hs new file mode 100644 index 0000000000..ec1ce57379 --- /dev/null +++ b/test/testdata/Format.ormolu.formatted.hs @@ -0,0 +1,12 @@ +module Format where + +foo :: Int -> Int +foo 3 = 2 +foo x = x +bar :: String -> IO String +bar s = do + x <- return "hello" + return "asdf" + +data Baz = Baz {a :: Int, b :: String} + diff --git a/test/testdata/Format.ormolu.unchanged.hs b/test/testdata/Format.ormolu.unchanged.hs new file mode 100644 index 0000000000..d4682acaa2 --- /dev/null +++ b/test/testdata/Format.ormolu.unchanged.hs @@ -0,0 +1,11 @@ +module Format where +foo :: Int -> Int +foo 3 = 2 +foo x = x +bar :: String -> IO String +bar s = do + x <- return "hello" + return "asdf" + +data Baz = Baz { a :: Int, b :: String } + diff --git a/test/testdata/StylishHaksell.format_document.hs b/test/testdata/StylishHaksell.format_document.hs new file mode 100644 index 0000000000..c695ddcb59 --- /dev/null +++ b/test/testdata/StylishHaksell.format_document.hs @@ -0,0 +1,8 @@ +import Data.Char +import qualified Data.List +import Data.String + +bar :: Maybe (Either String Integer) -> Integer +bar Nothing = 0 +bar (Just (Left _)) = 0 +bar (Just (Right x)) = x diff --git a/test/testdata/StylishHaksell.format_range.hs b/test/testdata/StylishHaksell.format_range.hs new file mode 100644 index 0000000000..18f1fe7a0b --- /dev/null +++ b/test/testdata/StylishHaksell.format_range.hs @@ -0,0 +1,8 @@ +import Data.Char +import qualified Data.List +import Data.String + +bar :: Maybe (Either String Integer) -> Integer +bar Nothing = 0 +bar (Just (Left _)) = 0 +bar (Just (Right x)) = x diff --git a/test/testdata/StylishHaksell.formatted_document.hs b/test/testdata/StylishHaksell.formatted_document.hs new file mode 100644 index 0000000000..c695ddcb59 --- /dev/null +++ b/test/testdata/StylishHaksell.formatted_document.hs @@ -0,0 +1,8 @@ +import Data.Char +import qualified Data.List +import Data.String + +bar :: Maybe (Either String Integer) -> Integer +bar Nothing = 0 +bar (Just (Left _)) = 0 +bar (Just (Right x)) = x diff --git a/test/testdata/StylishHaksell.formatted_range.hs b/test/testdata/StylishHaksell.formatted_range.hs new file mode 100644 index 0000000000..18f1fe7a0b --- /dev/null +++ b/test/testdata/StylishHaksell.formatted_range.hs @@ -0,0 +1,8 @@ +import Data.Char +import qualified Data.List +import Data.String + +bar :: Maybe (Either String Integer) -> Integer +bar Nothing = 0 +bar (Just (Left _)) = 0 +bar (Just (Right x)) = x