forked from haskell/haskell-language-server
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathMain.hs
189 lines (180 loc) · 8.81 KB
/
Main.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE OverloadedStrings #-}
module Main (
main,
) where
import Completer (completerTests)
import Context (contextTests)
import Control.Lens ((^.))
import Control.Monad (guard)
import qualified Data.ByteString as BS
import Data.Either (isRight)
import qualified Data.Text as T
import qualified Data.Text as Text
import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion)
import qualified Ide.Plugin.Cabal.Parse as Lib
import qualified Language.LSP.Protocol.Lens as L
import Outline (outlineTests)
import System.FilePath
import Test.Hls
import Utils
main :: IO ()
main = do
defaultTestRunner $
testGroup
"Cabal Plugin Tests"
[ unitTests
, pluginTests
, completerTests
, contextTests
, outlineTests
]
-- ------------------------------------------------------------------------
-- Unit Tests
-- ------------------------------------------------------------------------
unitTests :: TestTree
unitTests =
testGroup
"Unit Tests"
[ cabalParserUnitTests
, codeActionUnitTests
]
cabalParserUnitTests :: TestTree
cabalParserUnitTests =
testGroup
"Parsing Cabal"
[ testCase "Simple Parsing works" $ do
(warnings, pm) <- Lib.parseCabalFileContents =<< BS.readFile (testDataDir </> "simple.cabal")
liftIO $ do
null warnings @? "Found unexpected warnings"
isRight pm @? "Failed to parse GenericPackageDescription"
]
codeActionUnitTests :: TestTree
codeActionUnitTests =
testGroup
"Code Action Tests"
[ testCase "Unknown format" $ do
-- the message has the wrong format
licenseErrorSuggestion "Unknown license identifier: 'BSD3' Do you mean BSD-3-Clause?" @?= []
, testCase "BSD-3-Clause" $ do
take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'BSD3' Do you mean BSD-3-Clause?")
@?= [("BSD3", "BSD-3-Clause"), ("BSD3", "BSD-3-Clause-LBNL")]
, testCase "MiT" $ do
-- contains no suggestion
take 2 (licenseErrorSuggestion "Unknown SPDX license identifier: 'MiT'")
@?= [("MiT", "MIT"), ("MiT", "MIT-0")]
]
-- ------------------------ ------------------------------------------------
-- Integration Tests
-- ------------------------------------------------------------------------
pluginTests :: TestTree
pluginTests =
testGroup
"Plugin Tests"
[ testGroup
"Diagnostics"
[ runCabalTestCaseSession "Publishes Diagnostics on Error" "" $ do
doc <- openDoc "invalid.cabal" "cabal"
diags <- waitForDiagnosticsFromSource doc "cabal"
unknownLicenseDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"]
liftIO $ do
length diags @?= 1
unknownLicenseDiag ^. L.range @?= Range (Position 3 24) (Position 4 0)
unknownLicenseDiag ^. L.severity @?= Just DiagnosticSeverity_Error
, runCabalTestCaseSession "Clears diagnostics" "" $ do
doc <- openDoc "invalid.cabal" "cabal"
diags <- waitForDiagnosticsFrom doc
unknownLicenseDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"]
liftIO $ do
length diags @?= 1
unknownLicenseDiag ^. L.range @?= Range (Position 3 24) (Position 4 0)
unknownLicenseDiag ^. L.severity @?= Just DiagnosticSeverity_Error
_ <- applyEdit doc $ TextEdit (Range (Position 3 20) (Position 4 0)) "BSD-3-Clause\n"
newDiags <- waitForDiagnosticsFrom doc
liftIO $ newDiags @?= []
, runCabalTestCaseSession "No Diagnostics in .hs files from valid .cabal file" "simple-cabal" $ do
hsDoc <- openDoc "A.hs" "haskell"
expectNoMoreDiagnostics 1 hsDoc "typechecking"
cabalDoc <- openDoc "simple-cabal.cabal" "cabal"
expectNoMoreDiagnostics 1 cabalDoc "parsing"
, runCabalTestCaseSession "Diagnostics in .hs files from invalid .cabal file" "simple-cabal" $ do
hsDoc <- openDoc "A.hs" "haskell"
expectNoMoreDiagnostics 1 hsDoc "typechecking"
cabalDoc <- openDoc "simple-cabal.cabal" "cabal"
expectNoMoreDiagnostics 1 cabalDoc "parsing"
let theRange = Range (Position 3 20) (Position 3 23)
-- Invalid license
changeDoc
cabalDoc
[ TextDocumentContentChangeEvent $
InL TextDocumentContentChangePartial
{ _range = theRange
, _rangeLength = Nothing
, _text = "MIT3"
}
]
cabalDiags <- waitForDiagnosticsFrom cabalDoc
unknownLicenseDiag <- liftIO $ inspectDiagnostic cabalDiags ["Unknown SPDX license identifier: 'MIT3'"]
expectNoMoreDiagnostics 1 hsDoc "typechecking"
liftIO $ do
length cabalDiags @?= 1
unknownLicenseDiag ^. L.range @?= Range (Position 3 24) (Position 4 0)
unknownLicenseDiag ^. L.severity @?= Just DiagnosticSeverity_Error
]
, testGroup
"Code Actions"
[ runCabalTestCaseSession "BSD-3" "" $ do
doc <- openDoc "licenseCodeAction.cabal" "cabal"
diags <- waitForDiagnosticsFromSource doc "cabal"
reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'BSD3'"]
liftIO $ do
length diags @?= 1
reduceDiag ^. L.range @?= Range (Position 3 24) (Position 4 0)
reduceDiag ^. L.severity @?= Just DiagnosticSeverity_Error
[codeAction] <- getLicenseAction "BSD-3-Clause" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0))
executeCodeAction codeAction
contents <- documentContents doc
liftIO $
contents
@?= Text.unlines
[ "cabal-version: 3.0"
, "name: licenseCodeAction"
, "version: 0.1.0.0"
, "license: BSD-3-Clause"
, ""
, "library"
, " build-depends: base"
, " default-language: Haskell2010"
]
, runCabalTestCaseSession "Apache-2.0" "" $ do
doc <- openDoc "licenseCodeAction2.cabal" "cabal"
diags <- waitForDiagnosticsFromSource doc "cabal"
-- test if it supports typos in license name, here 'apahe'
reduceDiag <- liftIO $ inspectDiagnostic diags ["Unknown SPDX license identifier: 'APAHE'"]
liftIO $ do
length diags @?= 1
reduceDiag ^. L.range @?= Range (Position 3 25) (Position 4 0)
reduceDiag ^. L.severity @?= Just DiagnosticSeverity_Error
[codeAction] <- getLicenseAction "Apache-2.0" <$> getCodeActions doc (Range (Position 3 24) (Position 4 0))
executeCodeAction codeAction
contents <- documentContents doc
liftIO $
contents
@?= Text.unlines
[ "cabal-version: 3.0"
, "name: licenseCodeAction2"
, "version: 0.1.0.0"
, "license: Apache-2.0"
, ""
, "library"
, " build-depends: base"
, " default-language: Haskell2010"
]
]
]
where
getLicenseAction :: T.Text -> [Command |? CodeAction] -> [CodeAction]
getLicenseAction license codeActions = do
InR action@CodeAction{_title} <- codeActions
guard (_title == "Replace with " <> license)
pure action