Skip to content

Commit 2521a7f

Browse files
alanzalanz
committed
WIP on formatting spec, via hspec
We only have an Ormolu formatter at present, want to make sure the circle stuff actually works too. Need to plumb the config values through to the actual formatter.
1 parent 22ec256 commit 2521a7f

File tree

12 files changed

+414
-39
lines changed

12 files changed

+414
-39
lines changed

‎haskell-language-server.cabal

Lines changed: 33 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -173,19 +173,22 @@ executable haskell-language-server-wrapper
173173
default-language: Haskell2010
174174

175175

176-
test-suite hls-tests
176+
test-suite func-test
177177
type: exitcode-stdio-1.0
178178
default-language: Haskell2010
179-
build-tool-depends:
180-
haskell-language-server:haskell-language-server,
181-
ghcide:ghcide-test-preprocessor
179+
build-tool-depends: hspec-discover:hspec-discover
180+
, haskell-language-server:haskell-language-server
181+
, cabal-helper:cabal-helper-main
182+
, ghcide:ghcide-test-preprocessor
183+
182184
build-depends:
183185
base >=4.7 && <5
184186
, haskell-language-server
185187
, aeson
186188
, base
187189
, bytestring
188190
, containers
191+
, data-default
189192
, directory
190193
, extra
191194
, filepath
@@ -204,20 +207,39 @@ test-suite hls-tests
204207
, haskell-lsp-types
205208
, hls-test-utils
206209
, lens
207-
, lsp-test >= 0.8
210+
, lsp-test >= 0.10.0.0
208211
, parser-combinators
209212
, QuickCheck
210213
, quickcheck-instances
211214
, rope-utf16-splay
212-
, tasty
213-
, tasty-expected-failure
214-
, tasty-hunit
215-
, tasty-quickcheck
216215
, text
216+
, hspec
217+
, hspec-core
217218
other-modules:
218-
Paths_haskell_language_server
219+
-- CompletionSpec
220+
-- , CommandSpec
221+
-- , DeferredSpec
222+
-- , DefinitionSpec
223+
-- , DiagnosticsSpec
224+
FormatSpec
225+
-- , FunctionalBadProjectSpec
226+
-- , FunctionalCodeActionsSpec
227+
-- , FunctionalLiquidSpec
228+
, FunctionalSpec
229+
-- , HaReSpec
230+
-- , HieBiosSpec
231+
-- , HighlightSpec
232+
-- , HoverSpec
233+
-- , ProgressSpec
234+
-- , ReferencesSpec
235+
-- , RenameSpec
236+
-- , SymbolsSpec
237+
-- , TypeDefinitionSpec
238+
, Utils
239+
, Paths_haskell_language_server
240+
219241
hs-source-dirs:
220-
test/exe
242+
test/functional
221243
ghc-options:
222244
-Wall
223245
-Wredundant-constraints

‎stack.yaml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -30,9 +30,9 @@ extra-deps:
3030
- temporary-1.2.1.1
3131
- topograph-1
3232

33-
flags:
34-
haskell-language-server:
35-
pedantic: true
33+
# flags:
34+
# haskell-language-server:
35+
# pedantic: true
3636

3737
# allow-newer: true
3838

‎test/functional/FormatSpec.hs

