Skip to content

Commit ba5216d

Browse files
rm41339rm41339
committed
add parsing and diagnostics tests
1 parent 594bba1 commit ba5216d

File tree

11 files changed

+160
-21
lines changed

11 files changed

+160
-21
lines changed

‎cabal.project

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,6 @@ package cabal-install
1717
tests: False
1818
benchmarks: False
1919

20-
2120
index-state: 2025-05-12T13:26:29Z
2221

2322
tests: True

‎haskell-language-server.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -380,6 +380,7 @@ test-suite hls-cabal-project-plugin-tests
380380
hs-source-dirs: plugins/hls-cabal-project-plugin/test
381381
main-is: Main.hs
382382
other-modules:
383+
Utils
383384
build-depends:
384385
, bytestring
385386
, Cabal-syntax >= 3.7

‎plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -99,14 +99,14 @@ descriptor recorder plId =
9999
\ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri, _version}) -> liftIO $ do
100100
whenUriFile _uri $ \file -> do
101101
log' Debug $ LogDocOpened _uri
102-
parseAndPrint (fromNormalizedFilePath file)
102+
-- parseAndPrint (fromNormalizedFilePath file)
103103
restartCabalShakeSession (shakeExtras ide) vfs file "(opened)" $
104104
addFileOfInterest recorder ide file Modified{firstOpen = True}
105105
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidChange $
106106
\ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do
107107
whenUriFile _uri $ \file-> do
108108
log' Debug $ LogDocModified _uri
109-
parseAndPrint (fromNormalizedFilePath file)
109+
-- parseAndPrint (fromNormalizedFilePath file)
110110
restartCabalShakeSession (shakeExtras ide) vfs file "(changed)" $
111111
addFileOfInterest recorder ide file Modified{firstOpen = False}
112112
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidSave $
@@ -132,6 +132,7 @@ descriptor recorder plId =
132132
whenUriFile :: Uri -> (NormalizedFilePath -> IO ()) -> IO ()
133133
whenUriFile uri act = whenJust (uriToFilePath uri) $ act . toNormalizedFilePath'
134134

135+
-- for development/debugging
135136
parseAndPrint :: FilePath -> IO ()
136137
parseAndPrint file = do
137138
(warnings, res) <- Parse.parseCabalProjectFileContents file

‎plugins/hls-cabal-project-plugin/src/Ide/Plugin/CabalProject/Parse.hs

Lines changed: 4 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -5,24 +5,21 @@ module Ide.Plugin.CabalProject.Parse
55
readCabalProjectFields
66
) where
77

8-
-- base -----------------------------------------------------------------------
98
import Control.Monad (unless)
109
import qualified Data.ByteString as BS
1110
import Data.List.NonEmpty (NonEmpty (..))
11+
import qualified Data.List.NonEmpty as NE
12+
import qualified Data.Text as T
13+
import Development.IDE
1214
import Distribution.Client.HttpUtils (configureTransport)
1315
import Distribution.Client.ProjectConfig.Parsec (ProjectConfigSkeleton,
1416
parseProject,
1517
readPreprocessFields)
1618
import Distribution.Client.ProjectConfig.Types (ProjectConfigToParse (..))
1719
import Distribution.Fields (PError (..),
1820
PWarning (..))
19-
import qualified Distribution.Fields.ParseResult as PR
20-
-- import Distribution.Fields.ParseResult (ParseResult,
21-
-- runParseResult)
22-
import qualified Data.List.NonEmpty as NE
23-
import qualified Data.Text as T
24-
import Development.IDE
2521
import qualified Distribution.Fields.Parser as Syntax
22+
import qualified Distribution.Fields.ParseResult as PR
2623
import qualified Distribution.Parsec.Position as Syntax
2724
import Distribution.Types.Version (Version)
2825
import Distribution.Verbosity (normal)
@@ -60,12 +57,3 @@ readCabalProjectFields file contents =
6057

6158
(_warnings, Right fields) ->
6259
Right fields
63-
64-
-- parseCabalProjectContents :: FilePath -> IO (Either String (Project Void String String))
65-
-- parseCabalProjectContents file = do
66-
-- contents <- BS.readFile file
67-
-- case parseProject file contents of
68-
-- Left parseErr ->
69-
-- pure $ Left ("Parse error in " ++ file ++ ": " ++ show parseErr)
70-
-- Right project ->
71-
-- pure $ Right project

