diff --git a/.hlint.yaml b/.hlint.yaml index a6c6f29b0a..89b65dfc24 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,17 +102,12 @@ - Ide.Plugin.CallHierarchy.Internal - Ide.Plugin.Eval.Code - Ide.Plugin.Eval.Util - - Ide.Plugin.Floskell - - Ide.Plugin.ModuleName - Ide.Plugin.Class.ExactPrint - TExpectedActual - TRigidType - 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,9 +141,8 @@ - Main - Development.IDE.Spans.Common - Ide.PluginUtils - - Wingman.Metaprogramming.Parser - Development.Benchmark.Rules - - ErrorGivenPartialSignature + - TErrorGivenPartialSignature - IfaceTests #Previously part of GHCIDE Main tests - THTests #Previously part of GHCIDE Main tests - WatchedFileTests #Previously part of GHCIDE Main tests @@ -171,8 +162,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 +174,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 +231,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/ghcide/test/exe/WatchedFileTests.hs b/ghcide/test/exe/WatchedFileTests.hs index 7a2a68762b..8ae8d8943d 100644 --- a/ghcide/test/exe/WatchedFileTests.hs +++ b/ghcide/test/exe/WatchedFileTests.hs @@ -17,7 +17,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 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 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-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 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