@@ -14,9 +14,8 @@ import Control.Exception (catch)
1414import Control.Monad
1515import Control.Monad.IO.Class (liftIO)
1616import Data.Aeson (FromJSON, Value)
17−import Data.Char (toLower)
1817import Data.Foldable
19−import Data.List
18+import Data.List.Extra
2019import Data.Rope.UTF16 (Rope)
2120import qualified Data.Rope.UTF16 as Rope
2221import Development.IDE.Core.PositionMapping (fromCurrent, toCurrent)
@@ -129,8 +128,8 @@ initializeResponseTests = withResource acquire release tests where
129128 where
130129 doTest = do
131130 ir <- getInitializeResponse
132− let Just (ExecuteCommandOptions {_commands = List [command]}) = getActual $ innerCaps ir
133− True @=? (T.isSuffixOf "typesignature.add" command)
131+ let Just ExecuteCommandOptions {_commands = List [command]} = getActual $ innerCaps ir
132+ True @=? T.isSuffixOf "typesignature.add" command
134133
135134
136135 innerCaps :: InitializeResponse -> InitializeResponseCapabilitiesInner
@@ -401,14 +400,14 @@ diagnosticTests = testGroup "diagnostics"
401400 Just pathB <- pure $ uriToFilePath uriB
402401 uriB <- pure $
403402 let (drive, suffix) = splitDrive pathB
404− in filePathToUri (joinDrive (map toLower drive ) suffix)
403+ in filePathToUri (joinDrive (lower drive) suffix)
405404 liftIO $ createDirectoryIfMissing True (takeDirectory pathB)
406405 liftIO $ writeFileUTF8 pathB $ T.unpack bContent
407406 uriA <- getDocUri "A/A.hs"
408407 Just pathA <- pure $ uriToFilePath uriA
409408 uriA <- pure $
410409 let (drive, suffix) = splitDrive pathA
411− in filePathToUri (joinDrive (map toLower drive ) suffix)
410+ in filePathToUri (joinDrive (lower drive) suffix)
412411 let itemA = TextDocumentItem uriA "haskell" 0 aContent
413412 let a = TextDocumentIdentifier uriA
414413 sendNotification TextDocumentDidOpen (DidOpenTextDocumentParams itemA)
@@ -459,7 +458,7 @@ codeLensesTests = testGroup "code lenses"
459458watchedFilesTests :: TestTree
460459watchedFilesTests = testGroup "watched files"
461460 [ testSession' "workspace files" $ \sessionDir -> do
462− liftIO $ writeFile (sessionDir </> "hie.yaml") $ "cradle: {direct: {arguments: [\"-isrc\"]}}"
461+ liftIO $ writeFile (sessionDir </> "hie.yaml") "cradle: {direct: {arguments: [\"-isrc\"]}}"
463462 _doc <- openDoc' "A.hs" "haskell" "{-#LANGUAGE NoImplicitPrelude #-}\nmodule A where\nimport WatchedFilesMissingModule"
464463 watchedFileRegs <- getWatchedFilesSubscriptionsUntil @PublishDiagnosticsNotification
465464
@@ -473,7 +472,7 @@ watchedFilesTests = testGroup "watched files"
473472 liftIO $ length watchedFileRegs @?= 6
474473
475474 , testSession' "non workspace file" $ \sessionDir -> do
476− liftIO $ writeFile (sessionDir </> "hie.yaml") $ "cradle: {direct: {arguments: [\"-i/tmp\"]}}"
475+ liftIO $ writeFile (sessionDir </> "hie.yaml") "cradle: {direct: {arguments: [\"-i/tmp\"]}}"
477476 _doc <- openDoc' "A.hs" "haskell" "{-# LANGUAGE NoImplicitPrelude#-}\nmodule A where\nimport WatchedFilesMissingModule"
478477 watchedFileRegs <- getWatchedFilesSubscriptionsUntil @PublishDiagnosticsNotification
479478
@@ -980,14 +979,15 @@ suggestImportTests = testGroup "suggest import actions"
980979 let defLine = length imps + 1
981980 range = Range (Position defLine 0) (Position defLine maxBound)
982981 actions <- getCodeActions doc range
983− case wanted of
984− False ->
985− liftIO $ [_title | CACodeAction CodeAction{_title} <- actions, _title == newImp ] @?= []
986− True -> do
987− action <- liftIO $ pickActionWithTitle newImp actions
988− executeCodeAction action
989− contentAfterAction <- documentContents doc
990− liftIO $ after @=? contentAfterAction
982+ if wanted
983+ then do
984+ action <- liftIO $ pickActionWithTitle newImp actions
985+ executeCodeAction action
986+ contentAfterAction <- documentContents doc
987+ liftIO $ after @=? contentAfterAction
988+ else
989+ liftIO $ [_title | CACodeAction CodeAction{_title} <- actions, _title == newImp ] @?= []
990+
991991
992992addExtensionTests :: TestTree
993993addExtensionTests = testGroup "add language extension actions"
@@ -1984,6 +1984,8 @@ cradleTests = testGroup "cradle"
19841984 ,testGroup "loading" [loadCradleOnlyonce]
19851985 ]
19861986
1987+{- HLINT ignore loadCradleOnlyonce "Redundant bracket" -}
1988+-- HLint seems to get confused by type applications and suggests to remove parentheses.
19871989loadCradleOnlyonce :: TestTree
19881990loadCradleOnlyonce = testGroup "load cradle only once"
19891991 [ testSession' "implicit" implicit
@@ -2351,11 +2353,13 @@ nthLine i r
23512353 | i >= Rope.rows r = error $ "Row number out of bounds: " <> show i <> "/" <> show (Rope.rows r)
23522354 | otherwise = Rope.takeWhile (/= '\n') $ fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (i - 1) r
23532355
2356+{- HLINT ignore getWatchedFilesSubscriptionsUntil "Redundant bracket" -}
2357+-- HLint seems to get confused by type applications and suggests to remove parentheses.
23542358getWatchedFilesSubscriptionsUntil :: forall end . (FromJSON end, Typeable end) => Session [Maybe Value]
23552359getWatchedFilesSubscriptionsUntil = do
23562360 msgs <- manyTill (Just <$> message @RegisterCapabilityRequest <|> Nothing <$ anyMessage) (message @end)
23572361 return
23582362 [ args
2359− | Just (RequestMessage{_params = RegistrationParams (List regs)}) <- msgs
2363+ | Just RequestMessage{_params = RegistrationParams (List regs)} <- msgs
23602364 , Registration _id WorkspaceDidChangeWatchedFiles args <- regs
23612365 ]