Introduce golden testing

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

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"

test/testdata/BrittanyCRLF.formatted_document.hs

@@ -0,0 +1,4 @@
+foo :: Int -> String -> IO ()
+foo x y = do
+  print x
+  return 42

test/testdata/BrittanyCRLF.formatted_range.hs

@@ -0,0 +1,4 @@
+foo :: Int -> String -> IO ()
+foo x y = do
+  print x
+  return 42

test/testdata/BrittanyLF.formatted_document.hs

@@ -0,0 +1,4 @@
+foo :: Int -> String -> IO ()
+foo x y = do
+  print x
+  return 42

test/testdata/BrittanyLF.formatted_range.hs

@@ -0,0 +1,4 @@
+foo :: Int -> String -> IO ()
+foo x y = do
+  print x
+  return 42

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}
+

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}
+

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 }
+

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 }
+

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}
+

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 }
+

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

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