1
- {-# LANGUAGE CPP #-}
2
1
{-# LANGUAGE OverloadedStrings #-}
3
2
4
3
module FunctionalCodeActionsSpec where
@@ -136,11 +135,11 @@ spec = describe "code actions" $ do
136
135
[_,diag: _] <- count 2 waitForDiagnostics
137
136
138
137
139
- # if __GLASGOW_HASKELL__ >= 806
140
- liftIO $ diag ^. L. message `shouldSatisfy` T. isPrefixOf " Could not load module \8216Data.Text\8217 "
141
- #else
142
- liftIO $ diag ^. L. message `shouldSatisfy` T. isPrefixOf " Could not find module ‘Data.Text’ "
143
- #endif
138
+ if ghcVersion == GHC86
139
+ then
140
+ liftIO $ diag ^. L. message `shouldSatisfy` T. isPrefixOf " Could not load module \8216Data.Text\8217 "
141
+ else
142
+ liftIO $ diag ^. L. message `shouldSatisfy` T. isPrefixOf " Could not find module ‘Data.Text’ "
144
143
145
144
liftIO $ putStrLn $ " add package suggestions:waiting for code actions" -- AZ
146
145
acts <- getAllCodeActions doc
@@ -165,11 +164,11 @@ spec = describe "code actions" $ do
165
164
-- ignore the first empty hlint diagnostic publish
166
165
[_,diag: _] <- count 2 waitForDiagnostics
167
166
168
- # if __GLASGOW_HASKELL__ >= 806
169
- liftIO $ diag ^. L. message `shouldSatisfy` T. isPrefixOf " Could not load module ‘Codec.Compression.GZip’ "
170
- #else
171
- liftIO $ diag ^. L. message `shouldSatisfy` T. isPrefixOf " Could not find module ‘Codec.Compression.GZip’ "
172
- #endif
167
+ if ghcVersion == GHC86
168
+ then
169
+ liftIO $ diag ^. L. message `shouldSatisfy` T. isPrefixOf " Could not load module ‘Codec.Compression.GZip’ "
170
+ else
171
+ liftIO $ diag ^. L. message `shouldSatisfy` T. isPrefixOf " Could not find module ‘Codec.Compression.GZip’ "
173
172
174
173
mActions <- getAllCodeActions doc
175
174
let allActions = map fromAction mActions
@@ -246,19 +245,28 @@ spec = describe "code actions" $ do
246
245
cas <- map (\ (CACodeAction x)-> x) <$> getAllCodeActions doc
247
246
248
247
suggestion <-
249
- if ghc84 then do
250
- liftIO $ map (^. L. title) cas `shouldMatchList`
251
- [ " Substitute hole (Int) with maxBound (forall a. Bounded a => a)"
252
- , " Substitute hole (Int) with minBound (forall a. Bounded a => a)"
253
- , " Substitute hole (Int) with undefined (forall (a :: TYPE r). GHC.Stack.Types.HasCallStack => a)"
254
- ]
255
- return " maxBound"
256
- else do
257
- liftIO $ map (^. L. title) cas `shouldMatchList`
258
- [ " Substitute hole (Int) with x ([Int])"
259
- , " Substitute hole (Int) with foo ([Int] -> Int)"
260
- ]
261
- return " x"
248
+ case ghcVersion of
249
+ GHC86 -> do
250
+ liftIO $ map (^. L. title) cas `shouldMatchList`
251
+ [ " Substitute hole (Int) with x ([Int])"
252
+ , " Substitute hole (Int) with foo ([Int] -> Int Valid hole fits include)"
253
+ , " Substitute hole (Int) with maxBound (forall a. Bounded a => a with maxBound @Int)"
254
+ , " Substitute hole (Int) with minBound (forall a. Bounded a => a with minBound @Int)"
255
+ ]
256
+ return " x"
257
+ GHC84 -> do
258
+ liftIO $ map (^. L. title) cas `shouldMatchList`
259
+ [ " Substitute hole (Int) with maxBound (forall a. Bounded a => a)"
260
+ , " Substitute hole (Int) with minBound (forall a. Bounded a => a)"
261
+ , " Substitute hole (Int) with undefined (forall (a :: TYPE r). GHC.Stack.Types.HasCallStack => a)"
262
+ ]
263
+ return " maxBound"
264
+ GHCPre84 -> do
265
+ liftIO $ map (^. L. title) cas `shouldMatchList`
266
+ [ " Substitute hole (Int) with x ([Int])"
267
+ , " Substitute hole (Int) with foo ([Int] -> Int)"
268
+ ]
269
+ return " x"
262
270
263
271
executeCodeAction $ head cas
264
272
@@ -276,21 +284,29 @@ spec = describe "code actions" $ do
276
284
cas <- map fromAction <$> getAllCodeActions doc
277
285
278
286
suggestion <-
279
- if ghc84 then do
280
- liftIO $ map (^. L. title) cas `shouldMatchList`
281
- [ " Substitute hole (A) with undefined (forall (a :: TYPE r). GHC.Stack.Types.HasCallStack => a)"
282
- , " Substitute hole (A) with stuff (A -> A)"
283
- , " Substitute hole (A) with x ([A])"
284
- , " Substitute hole (A) with foo2 ([A] -> A)"
285
- ]
286
- return " undefined"
287
- else do
288
- liftIO $ map (^. L. title) cas `shouldMatchList`
289
- [ " Substitute hole (A) with stuff (A -> A)"
290
- , " Substitute hole (A) with x ([A])"
291
- , " Substitute hole (A) with foo2 ([A] -> A)"
292
- ]
293
- return " stuff"
287
+ case ghcVersion of
288
+ GHC86 -> do
289
+ liftIO $ map (^. L. title) cas `shouldMatchList`
290
+ [ " Substitute hole (A) with stuff (A -> A)"
291
+ , " Substitute hole (A) with x ([A])"
292
+ , " Substitute hole (A) with foo2 ([A] -> A)"
293
+ ]
294
+ return " stuff"
295
+ GHC84 -> do
296
+ liftIO $ map (^. L. title) cas `shouldMatchList`
297
+ [ " Substitute hole (A) with undefined (forall (a :: TYPE r). GHC.Stack.Types.HasCallStack => a)"
298
+ , " Substitute hole (A) with stuff (A -> A)"
299
+ , " Substitute hole (A) with x ([A])"
300
+ , " Substitute hole (A) with foo2 ([A] -> A)"
301
+ ]
302
+ return " undefined"
303
+ GHCPre84 -> do
304
+ liftIO $ map (^. L. title) cas `shouldMatchList`
305
+ [ " Substitute hole (A) with stuff (A -> A)"
306
+ , " Substitute hole (A) with x ([A])"
307
+ , " Substitute hole (A) with foo2 ([A] -> A)"
308
+ ]
309
+ return " stuff"
294
310
295
311
executeCodeAction $ head cas
296
312
0 commit comments