Skip to content

Introduce golden testing #152

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Jun 10, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 2 additions & 0 deletions haskell-language-server.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -246,6 +246,7 @@ test-suite func-test
, ghcide:ghcide-test-preprocessor
build-depends: base >=4.7 && <5
, aeson
, bytestring
, data-default
, directory
, filepath
Expand All @@ -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
Expand Down
165 changes: 40 additions & 125 deletions test/functional/Format.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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)
Expand All @@ -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
Expand All @@ -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\
Expand All @@ -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\
Expand Down Expand Up @@ -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"
4 changes: 4 additions & 0 deletions test/testdata/BrittanyCRLF.formatted_document.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
foo :: Int -> String -> IO ()
foo x y = do
print x
return 42
4 changes: 4 additions & 0 deletions test/testdata/BrittanyCRLF.formatted_range.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
foo :: Int -> String -> IO ()
foo x y = do
print x
return 42
4 changes: 4 additions & 0 deletions test/testdata/BrittanyLF.formatted_document.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
foo :: Int -> String -> IO ()
foo x y = do
print x
return 42
4 changes: 4 additions & 0 deletions test/testdata/BrittanyLF.formatted_range.hs
Original file line number Diff line number Diff line change
@@ -0,0 +1,4 @@
foo :: Int -> String -> IO ()
foo x y = do
print x
return 42
12 changes: 12 additions & 0 deletions test/testdata/Format.formatted_document.hs
Original file line number Diff line number Diff line change
@@ -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}

12 changes: 12 additions & 0 deletions test/testdata/Format.formatted_document_with_tabsize.hs
Original file line number Diff line number Diff line change
@@ -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}

12 changes: 12 additions & 0 deletions test/testdata/Format.formatted_range.hs
Original file line number Diff line number Diff line change
@@ -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 }

12 changes: 12 additions & 0 deletions test/testdata/Format.formatted_range_with_tabsize.hs
Original file line number Diff line number Diff line change
@@ -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 }

12 changes: 12 additions & 0 deletions test/testdata/Format.ormolu.formatted.hs
Original file line number Diff line number Diff line change
@@ -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}

11 changes: 11 additions & 0 deletions test/testdata/Format.ormolu.unchanged.hs
Original file line number Diff line number Diff line change
@@ -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 }

8 changes: 8 additions & 0 deletions test/testdata/StylishHaksell.format_document.hs
Original file line number Diff line number Diff line change
@@ -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
8 changes: 8 additions & 0 deletions test/testdata/StylishHaksell.format_range.hs
Original file line number Diff line number Diff line change
@@ -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
Loading