11{-# LANGUAGE OverloadedStrings #-}
2+ {-# OPTIONS_GHC -Wno-orphans #-}
3+ {-# LANGUAGE NamedFieldPuns #-}
4+ {-# LANGUAGE ViewPatterns #-}
25module Main
36 ( main
47 ) where
58
6- import qualified Ide.Plugin.Cabal.Parse as Lib
7- import qualified Data.Text as T
8- import qualified Language.LSP.Types.Lens as L
9+ import Control.Lens ((^.) )
10+ import Data.Function
11+ import qualified Data.Text as Text
12+ import Development.IDE.Types.Logger
913import Ide.Plugin.Cabal
14+ import qualified Ide.Plugin.Cabal.Parse as Lib
15+ import qualified Language.LSP.Types.Lens as J
1016import System.FilePath
1117import Test.Hls
12- import Test.Hls.Util (onlyWorkForGhcVersions )
13- import Test.Tasty.HUnit (assertFailure , testCase , (@?=) )
18+ import qualified Data.Text.IO as Text
19+
20+ cabalPlugin :: Recorder (WithPriority Log ) -> PluginDescriptor IdeState
21+ cabalPlugin recorder = descriptor recorder " cabal"
1422
1523main :: IO ()
16- main = defaultTestRunner tests
24+ main = do
25+ recorder <- initialiseRecorder True
26+ defaultTestRunner $
27+ testGroup " Cabal Plugin Tests"
28+ [ unitTests
29+ , pluginTests recorder
30+ ]
31+
32+ initialiseRecorder :: Bool -> IO Recorder (WithPriority Log ))
33+ initialiseRecorder True = pure mempty
34+ initialiseRecorder False = do
35+ docWithPriorityRecorder <- makeDefaultStderrRecorder Nothing Debug
1736
18- pragmasPlugin :: PluginDescriptor IdeState
19- pragmasPlugin = descriptor mempty " cabal"
37+ let docWithFilteredPriorityRecorder =
38+ docWithPriorityRecorder
39+ & cfilter (\ WithPriority { priority } -> priority >= Debug )
40+ pure $ docWithFilteredPriorityRecorder
41+ & cmapWithPrio pretty
2042
21- tests :: TestTree
22- tests =
23- testGroup " cabal"
43+ -- ------------------------------------------------------------------------
44+ -- Unit Tests
45+ -- ------------------------------------------------------------------------
46+
47+ unitTests :: TestTree
48+ unitTests =
49+ testGroup " Unit Tests"
2450 [ testCase " parsing works" $ do
2551 parseRes <- Lib. parseCabalFile " test/testdata/simple.cabal"
26- goldenShowStr <- readFile " test/testdata/simple.cabal.golden.txt"
27- show parseRes @?= goldenShowStr
52+ goldenShowStr <- Text. readFile " test/testdata/simple.cabal.golden.txt"
53+ Text. pack ( show parseRes) @?= Text. strip goldenShowStr
2854 ]
2955
56+ -- ------------------------------------------------------------------------
57+ -- Integration Tests
58+ -- ------------------------------------------------------------------------
59+
60+ pluginTests :: Recorder (WithPriority Log ) -> TestTree
61+ pluginTests recorder = testGroup " Plugin Tests"
62+ [ testGroup " Diagnostics"
63+ [ runCabalTestCaseSession " Publishes Diagnostics on Error" " " $ do
64+ doc <- openDoc " invalid.cabal" " cabal"
65+ diags <- waitForDiagnosticsFromSource doc " parsing"
66+ reduceDiag <- liftIO $ inspectDiagnostic diags [" Unknown SPDX license identifier: 'BSD3'"
67+ liftIO $ do
68+ length diags @?= 1
69+ reduceDiag ^. J. range @?= Range (Position 3 24 ) (Position 4 0 )
70+ reduceDiag ^. J. severity @?= Just DsError
71+ , runCabalTestCaseSession " Clears diagnostics" " " $ do
72+ doc <- openDoc " invalid.cabal" " cabal"
73+ diags <- waitForDiagnosticsFrom doc
74+ reduceDiag <- liftIO $ inspectDiagnostic diags [" Unknown SPDX license identifier: 'BSD3'"
75+ liftIO $ do
76+ length diags @?= 1
77+ reduceDiag ^. J. range @?= Range (Position 3 24 ) (Position 4 0 )
78+ reduceDiag ^. J. severity @?= Just DsError
79+ _ <- applyEdit doc $ TextEdit (Range (Position 3 20 ) (Position 4 0 )) " BSD-3-Clause\n "
80+ newDiags <- waitForDiagnosticsFrom doc
81+ liftIO $ newDiags @?= []
82+ ]
83+ , testGroup " Code Actions"
84+ [ runCabalTestCaseSession " BSD-3" " " $ do
85+ doc <- openDoc " licenseCodeAction.cabal" " cabal"
86+ diags <- waitForDiagnosticsFromSource doc " parsing"
87+ reduceDiag <- liftIO $ inspectDiagnostic diags [" Unknown SPDX license identifier: 'BSD3'"
88+ liftIO $ do
89+ length diags @?= 1
90+ reduceDiag ^. J. range @?= Range (Position 3 24 ) (Position 4 0 )
91+ reduceDiag ^. J. severity @?= Just DsError
92+ [InR codeAction] <- getCodeActions doc (Range (Position 3 24 ) (Position 4 0 ))
93+ executeCodeAction codeAction
94+ contents <- documentContents doc
95+ liftIO $ contents @?= Text. unlines
96+ [ " cabal-version: 3.0"
97+ , " name: licenseCodeAction"
98+ , " version: 0.1.0.0"
99+ , " license: BSD-3-Clause"
100+ , " "
101+ , " library"
102+ , " build-depends: base"
103+ , " default-language: Haskell2010"
104+ ]
105+ ]
106+ ]
107+
108+ -- ------------------------------------------------------------------------
109+ -- Runner utils
110+ -- ------------------------------------------------------------------------
111+
112+ runCabalTestCaseSession :: TestName -> Recorder (WithPriority Log ) -> FilePath -> Session () -> TestTree
113+ runCabalTestCaseSession title recorder subdir act = testCase title $ runCabalSession recorder subdir act
114+
115+ runCabalSession :: Recorder (WithPriority Log ) -> FilePath -> Session a -> IO a
116+ runCabalSession recorder subdir =
117+ failIfSessionTimeout . runSessionWithServer (cabalPlugin recorder) (testDataDir </> subdir)
118+
119+ testDataDir :: FilePath
120+ testDataDir = " test" </> " testdata"
121+
122+ -- ------------------------------------------------------------------------
123+ -- Test utils for lib:Cabal
124+ -- ------------------------------------------------------------------------
125+
30126-- Orphans
31127instance Eq Lib. PWarningwhere
32128 Lib. PWarning== Lib. PWarning=
@@ -35,3 +131,14 @@ instance Eq Lib.PWarning where
35131instance Eq Lib. PErrorwhere
36132 Lib. PError== Lib. PError=
37133 pos1 == pos2 && str1 == str2
134+
135+
136+ -- ------------------------------------------------------------------------
137+ -- Test utils
138+ -- ------------------------------------------------------------------------
139+
140+ pointRange :: Int -> Int -> Range
141+ pointRange
142+ (subtract 1 -> fromIntegral -> line)
143+ (subtract 1 -> fromIntegral -> col) =
144+ Range (Position line col) (Position line $ col + 1 )
0 commit comments