‎plugins/hls-cabal-project-plugin/test/Main.hs

Lines changed: 96 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,97 @@
1-
module Main where
1+
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE DisambiguateRecordFields #-}
3+
{-# LANGUAGE OverloadedStrings #-}
24

3-
main = undefined
5+
module Main (
6+
main,
7+
) where
8+
9+
import Control.Lens ((^.))
10+
import Control.Lens.Fold ((^?))
11+
import Control.Monad (guard)
12+
import qualified Data.ByteString as BS
13+
import Data.Either (isRight)
14+
import Data.List.Extra (nubOrdOn)
15+
import qualified Data.Maybe as Maybe
16+
import qualified Data.Text as T
17+
import qualified Ide.Plugin.CabalProject.Parse as Lib
18+
import qualified Language.LSP.Protocol.Lens as L
19+
import System.FilePath
20+
import Test.Hls
21+
import Utils
22+
23+
main :: IO ()
24+
main = do
25+
defaultTestRunner $
26+
testGroup
27+
"Cabal Plugin Tests"
28+
[ unitTests
29+
, pluginTests
30+
]
31+
32+
-- ------------------------------------------------------------------------
33+
-- Unit Tests
34+
-- ------------------------------------------------------------------------
35+
36+
unitTests :: TestTree
37+
unitTests =
38+
testGroup
39+
"Unit Tests"
40+
[ cabalProjectParserUnitTests
41+
]
42+
43+
cabalProjectParserUnitTests :: TestTree
44+
cabalProjectParserUnitTests =
45+
testGroup
46+
"Parsing Cabal Project"
47+
[ testCase "Simple Parsing works" $ do
48+
(warnings, pm) <- Lib.parseCabalProjectFileContents (testDataDir </> "cabal.project")
49+
liftIO $ do
50+
null warnings @? "Found unexpected warnings"
51+
isRight pm @? "Failed to parse base cabal.project file"
52+
]
53+
54+
-- ------------------------ ------------------------------------------------
55+
-- Integration Tests
56+
-- ------------------------------------------------------------------------
57+
58+
pluginTests :: TestTree
59+
pluginTests =
60+
testGroup
61+
"Plugin Tests"
62+
[ testGroup
63+
"Diagnostics"
64+
[ runCabalProjectTestCaseSession "Publishes Diagnostics on Error" "invalid-cabal-project" $ do
65+
_ <- openDoc "cabal.project" "cabal-project"
66+
diags <- cabalProjectCaptureKick
67+
unexpectedErrorDiag <- liftIO $ inspectDiagnostic diags ["unexpected 'f'"]
68+
liftIO $ do
69+
length diags @?= 1
70+
unexpectedErrorDiag ^. L.range @?= Range (Position 2 6) (Position 3 0)
71+
unexpectedErrorDiag ^. L.severity @?= Just DiagnosticSeverity_Error
72+
, runCabalProjectTestCaseSession "Publishes Diagnostics on misspelled packages as Warning" "warning-cabal-project" $ do
73+
_ <- openDoc "cabal.project" "cabal-project"
74+
diags <- cabalProjectCaptureKick
75+
stanzaWarningDiag <- liftIO $ inspectDiagnosticAny diags ["'\"package\"' is a stanza, not a field. Remove the trailing ':' to parse a stanza."]
76+
liftIO $ do
77+
length diags @?= 1
78+
stanzaWarningDiag ^. L.range @?= Range (Position 0 0) (Position 1 0)
79+
stanzaWarningDiag ^. L.severity @?= Just DiagnosticSeverity_Warning
80+
, runCabalProjectTestCaseSession "Clears diagnostics" "invalid-cabal-project" $ do
81+
doc <- openDoc "cabal.project" "cabal-project"
82+
diags <- cabalProjectCaptureKick
83+
unknownLicenseDiag <- liftIO $ inspectDiagnostic diags ["unexpected 'f'"]
84+
liftIO $ do
85+
length diags @?= 1
86+
unknownLicenseDiag ^. L.range @?= Range (Position 2 6) (Position 3 0)
87+
unknownLicenseDiag ^. L.severity @?= Just DiagnosticSeverity_Error
88+
_ <- applyEdit doc $ TextEdit (Range (Position 2 6) (Position 3 0)) " -foo"
89+
newDiags <- cabalProjectCaptureKick
90+
liftIO $ newDiags @?= []
91+
, runCabalProjectTestCaseSession "No Diagnostics in .hs files from valid cabal.project file" "simple-cabal-project" $ do
92+
hsDoc <- openDoc "A.hs" "haskell"
93+
expectNoMoreDiagnostics 1 hsDoc "typechecking"
94+
cabalDoc <- openDoc "cabal.project" "cabal-project"
95+
expectNoMoreDiagnostics 1 cabalDoc "parsing"
96+
]
97+
]

‎plugins/hls-cabal-project-plugin/test/Utils.hs

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,48 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE DisambiguateRecordFields #-}
3+
{-# LANGUAGE OverloadedStrings #-}
4+
5+
module Utils where
6+
7+
import Control.Monad (guard)
8+
import Data.List (sort)
9+
import Data.Proxy (Proxy (Proxy))
10+
import qualified Data.Text as T
11+
import Ide.Plugin.CabalProject (descriptor)
12+
import qualified Ide.Plugin.CabalProject
13+
import Ide.Plugin.CabalProject.Types
14+
import System.FilePath
15+
import Test.Hls
16+
17+
18+
cabalProjectPlugin :: PluginTestDescriptor Ide.Plugin.CabalProject.Log
19+
cabalProjectPlugin = mkPluginTestDescriptor descriptor "cabal-project"
20+
21+
runCabalProjectTestCaseSession :: TestName -> FilePath -> Session () -> TestTree
22+
runCabalProjectTestCaseSession title subdir = testCase title . runCabalProjectSession subdir
23+
24+
runCabalProjectSession :: FilePath -> Session a -> IO a
25+
runCabalProjectSession subdir =
26+
failIfSessionTimeout . runSessionWithServer def cabalProjectPlugin (testDataDir </> subdir)
27+
28+
runCabalProjectGoldenSession :: TestName -> FilePath -> FilePath -> (TextDocumentIdentifier -> Session ()) -> TestTree
29+
runCabalProjectGoldenSession title subdir fp act = goldenWithCabalDoc def cabalProjectPlugin title testDataDir (subdir </> fp) "golden" "cabal-project" act
30+
31+
testDataDir :: FilePath
32+
testDataDir = "plugins" </> "hls-cabal-project-plugin" </> "test" </> "testdata"
33+
34+
-- | these functions are used to detect cabal kicks
35+
-- and look at diagnostics for cabal files
36+
-- kicks are run everytime there is a shake session run/restart
37+
cabalProjectKickDone :: Session ()
38+
cabalProjectKickDone = kick (Proxy @"kick/done/cabal-project") >>= guard . not . null
39+
40+
cabalProjectKickStart :: Session ()
41+
cabalProjectKickStart = kick (Proxy @"kick/start/cabal-project") >>= guard . not . null
42+
43+
cabalProjectCaptureKick :: Session [Diagnostic]
44+
cabalProjectCaptureKick = captureKickDiagnostics cabalProjectKickStart cabalProjectKickDone
45+
46+
-- | list comparison where the order in the list is irrelevant
47+
(@?==) :: (HasCallStack, Ord a, Show a) => [a] -> [a] -> Assertion
48+
(@?==) l1 l2 = sort l1 @?= sort l2

‎plugins/hls-cabal-project-plugin/test/testdata/cabal.project

Whitespace-only changes.

‎plugins/hls-cabal-project-plugin/test/testdata/invalid-cabal-project/cabal.project

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
packages: .
2+
3+
flags:foo

‎plugins/hls-cabal-project-plugin/test/testdata/simple-cabal-project/A.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
module A where
2+
3+
a = undefined

‎plugins/hls-cabal-project-plugin/test/testdata/simple-cabal-project/cabal.project

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
packages: .

0 commit comments

Comments
 (0)