Lines changed: 207 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,207 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
module FormatSpec where
3+
4+
import Control.Monad.IO.Class
5+
import Data.Aeson
6+
import qualified Data.Text as T
7+
import Language.Haskell.LSP.Test
8+
import Language.Haskell.LSP.Types
9+
import Test.Hspec
10+
import TestUtils
11+
12+
spec :: Spec
13+
spec = do
14+
describe "format document" $ do
15+
it "works" $ runSession hieCommand fullCaps "test/testdata" $ do
16+
doc <- openDoc "Format.hs" "haskell"
17+
formatDoc doc (FormattingOptions 2 True)
18+
documentContents doc >>= liftIO . (`shouldBe` formattedDocTabSize2)
19+
it "works with custom tab size" $ runSession hieCommand fullCaps "test/testdata" $ do
20+
doc <- openDoc "Format.hs" "haskell"
21+
formatDoc doc (FormattingOptions 5 True)
22+
documentContents doc >>= liftIO . (`shouldBe` formattedDocTabSize5)
23+
24+
describe "format range" $ do
25+
it "works" $ runSession hieCommand fullCaps "test/testdata" $ do
26+
doc <- openDoc "Format.hs" "haskell"
27+
formatRange doc (FormattingOptions 2 True) (Range (Position 1 0) (Position 3 10))
28+
documentContents doc >>= liftIO . (`shouldBe` formattedRangeTabSize2)
29+
it "works with custom tab size" $ runSession hieCommand fullCaps "test/testdata" $ do
30+
doc <- openDoc "Format.hs" "haskell"
31+
formatRange doc (FormattingOptions 5 True) (Range (Position 4 0) (Position 7 19))
32+
documentContents doc >>= liftIO . (`shouldBe` formattedRangeTabSize5)
33+
34+
describe "formatting provider" $ do
35+
let formatLspConfig provider =
36+
object [ "languageServerHaskell" .= object ["formattingProvider" .= (provider :: Value)] ]
37+
formatConfig provider = defaultConfig { lspConfig = Just (formatLspConfig provider) }
38+
39+
it "respects none" $ runSessionWithConfig (formatConfig "none") hieCommand fullCaps "test/testdata" $ do
40+
doc <- openDoc "Format.hs" "haskell"
41+
orig <- documentContents doc
42+
43+
formatDoc doc (FormattingOptions 2 True)
44+
documentContents doc >>= liftIO . (`shouldBe` orig)
45+
46+
formatRange doc (FormattingOptions 2 True) (Range (Position 1 0) (Position 3 10))
47+
documentContents doc >>= liftIO . (`shouldBe` orig)
48+
49+
it "can change on the fly" $ runSession hieCommand fullCaps "test/testdata" $ do
50+
doc <- openDoc "Format.hs" "haskell"
51+
52+
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))
53+
formatDoc doc (FormattingOptions 2 True)
54+
documentContents doc >>= liftIO . (`shouldBe` formattedDocTabSize2)
55+
56+
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "floskell"))
57+
formatDoc doc (FormattingOptions 2 True)
58+
documentContents doc >>= liftIO . (`shouldBe` formattedFloskell)
59+
60+
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "brittany"))
61+
formatDoc doc (FormattingOptions 2 True)
62+
documentContents doc >>= liftIO . (`shouldBe` formattedBrittanyPostFloskell)
63+
64+
describe "brittany" $ do
65+
it "formats a document with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do
66+
doc <- openDoc "BrittanyLF.hs" "haskell"
67+
let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing
68+
ResponseMessage _ _ (Just edits) _ <- request TextDocumentFormatting opts
69+
liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 3 0))
70+
"foo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return 42\n"]
71+
72+
it "formats a document with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do
73+
doc <- openDoc "BrittanyCRLF.hs" "haskell"
74+
let opts = DocumentFormattingParams doc (FormattingOptions 4 True) Nothing
75+
ResponseMessage _ _ (Just edits) _ <- request TextDocumentFormatting opts
76+
liftIO $ edits `shouldBe` [TextEdit (Range (Position 0 0) (Position 3 0))
77+
"foo :: Int -> String -> IO ()\nfoo x y = do\n print x\n return 42\n"]
78+
79+
it "formats a range with LF endings" $ runSession hieCommand fullCaps "test/testdata" $ do
80+
doc <- openDoc "BrittanyLF.hs" "haskell"
81+
let range = Range (Position 1 0) (Position 2 22)
82+
opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing
83+
ResponseMessage _ _ (Just edits) _ <- request TextDocumentRangeFormatting opts
84+
liftIO $ edits `shouldBe` [TextEdit (Range (Position 1 0) (Position 3 0))
85+
"foo x y = do\n print x\n return 42\n"]
86+
87+
it "formats a range with CRLF endings" $ runSession hieCommand fullCaps "test/testdata" $ do
88+
doc <- openDoc "BrittanyCRLF.hs" "haskell"
89+
let range = Range (Position 1 0) (Position 2 22)
90+
opts = DocumentRangeFormattingParams doc range (FormattingOptions 4 True) Nothing
91+
ResponseMessage _ _ (Just edits) _ <- request TextDocumentRangeFormatting opts
92+
liftIO $ edits `shouldBe` [TextEdit (Range (Position 1 0) (Position 3 0))
93+
"foo x y = do\n print x\n return 42\n"]
94+
95+
describe "ormolu" $ do
96+
let formatLspConfig provider =
97+
object [ "languageServerHaskell" .= object ["formattingProvider" .= (provider :: Value)] ]
98+
99+
it "formats correctly" $ runSession hieCommand fullCaps "test/testdata" $ do
100+
sendNotification WorkspaceDidChangeConfiguration (DidChangeConfigurationParams (formatLspConfig "ormolu"))
101+
doc <- openDoc "Format.hs" "haskell"
102+
formatDoc doc (FormattingOptions 2 True)
103+
docContent <- documentContents doc
104+
let formatted = liftIO $ docContent `shouldBe` formattedOrmolu
105+
case ghcVersion of
106+
GHC88 -> formatted
107+
GHC86 -> formatted
108+
_ -> liftIO $ docContent `shouldBe` unchangedOrmolu
109+
110+
111+
formattedDocTabSize2 :: T.Text
112+
formattedDocTabSize2 =
113+
"module Format where\n\
114+
\foo :: Int -> Int\n\
115+
\foo 3 = 2\n\
116+
\foo x = x\n\
117+
\bar :: String -> IO String\n\
118+
\bar s = do\n\
119+
\ x <- return \"hello\"\n\
120+
\ return \"asdf\"\n\n"
121+
122+
formattedDocTabSize5 :: T.Text
123+
formattedDocTabSize5 =
124+
"module Format where\n\
125+
\foo :: Int -> Int\n\
126+
\foo 3 = 2\n\
127+
\foo x = x\n\
128+
\bar :: String -> IO String\n\
129+
\bar s = do\n\
130+
\ x <- return \"hello\"\n\
131+
\ return \"asdf\"\n\n"
132+
133+
formattedRangeTabSize2 :: T.Text
134+
formattedRangeTabSize2 =
135+
"module Format where\n\
136+
\foo :: Int -> Int\n\
137+
\foo 3 = 2\n\
138+
\foo x = x\n\
139+
\bar :: String -> IO String\n\
140+
\bar s = do\n\
141+
\ x <- return \"hello\"\n\
142+
\ return \"asdf\"\n\
143+
\ \n"
144+
145+
formattedRangeTabSize5 :: T.Text
146+
formattedRangeTabSize5 =
147+
"module Format where\n\
148+
\foo :: Int -> Int\n\
149+
\foo 3 = 2\n\
150+
\foo x = x\n\
151+
\bar :: String -> IO String\n\
152+
\bar s = do\n\
153+
\ x <- return \"hello\"\n\
154+
\ return \"asdf\"\n\
155+
\ \n"
156+
157+
formattedFloskell :: T.Text
158+
formattedFloskell =
159+
"module Format where\n\
160+
\\n\
161+
\foo :: Int -> Int\n\
162+
\foo 3 = 2\n\
163+
\foo x = x\n\
164+
\\n\
165+
\bar :: String -> IO String\n\
166+
\bar s = do\n\
167+
\ x <- return \"hello\"\n\
168+
\ return \"asdf\"\n\n\
169+
\"
170+
171+
formattedBrittanyPostFloskell :: T.Text
172+
formattedBrittanyPostFloskell =
173+
"module Format where\n\
174+
\\n\
175+
\foo :: Int -> Int\n\
176+
\foo 3 = 2\n\
177+
\foo x = x\n\
178+
\\n\
179+
\bar :: String -> IO String\n\
180+
\bar s = do\n\
181+
\ x <- return \"hello\"\n\
182+
\ return \"asdf\"\n\n"
183+
184+
formattedOrmolu :: T.Text
185+
formattedOrmolu =
186+
"module Format where\n\
187+
\\n\
188+
\foo :: Int -> Int\n\
189+
\foo 3 = 2\n\
190+
\foo x = x\n\
191+
\\n\
192+
\bar :: String -> IO String\n\
193+
\bar s = do\n\
194+
\ x <- return \"hello\"\n\
195+
\ return \"asdf\"\n"
196+
197+
unchangedOrmolu :: T.Text
198+
unchangedOrmolu =
199+
"module Format where\n\
200+
\foo :: Int -> Int\n\
201+
\foo 3 = 2\n\
202+
\foo x = x\n\
203+
\bar :: String -> IO String\n\
204+
\bar s = do\n\
205+
\ x <- return \"hello\"\n\
206+
\ return \"asdf\"\n\
207+
\ \n"

