1
1
{-# LANGUAGE OverloadedStrings #-}
2
2
{-# LANGUAGE RecordWildCards #-}
3
+ {-# LANGUAGE TypeApplications #-}
3
4
{-# LANGUAGE ViewPatterns #-}
4
5
5
6
module Main
6
7
( main
7
8
) where
8
9
9
- import Control.Lens (_Just , preview , view )
10
- import Control.Monad (when )
10
+ import Control.Lens (_Just , preview , toListOf , view )
11
11
import Data.Aeson (fromJSON )
12
12
import Data.Aeson.Types (Result (Success ))
13
+ import Data.List (isInfixOf )
13
14
import Data.List.Extra (nubOrdOn )
14
15
import qualified Ide.Plugin.Eval as Eval
15
- import Ide.Plugin.Eval.Types (EvalParams (.. ))
16
- import Language.LSP.Types.Lens ( command , range , title )
17
- import System.Directory ( doesFileExist )
18
- import System.FilePath ((<.>) , (< />) )
16
+ import Ide.Plugin.Eval.Types (EvalParams (.. ), Section ( .. ),
17
+ testOutput )
18
+ import Language.LSP.Types.Lens ( arguments , command , range , title )
19
+ import System.FilePath ((</>) )
19
20
import Test.Hls
20
21
21
22
main :: IO ()
@@ -107,11 +108,56 @@ tests =
107
108
]
108
109
, goldenWithEval " Works with NoImplicitPrelude" " TNoImplicitPrelude" " hs"
109
110
, goldenWithEval " Variable 'it' works" " TIt" " hs"
111
+
112
+ , testGroup " :info command"
113
+ [ testCase " :info reports type, constructors and instances" $ do
114
+ [output] <- map (unlines . codeLensTestOutput) <$> evalLenses " TInfo.hs"
115
+ " data Foo = Foo1 | Foo2" `isInfixOf` output @? " Output does not include Foo data declaration"
116
+ " Eq Foo" `isInfixOf` output @? " Output does not include instance Eq Foo"
117
+ " Ord Foo" `isInfixOf` output @? " Output does not include instance Ord Foo"
118
+ not (" Baz Foo" `isInfixOf` output) @? " Output includes instance Baz Foo"
119
+ , testCase " :info reports type, constructors and instances for multiple types" $ do
120
+ [output] <- map (unlines . codeLensTestOutput) <$> evalLenses " TInfoMany.hs"
121
+ " data Foo = Foo1 | Foo2" `isInfixOf` output @? " Output does not include Foo data declaration"
122
+ " Eq Foo" `isInfixOf` output @? " Output does not include instance Eq Foo"
123
+ " Ord Foo" `isInfixOf` output @? " Output does not include instance Ord Foo"
124
+ not (" Baz Foo" `isInfixOf` output) @? " Output includes instance Baz Foo"
125
+ " data Bar = Bar1 | Bar2 | Bar3" `isInfixOf` output @? " Output does not include Bar data declaration"
126
+ " Eq Bar" `isInfixOf` output @? " Output does not include instance Eq Bar"
127
+ " Ord Bar" `isInfixOf` output @? " Output does not include instance Ord Bar"
128
+ not (" Baz Bar" `isInfixOf` output) @? " Output includes instance Baz Bar"
129
+ , testCase " :info! reports type, constructors and unfiltered instances" $ do
130
+ [output] <- map (unlines . codeLensTestOutput) <$> evalLenses " TInfoBang.hs"
131
+ " data Foo = Foo1 | Foo2" `isInfixOf` output @? " Output does not include Foo data declaration"
132
+ " Eq Foo" `isInfixOf` output @? " Output does not include instance Eq Foo"
133
+ " Ord Foo" `isInfixOf` output @? " Output does not include instance Ord Foo"
134
+ " Baz Foo" `isInfixOf` output @? " Output does not include instance Baz Foo"
135
+ , testCase " :info! reports type, constructors and unfiltered instances for multiple types" $ do
136
+ [output] <- map (unlines . codeLensTestOutput) <$> evalLenses " TInfoBangMany.hs"
137
+ " data Foo = Foo1 | Foo2" `isInfixOf` output @? " Output does not include Foo data declaration"
138
+ " Eq Foo" `isInfixOf` output @? " Output does not include instance Eq Foo"
139
+ " Ord Foo" `isInfixOf` output @? " Output does not include instance Ord Foo"
140
+ " Baz Foo" `isInfixOf` output @? " Output does not include instance Baz Foo"
141
+ " data Bar = Bar1 | Bar2 | Bar3" `isInfixOf` output @? " Output does not include Bar data declaration"
142
+ " Eq Bar" `isInfixOf` output @? " Output does not include instance Eq Bar"
143
+ " Ord Bar" `isInfixOf` output @? " Output does not include instance Ord Bar"
144
+ " Baz Bar" `isInfixOf` output @? " Output does not include instance Baz Bar"
145
+ , testCase " :i behaves exactly the same as :info" $ do
146
+ [output] <- map (unlines . codeLensTestOutput) <$> evalLenses " TI_Info.hs"
147
+ " data Foo = Foo1 | Foo2" `isInfixOf` output @? " Output does not include Foo data declaration"
148
+ " Eq Foo" `isInfixOf` output @? " Output does not include instance Eq Foo"
149
+ " Ord Foo" `isInfixOf` output @? " Output does not include instance Ord Foo"
150
+ not (" Baz Foo" `isInfixOf` output) @? " Output includes instance Baz Foo"
151
+ ]
110
152
]
111
153
112
154
goldenWithEval :: TestName -> FilePath -> FilePath -> TestTree
113
- goldenWithEval title path ext = goldenWithHaskellDoc evalPlugin title testDataDir path " expected" ext $ \ doc -> do
114
- -- Execute lenses backwards, to avoid affecting their position in the source file
155
+ goldenWithEval title path ext =
156
+ goldenWithHaskellDoc evalPlugin title testDataDir path " expected" ext executeLensesBackwards
157
+
158
+ -- | Execute lenses backwards, to avoid affecting their position in the source file
159
+ executeLensesBackwards :: TextDocumentIdentifier -> Session ()
160
+ executeLensesBackwards doc = do
115
161
codeLenses <- reverse <$> getCodeLenses doc
116
162
-- liftIO $ print codeLenses
117
163
@@ -133,5 +179,19 @@ executeCmd cmd = do
133
179
-- liftIO $ print _resp
134
180
pure ()
135
181
182
+ evalLenses :: FilePath -> IO [CodeLens ]
183
+ evalLenses path = runSessionWithServer evalPlugin testDataDir $ do
184
+ doc <- openDoc path " haskell"
185
+ executeLensesBackwards doc
186
+ getCodeLenses doc
187
+
188
+ codeLensTestOutput :: CodeLens -> [String ]
189
+ codeLensTestOutput codeLens = do
190
+ CodeLens { _command = Just command } <- [codeLens]
191
+ Command { _arguments = Just (List args) } <- [command]
192
+ Success EvalParams { sections = sections } <- fromJSON @ EvalParams <$> args
193
+ Section { sectionTests = sectionTests } <- sections
194
+ testOutput =<< sectionTests
195
+
136
196
testDataDir :: FilePath
137
197
testDataDir = " test" </> " testdata"
0 commit comments