From bcaaf8b948823f07dc2b508fa3e21acd4eea0ecb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Fri, 8 Mar 2024 19:17:49 +0100 Subject: [PATCH 1/4] Reduce usage of partial functions --- .hlint.yaml | 23 +---------- .../test/exe/FindDefinitionAndHoverTests.hs | 2 - .../src/Ide/Plugin/Eval/Code.hs | 2 +- .../src/Ide/Plugin/Eval/Parse/Comments.hs | 2 +- .../src/Ide/Plugin/Floskell.hs | 6 ++- .../src/Development/IDE/Plugin/CodeAction.hs | 41 +++++++++---------- .../IDE/Plugin/CodeAction/ExactPrint.hs | 14 +++---- 7 files changed, 34 insertions(+), 56 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index a6c6f29b0a..c602460b95 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -64,8 +64,6 @@ - Ide.Types - Test.Hls - Test.Hls.Command - - Wingman.Debug - - Wingman.Types - AutoTupleSpec - name: unsafeInterleaveIO within: @@ -76,7 +74,6 @@ - Ide.Plugin.Eval.Code - Development.IDE.Core.Compile - Development.IDE.Types.Shake - - Wingman.Judgements.SYB - Ide.Plugin.Properties # Things that are a bit dangerous in the GHC API @@ -105,7 +102,6 @@ - Ide.Plugin.CallHierarchy.Internal - Ide.Plugin.Eval.Code - Ide.Plugin.Eval.Util - - Ide.Plugin.Floskell - Ide.Plugin.ModuleName - Ide.Plugin.Class.ExactPrint - TExpectedActual @@ -113,9 +109,6 @@ - TRigidType2 - RightToLeftFixities - Typeclass - - Wingman.Judgements - - Wingman.Machinery - - Wingman.Tactics - CompletionTests #Previously part of GHCIDE Main tests - DiagnosticTests #Previously part of GHCIDE Main tests - FindDefinitionAndHoverTests #Previously part of GHCIDE Main tests @@ -149,7 +142,6 @@ - Main - Development.IDE.Spans.Common - Ide.PluginUtils - - Wingman.Metaprogramming.Parser - Development.Benchmark.Rules - ErrorGivenPartialSignature - IfaceTests #Previously part of GHCIDE Main tests @@ -171,8 +163,6 @@ - Development.IDE.Plugin.Completions.Logic - Development.IDE.Spans.Documentation - TErrorGivenPartialSignature - - Wingman.CaseSplit - - Wingman.Simplify - InitializeResponseTests #Previously part of GHCIDE Main tests - PositionMappingTests #Previously part of GHCIDE Main tests @@ -185,31 +175,23 @@ within: [] - name: Data.Foldable.foldr1 - within: - - Wingman.Tactics + within: [] - name: Data.Maybe.fromJust within: - Experiments - Main - - MultipleImports - Progress - - Utils - Development.IDE.Core.Compile - Development.IDE.Core.Rules - Development.IDE.Core.Shake - - Development.IDE.Plugin.Completions - - Development.IDE.Plugin.CodeAction.ExactPrint - - Development.IDE.Plugin.CodeAction - Development.IDE.Test - Development.IDE.Graph.Internal.Profile - Development.IDE.Graph.Internal.Rules - - Ide.Plugin.Class - CodeLensTests #Previously part of GHCIDE Main tests - name: "Data.Map.!" - within: - - Wingman.LanguageServer + within: [] - name: "Data.IntMap.!" within: [] @@ -250,7 +232,6 @@ - Development.IDE.Graph.Internal.Database - Development.IDE.GHC.Util - Development.IDE.Plugin.CodeAction.Util - - Wingman.Debug # We really do not want novel usages of restricted functions, and mere # Warning is not enough to prevent those consistently; you need a build failure. diff --git a/ghcide/test/exe/FindDefinitionAndHoverTests.hs b/ghcide/test/exe/FindDefinitionAndHoverTests.hs index bfa3be7f28..04ede6579b 100644 --- a/ghcide/test/exe/FindDefinitionAndHoverTests.hs +++ b/ghcide/test/exe/FindDefinitionAndHoverTests.hs @@ -1,6 +1,4 @@ -{-# LANGUAGE MultiWayIf #-} - module FindDefinitionAndHoverTests (tests) where import Control.Monad diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs index 846d8ce160..cc22d31da8 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Code.hs @@ -85,7 +85,7 @@ asStmts (Property t _ _) = myExecStmt :: String -> ExecOptions -> Ghc (Either String (Maybe String)) myExecStmt stmt opts = do (temp, purge) <- liftIO newTempFile - evalPrint <- head <$> runDecls ("evalPrint x = P.writeFile "<> show temp <> " (P.show x)") + evalPrint <- head <$> runDecls ("evalPrint x = P.writeFile " <> show temp <> " (P.show x)") modifySession $ \hsc -> hsc {hsc_IC = setInteractivePrintName (hsc_IC hsc) evalPrint} result <- execStmt stmt opts >>= \case ExecComplete (Left err) _ -> pure $ Left $ show err diff --git a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs index d1ef5e06c8..8fdf64bc96 100644 --- a/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs +++ b/plugins/hls-eval-plugin/src/Ide/Plugin/Eval/Parse/Comments.hs @@ -122,7 +122,7 @@ commentsToSections isLHS Comments {..} = in case parseMaybe lineGroupP $ NE.toList lcs of Nothing -> mempty Just (mls, rs) -> - ( maybe mempty (uncurry Map.singleton) ((theRan,) <$> mls) + ( maybe mempty (Map.singleton theRan) mls , -- orders setup sections in ascending order if null rs then mempty diff --git a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs b/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs index 6a3481404c..87f9f49e5b 100644 --- a/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs +++ b/plugins/hls-floskell-plugin/src/Ide/Plugin/Floskell.hs @@ -8,6 +8,7 @@ module Ide.Plugin.Floskell import Control.Monad.Except (throwError) import Control.Monad.IO.Class +import Data.List (find) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Development.IDE hiding (pluginHandlers) @@ -53,7 +54,8 @@ findConfigOrDefault file = do case mbConf of Just confFile -> readAppConfig confFile Nothing -> - let gibiansky = head (filter (\s -> styleName s == "gibiansky") styles) - in pure $ defaultAppConfig { appStyle = gibiansky } + pure $ case find (\s -> styleName s == "gibiansky") styles of + Just gibiansky -> defaultAppConfig { appStyle = gibiansky } + Nothing -> defaultAppConfig -- --------------------------------------------------------------------- diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs index b2ed67722f..ea9badc6ac 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction.hs @@ -75,7 +75,6 @@ import GHC (AddEpAnn (Ad EpAnn (..), EpaLocation (..), LEpaComment) -import GHC.Exts (fromList) import qualified GHC.LanguageExtensions as Lang import Ide.Logger hiding (group) @@ -189,18 +188,18 @@ extendImportHandler :: CommandFunction IdeState ExtendImport extendImportHandler ideState _ edit@ExtendImport {..} = ExceptT $ do res <- liftIO $ runMaybeT $ extendImportHandler' ideState edit whenJust res $ \(nfp, wedit@WorkspaceEdit {_changes}) -> do - let (_, head -> TextEdit {_range}) = fromJust $ _changes >>= listToMaybe . M.toList - srcSpan = rangeToSrcSpan nfp _range - LSP.sendNotification SMethod_WindowShowMessage $ - ShowMessageParams MessageType_Info $ - "Import " - <> maybe ("‘" <> newThing) (\x -> "‘" <> x <> " (" <> newThing <> ")") thingParent - <> "’ from " - <> importName - <> " (at " - <> printOutputable srcSpan - <> ")" - void $ LSP.sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ()) + whenJust (listToMaybe =<< listToMaybe . M.elems =<< _changes) $ \TextEdit {_range} -> do + let srcSpan = rangeToSrcSpan nfp _range + LSP.sendNotification SMethod_WindowShowMessage $ + ShowMessageParams MessageType_Info $ + "Import " + <> maybe ("‘" <> newThing) (\x -> "‘" <> x <> " (" <> newThing <> ")") thingParent + <> "’ from " + <> importName + <> " (at " + <> printOutputable srcSpan + <> ")" + void $ LSP.sendRequest SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wedit) (\_ -> pure ()) return $ Right $ InR Null extendImportHandler' :: IdeState -> ExtendImport -> MaybeT IO (NormalizedFilePath, WorkspaceEdit) @@ -223,8 +222,7 @@ extendImportHandler' ideState ExtendImport {..} case existingImport of Just imp -> do fmap (nfp,) $ liftEither $ - rewriteToWEdit df doc - $ + rewriteToWEdit df doc $ extendImport (T.unpack <$> thingParent) (T.unpack newThing) (makeDeltaAst imp) Nothing -> do @@ -235,7 +233,7 @@ extendImportHandler' ideState ExtendImport {..} Nothing -> newThing Just p -> p <> "(" <> newThing <> ")" t <- liftMaybe $ snd <$> newImportToEdit n ps (fromMaybe "" contents) - return (nfp, WorkspaceEdit {_changes=Just (GHC.Exts.fromList [(doc, [t])]), _documentChanges=Nothing, _changeAnnotations=Nothing}) + return (nfp, WorkspaceEdit {_changes=Just (M.singleton doc [t]), _documentChanges=Nothing, _changeAnnotations=Nothing}) | otherwise = mzero @@ -609,7 +607,7 @@ suggestDeleteUnusedBinding let maybeIdx = findIndex (\(L _ id) -> isSameName id name) lnames in case maybeIdx of Nothing -> Nothing - Just _ | length lnames == 1 -> Just (getLoc $ reLoc $ head lnames, True) + Just _ | [lname] <- lnames -> Just (getLoc $ reLoc lname, True) Just idx -> let targetLname = getLoc $ reLoc $ lnames !! idx startLoc = srcSpanStart targetLname @@ -1052,7 +1050,7 @@ suggestImportDisambiguation df (Just txt) ps fileContents diag@Diagnostic {..} parensed = "(" `T.isPrefixOf` T.strip (textInRange _range txt) -- > removeAllDuplicates [1, 1, 2, 3, 2] = [3] - removeAllDuplicates = map head . filter ((==1) <$> length) . group . sort + removeAllDuplicates = map NE.head . filter ((==1) . length) . NE.group . sort hasDuplicate xs = length xs /= length (S.fromList xs) suggestions symbol mods local | hasDuplicate mods = case mapM toModuleTarget (removeAllDuplicates mods) of @@ -1290,7 +1288,7 @@ suggestImplicitParameter (L _ HsModule {hsmodDecls}) Diagnostic {_message, _rang | otherwise = [] findTypeSignatureName :: T.Text -> Maybe T.Text -findTypeSignatureName t = matchRegexUnifySpaces t "([^ ]+) :: " <&> head +findTypeSignatureName t = matchRegexUnifySpaces t "([^ ]+) :: " >>= listToMaybe -- | Suggests a constraint for a type signature with any number of existing constraints. suggestFunctionConstraint :: DynFlags -> ParsedSource -> Diagnostic -> T.Text -> [(T.Text, Rewrite)] @@ -1378,7 +1376,8 @@ removeRedundantConstraints df (makeDeltaAst -> L _ HsModule {hsmodDecls}) Diagno & take 2 & mapMaybe ((`matchRegexUnifySpaces` "Redundant constraints?: (.+)") . T.strip) & listToMaybe - <&> (head >>> parseConstraints) + >>= listToMaybe + <&> parseConstraints formatConstraints :: [T.Text] -> T.Text formatConstraints [] = "" @@ -1658,7 +1657,7 @@ findPositionAfterModuleName ps hsmodName' = do #endif EpAnn _ annsModule _ -> do -- Find the first 'where' - whereLocation <- fmap NE.head . NE.nonEmpty . mapMaybe filterWhere . am_main $ annsModule + whereLocation <- listToMaybe . mapMaybe filterWhere $ am_main annsModule epaLocationToLine whereLocation EpAnnNotUsed -> Nothing filterWhere (AddEpAnn AnnWhere loc) = Just loc diff --git a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs index 63a8d8e14c..a9d5c48cc1 100644 --- a/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs +++ b/plugins/hls-refactor-plugin/src/Development/IDE/Plugin/CodeAction/ExactPrint.hs @@ -37,7 +37,7 @@ import Development.IDE.Plugin.CodeAction.Util import Control.Lens (_head, _last, over) import Data.Bifunctor (first) import Data.Default (Default (..)) -import Data.Maybe (fromJust, fromMaybe, +import Data.Maybe (fromMaybe, mapMaybe) import GHC (AddEpAnn (..), AnnContext (..), @@ -82,15 +82,13 @@ rewriteToEdit :: HasCallStack => Either String [TextEdit] rewriteToEdit dflags (Rewrite dst f) = do - (ast, _ , _) <- runTransformT - $ do + (ast, _ , _) <- runTransformT $ do ast <- f dflags pure $ traceAst "REWRITE_result" $ resetEntryDP ast - let editMap = - [ TextEdit (fromJust $ srcSpanToRange dst) $ - T.pack $ exactPrint ast - ] - pure editMap + let edits = case srcSpanToRange dst of + Just range -> [ TextEdit range $ T.pack $ exactPrint ast ] + Nothing -> [] + pure edits -- | Convert a 'Rewrite' into a 'WorkspaceEdit' rewriteToWEdit :: DynFlags From 91419bb76a39229be5825cb1c889251c6e199f9b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sat, 9 Mar 2024 09:58:30 +0100 Subject: [PATCH 2/4] no head in module name plugin --- .hlint.yaml | 1 - .../src/Ide/Plugin/ModuleName.hs | 10 +++++++--- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index c602460b95..ae0a9a5116 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -102,7 +102,6 @@ - Ide.Plugin.CallHierarchy.Internal - Ide.Plugin.Eval.Code - Ide.Plugin.Eval.Util - - Ide.Plugin.ModuleName - Ide.Plugin.Class.ExactPrint - TExpectedActual - TRigidType diff --git a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs index a62fb674ad..1192870b00 100644 --- a/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs +++ b/plugins/hls-module-name-plugin/src/Ide/Plugin/ModuleName.hs @@ -25,7 +25,7 @@ import Control.Monad.Trans.Maybe import Data.Aeson (toJSON) import Data.Char (isLower, isUpper) import Data.List (intercalate, minimumBy, - stripPrefix, uncons) + stripPrefix) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import Data.Maybe (mapMaybe) @@ -138,7 +138,7 @@ action recorder state uri = do -- directories are nested inside each other. pathModuleNames :: Recorder (WithPriority Log) -> IdeState -> NormalizedFilePath -> FilePath -> ExceptT PluginError IO [T.Text] pathModuleNames recorder state normFilePath filePath - | isLower . head $ takeFileName filePath = return ["Main"] + | firstLetter isLower $ takeFileName filePath = return ["Main"] | otherwise = do (session, _) <- runActionE "ModuleName.ghcSession" state $ useWithStaleE GhcSession normFilePath srcPaths <- liftIO $ evalGhcEnv (hscEnvWithImportPaths session) $ importPaths <$> getSessionDynFlags @@ -156,12 +156,16 @@ pathModuleNames recorder state normFilePath filePath let suffixes = mapMaybe (`stripPrefix` mdlPath) paths pure (map moduleNameFrom suffixes) where + firstLetter :: (Char -> Bool) -> FilePath -> Bool + firstLetter _ [] = False + firstLetter pred (c:_) = pred c + moduleNameFrom = T.pack . intercalate "." -- Do not suggest names whose components start from a lower-case char, -- they are guaranteed to be malformed. - . filter (maybe False (isUpper . fst) . uncons) + . filter (firstLetter isUpper) . splitDirectories . dropExtension From 2220dd7ddfead4380b1b7b2b306eba9a0b0e0672 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sat, 9 Mar 2024 11:04:42 +0100 Subject: [PATCH 3/4] More tail and init, fix module name --- .hlint.yaml | 6 +----- ghcide/test/exe/IfaceTests.hs | 3 ++- ghcide/test/exe/THTests.hs | 7 ++++--- ghcide/test/exe/WatchedFileTests.hs | 4 ++-- hls-test-utils/src/Test/Hls.hs | 2 +- .../test/testdata/TErrorGivenPartialSignature.hs | 2 +- 6 files changed, 11 insertions(+), 13 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index ae0a9a5116..c46c3abbe8 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -122,7 +122,6 @@ - Development.IDE.Plugin.CodeAction.ExactPrint - Development.IDE.Session - UnificationSpec - - WatchedFileTests #Previously part of GHCIDE Main tests - name: [Prelude.last, Data.List.last] within: @@ -142,10 +141,7 @@ - Development.IDE.Spans.Common - Ide.PluginUtils - Development.Benchmark.Rules - - ErrorGivenPartialSignature - - IfaceTests #Previously part of GHCIDE Main tests - - THTests #Previously part of GHCIDE Main tests - - WatchedFileTests #Previously part of GHCIDE Main tests + - TErrorGivenPartialSignature - name: Data.List.foldl1' within: [] diff --git a/ghcide/test/exe/IfaceTests.hs b/ghcide/test/exe/IfaceTests.hs index f4967a2656..b20558f269 100644 --- a/ghcide/test/exe/IfaceTests.hs +++ b/ghcide/test/exe/IfaceTests.hs @@ -4,6 +4,7 @@ module IfaceTests (tests) where import Control.Monad.IO.Class (liftIO) +import Data.List.Extra (dropEnd1) import Data.Row import qualified Data.Text as T import Development.IDE.GHC.Util @@ -49,7 +50,7 @@ ifaceTHTest = testCase "iface-th-test" $ runWithExtraFiles "TH" $ \dir -> do cdoc <- createDoc cPath "haskell" cSource -- Change [TH]a from () to Bool - liftIO $ writeFileUTF8 aPath (unlines $ init (lines $ T.unpack aSource) ++ ["th_a = [d| a = False|]"]) + liftIO $ writeFileUTF8 aPath (T.unpack $ T.unlines $ dropEnd1 (T.lines aSource) ++ ["th_a = [d| a = False|]"]) -- Check that the change propagates to C changeDoc cdoc [TextDocumentContentChangeEvent . InR . (.==) #text $ cSource] diff --git a/ghcide/test/exe/THTests.hs b/ghcide/test/exe/THTests.hs index 975b674549..85b1571da6 100644 --- a/ghcide/test/exe/THTests.hs +++ b/ghcide/test/exe/THTests.hs @@ -4,6 +4,7 @@ module THTests (tests) where import Control.Monad.IO.Class (liftIO) +import Data.List.Extra (dropEnd, dropEnd1) import Data.Row import qualified Data.Text as T import Development.IDE.GHC.Util @@ -141,7 +142,7 @@ thReloadingTest unboxed = testCase name $ runWithExtraFiles dir $ \dir -> do expectDiagnostics [("THB.hs", [(DiagnosticSeverity_Warning, (4,1), "Top-level binding")])] -- Change th from () to Bool - let aSource' = T.unlines $ init (T.lines aSource) ++ ["th_a = [d| a = False|]"] + let aSource' = T.unlines $ dropEnd1 (T.lines aSource) ++ ["th_a = [d| a = False|]"] changeDoc adoc [TextDocumentContentChangeEvent . InR . (.==) #text $ aSource'] -- generate an artificial warning to avoid timing out if the TH change does not propagate changeDoc cdoc [TextDocumentContentChangeEvent . InR . (.==) #text $ cSource <> "\nfoo=()"] @@ -175,11 +176,11 @@ thLinkingTest unboxed = testCase name $ runWithExtraFiles dir $ \dir -> do expectDiagnostics [("THB.hs", [(DiagnosticSeverity_Warning, (4,1), "Top-level binding")])] - let aSource' = T.unlines $ init (init (T.lines aSource)) ++ ["th :: DecsQ", "th = [d| a = False|]"] + let aSource' = T.unlines $ dropEnd 2 (T.lines aSource) ++ ["th :: DecsQ", "th = [d| a = False|]"] changeDoc adoc [TextDocumentContentChangeEvent . InR . (.==) #text $ aSource'] -- modify b too - let bSource' = T.unlines $ init (T.lines bSource) ++ ["$th"] + let bSource' = T.unlines $ dropEnd1 (T.lines bSource) ++ ["$th"] changeDoc bdoc [TextDocumentContentChangeEvent . InR . (.==) #text $ bSource'] waitForProgressBegin waitForAllProgressDone diff --git a/ghcide/test/exe/WatchedFileTests.hs b/ghcide/test/exe/WatchedFileTests.hs index 7a2a68762b..6155f770be 100644 --- a/ghcide/test/exe/WatchedFileTests.hs +++ b/ghcide/test/exe/WatchedFileTests.hs @@ -6,6 +6,7 @@ module WatchedFileTests (tests) where import Control.Applicative.Combinators import Control.Monad.IO.Class (liftIO) import qualified Data.Aeson as A +import Data.List.Extra (drop1, dropEnd1) import qualified Data.Text as T import Development.IDE.Test (expectDiagnostics) import Language.LSP.Protocol.Message @@ -17,7 +18,6 @@ import Language.LSP.Protocol.Types hiding import Language.LSP.Test import System.Directory import System.FilePath --- import Test.QuickCheck.Instances () import Test.Tasty import Test.Tasty.HUnit import TestUtils @@ -36,7 +36,7 @@ tests = testGroup "watched files" , testSession' "non workspace file" $ \sessionDir -> do tmpDir <- liftIO getTemporaryDirectory - let yaml = "cradle: {direct: {arguments: [\"-i" <> tail(init(show tmpDir)) <> "\", \"A\", \"WatchedFilesMissingModule\"]}}" + let yaml = "cradle: {direct: {arguments: [\"-i" <> drop1 (dropEnd1 (show tmpDir)) <> "\", \"A\", \"WatchedFilesMissingModule\"]}}" liftIO $ writeFile (sessionDir "hie.yaml") yaml _doc <- createDoc "A.hs" "haskell" "{-# LANGUAGE NoImplicitPrelude#-}\nmodule A where\nimport WatchedFilesMissingModule" setIgnoringRegistrationRequests False diff --git a/hls-test-utils/src/Test/Hls.hs b/hls-test-utils/src/Test/Hls.hs index 7b66f63985..55d579acf1 100644 --- a/hls-test-utils/src/Test/Hls.hs +++ b/hls-test-utils/src/Test/Hls.hs @@ -65,7 +65,7 @@ import Control.Concurrent.Async (async, cancel, wait) import Control.Concurrent.Extra import Control.Exception.Safe import Control.Lens.Extras (is) -import Control.Monad (guard, unless, void, when) +import Control.Monad (guard, unless, void) import Control.Monad.Extra (forM) import Control.Monad.IO.Class import Data.Aeson (Result (Success), diff --git a/plugins/hls-change-type-signature-plugin/test/testdata/TErrorGivenPartialSignature.hs b/plugins/hls-change-type-signature-plugin/test/testdata/TErrorGivenPartialSignature.hs index caa595242a..da45222d93 100644 --- a/plugins/hls-change-type-signature-plugin/test/testdata/TErrorGivenPartialSignature.hs +++ b/plugins/hls-change-type-signature-plugin/test/testdata/TErrorGivenPartialSignature.hs @@ -1,4 +1,4 @@ -module ErrorGivenPartialSignature where +module TErrorGivenPartialSignature where partial :: Int -> Int partial x = init x From fc2afb96e5c0ea6f377267bf79b2a2d30668dff4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20Hr=C4=8Dek?= Date: Sat, 9 Mar 2024 13:21:42 +0100 Subject: [PATCH 4/4] Revert test changes --- .hlint.yaml | 4 ++++ ghcide/test/exe/IfaceTests.hs | 3 +-- ghcide/test/exe/THTests.hs | 7 +++---- ghcide/test/exe/WatchedFileTests.hs | 3 +-- 4 files changed, 9 insertions(+), 8 deletions(-) diff --git a/.hlint.yaml b/.hlint.yaml index c46c3abbe8..89b65dfc24 100644 --- a/.hlint.yaml +++ b/.hlint.yaml @@ -122,6 +122,7 @@ - Development.IDE.Plugin.CodeAction.ExactPrint - Development.IDE.Session - UnificationSpec + - WatchedFileTests #Previously part of GHCIDE Main tests - name: [Prelude.last, Data.List.last] within: @@ -142,6 +143,9 @@ - Ide.PluginUtils - Development.Benchmark.Rules - TErrorGivenPartialSignature + - IfaceTests #Previously part of GHCIDE Main tests + - THTests #Previously part of GHCIDE Main tests + - WatchedFileTests #Previously part of GHCIDE Main tests - name: Data.List.foldl1' within: [] diff --git a/ghcide/test/exe/IfaceTests.hs b/ghcide/test/exe/IfaceTests.hs index b20558f269..f4967a2656 100644 --- a/ghcide/test/exe/IfaceTests.hs +++ b/ghcide/test/exe/IfaceTests.hs @@ -4,7 +4,6 @@ module IfaceTests (tests) where import Control.Monad.IO.Class (liftIO) -import Data.List.Extra (dropEnd1) import Data.Row import qualified Data.Text as T import Development.IDE.GHC.Util @@ -50,7 +49,7 @@ ifaceTHTest = testCase "iface-th-test" $ runWithExtraFiles "TH" $ \dir -> do cdoc <- createDoc cPath "haskell" cSource -- Change [TH]a from () to Bool - liftIO $ writeFileUTF8 aPath (T.unpack $ T.unlines $ dropEnd1 (T.lines aSource) ++ ["th_a = [d| a = False|]"]) + liftIO $ writeFileUTF8 aPath (unlines $ init (lines $ T.unpack aSource) ++ ["th_a = [d| a = False|]"]) -- Check that the change propagates to C changeDoc cdoc [TextDocumentContentChangeEvent . InR . (.==) #text $ cSource] diff --git a/ghcide/test/exe/THTests.hs b/ghcide/test/exe/THTests.hs index 85b1571da6..975b674549 100644 --- a/ghcide/test/exe/THTests.hs +++ b/ghcide/test/exe/THTests.hs @@ -4,7 +4,6 @@ module THTests (tests) where import Control.Monad.IO.Class (liftIO) -import Data.List.Extra (dropEnd, dropEnd1) import Data.Row import qualified Data.Text as T import Development.IDE.GHC.Util @@ -142,7 +141,7 @@ thReloadingTest unboxed = testCase name $ runWithExtraFiles dir $ \dir -> do expectDiagnostics [("THB.hs", [(DiagnosticSeverity_Warning, (4,1), "Top-level binding")])] -- Change th from () to Bool - let aSource' = T.unlines $ dropEnd1 (T.lines aSource) ++ ["th_a = [d| a = False|]"] + let aSource' = T.unlines $ init (T.lines aSource) ++ ["th_a = [d| a = False|]"] changeDoc adoc [TextDocumentContentChangeEvent . InR . (.==) #text $ aSource'] -- generate an artificial warning to avoid timing out if the TH change does not propagate changeDoc cdoc [TextDocumentContentChangeEvent . InR . (.==) #text $ cSource <> "\nfoo=()"] @@ -176,11 +175,11 @@ thLinkingTest unboxed = testCase name $ runWithExtraFiles dir $ \dir -> do expectDiagnostics [("THB.hs", [(DiagnosticSeverity_Warning, (4,1), "Top-level binding")])] - let aSource' = T.unlines $ dropEnd 2 (T.lines aSource) ++ ["th :: DecsQ", "th = [d| a = False|]"] + let aSource' = T.unlines $ init (init (T.lines aSource)) ++ ["th :: DecsQ", "th = [d| a = False|]"] changeDoc adoc [TextDocumentContentChangeEvent . InR . (.==) #text $ aSource'] -- modify b too - let bSource' = T.unlines $ dropEnd1 (T.lines bSource) ++ ["$th"] + let bSource' = T.unlines $ init (T.lines bSource) ++ ["$th"] changeDoc bdoc [TextDocumentContentChangeEvent . InR . (.==) #text $ bSource'] waitForProgressBegin waitForAllProgressDone diff --git a/ghcide/test/exe/WatchedFileTests.hs b/ghcide/test/exe/WatchedFileTests.hs index 6155f770be..8ae8d8943d 100644 --- a/ghcide/test/exe/WatchedFileTests.hs +++ b/ghcide/test/exe/WatchedFileTests.hs @@ -6,7 +6,6 @@ module WatchedFileTests (tests) where import Control.Applicative.Combinators import Control.Monad.IO.Class (liftIO) import qualified Data.Aeson as A -import Data.List.Extra (drop1, dropEnd1) import qualified Data.Text as T import Development.IDE.Test (expectDiagnostics) import Language.LSP.Protocol.Message @@ -36,7 +35,7 @@ tests = testGroup "watched files" , testSession' "non workspace file" $ \sessionDir -> do tmpDir <- liftIO getTemporaryDirectory - let yaml = "cradle: {direct: {arguments: [\"-i" <> drop1 (dropEnd1 (show tmpDir)) <> "\", \"A\", \"WatchedFilesMissingModule\"]}}" + let yaml = "cradle: {direct: {arguments: [\"-i" <> tail(init(show tmpDir)) <> "\", \"A\", \"WatchedFilesMissingModule\"]}}" liftIO $ writeFile (sessionDir "hie.yaml") yaml _doc <- createDoc "A.hs" "haskell" "{-# LANGUAGE NoImplicitPrelude#-}\nmodule A where\nimport WatchedFilesMissingModule" setIgnoringRegistrationRequests False