‎test/functional/FunctionalSpec.hs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=FunctionalSpec #-}

‎test/functional/Main.hs

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
module Main where
2+
3+
import Control.Monad.IO.Class
4+
import Language.Haskell.LSP.Test
5+
import qualified FunctionalSpec
6+
import Test.Hspec.Runner (hspecWith)
7+
import TestUtils
8+
9+
main :: IO ()
10+
main = do
11+
setupBuildToolFiles
12+
-- run a test session to warm up the cache to prevent timeouts in other tests
13+
putStrLn "Warming up HIE cache..."
14+
putStrLn $ "hieCommand: " ++ hieCommand
15+
runSessionWithConfig (defaultConfig { messageTimeout = 120 }) hieCommand fullCaps "test/testdata" $
16+
liftIO $ putStrLn "HIE cache is warmed up"
17+
18+
config <- getHspecFormattedConfig "functional"
19+
withFileLogging logFilePath $ hspecWith config FunctionalSpec.spec

‎test/functional/Utils.hs

Lines changed: 21 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,21 @@
1+
module Utils where
2+
3+
import Data.Default
4+
import qualified Language.Haskell.LSP.Test as Test
5+
import Language.Haskell.LSP.Test hiding (message)
6+
import qualified Language.Haskell.LSP.Types.Capabilities as C
7+
8+
-- ---------------------------------------------------------------------
9+
10+
noLogConfig :: SessionConfig
11+
noLogConfig = Test.defaultConfig { logMessages = False }
12+
13+
logConfig :: SessionConfig
14+
logConfig = Test.defaultConfig { logMessages = True }
15+
16+
codeActionSupportCaps :: C.ClientCapabilities
17+
codeActionSupportCaps = def { C._textDocument = Just textDocumentCaps }
18+
where
19+
textDocumentCaps = def { C._codeAction = Just codeActionCaps }
20+
codeActionCaps = C.CodeActionClientCapabilities (Just True) (Just literalSupport)
21+
literalSupport = C.CodeActionLiteralSupport def

‎test/testdata/BrittanyCRLF.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
foo :: Int -> String-> IO ()
2+
foo x y = do print x
3+
return 42

‎test/testdata/BrittanyLF.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
foo :: Int -> String-> IO ()
2+
foo x y = do print x
3+
return 42

‎test/testdata/Format.hs

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
module Format where
2+
foo :: Int -> Int
3+
foo 3 = 2
4+
foo x = x
5+
bar :: String -> IO String
6+
bar s = do
7+
x <- return "hello"
8+
return "asdf"
9+

‎test/testdata/stack.yaml

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
# WARNING: THIS FILE IS AUTOGENERATED IN test/utils/TestUtils. IT WILL BE OVERWRITTEN ON EVERY TEST RUN
2+
resolver: lts-14.22
3+
packages:
4+
- '.'
5+
extra-deps: []
6+
flags: {}
7+
extra-package-dbs: []

0 commit comments

Comments
 (0)