From 0420cc9b3037428c641b0194da4bdaf829f82bba Mon Sep 17 00:00:00 2001 From: Nick Suchecki Date: Tue, 25 Jan 2022 23:58:10 -0500 Subject: [PATCH 1/3] Change Type Family Export pattern --- ghcide/src/Development/IDE/Plugin/CodeAction.hs | 2 +- ghcide/test/exe/Main.hs | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index e1667ef627..231e876c32 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -613,7 +613,7 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul exportsAs (TyClD _ SynDecl{tcdLName}) = Just (ExportName, reLoc tcdLName) exportsAs (TyClD _ DataDecl{tcdLName}) = Just (ExportAll, reLoc tcdLName) exportsAs (TyClD _ ClassDecl{tcdLName}) = Just (ExportAll, reLoc tcdLName) - exportsAs (TyClD _ FamDecl{tcdFam}) = Just (ExportAll, reLoc $ fdLName tcdFam) + exportsAs (TyClD _ FamDecl{tcdFam}) = Just (ExportName, reLoc $ fdLName tcdFam) exportsAs _ = Nothing suggestAddTypeAnnotationToSatisfyContraints :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])] diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 3c4f870aa6..26f377b756 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -3466,7 +3466,7 @@ exportUnusedTests = testGroup "export unused actions" (Just $ T.unlines [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "{-# LANGUAGE TypeFamilies #-}" - , "module A (Foo(..)) where" + , "module A (Foo) where" , "type family Foo p"]) , testSession "unused typeclass" $ template (T.unlines From c41db9296a93cdd09c3749e226c716eb40d2d00c Mon Sep 17 00:00:00 2001 From: Nick Suchecki Date: Wed, 26 Jan 2022 19:51:31 -0500 Subject: [PATCH 2/3] Add new ExportAs case for TypeFamily's. - Updated tests to match --- .../src/Development/IDE/Plugin/CodeAction.hs | 5 +++-- ghcide/test/exe/Main.hs | 21 +++++++++++-------- 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs index 231e876c32..37a4c7ecbc 100644 --- a/ghcide/src/Development/IDE/Plugin/CodeAction.hs +++ b/ghcide/src/Development/IDE/Plugin/CodeAction.hs @@ -548,7 +548,7 @@ suggestDeleteUnusedBinding isSameName :: IdP GhcPs -> String -> Bool isSameName x name = showSDocUnsafe (ppr x) == name -data ExportsAs = ExportName | ExportPattern | ExportAll +data ExportsAs = ExportName | ExportPattern | ExportFamily | ExportAll deriving (Eq) getLocatedRange :: Located a -> Maybe Range @@ -602,6 +602,7 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul printExport :: ExportsAs -> T.Text -> T.Text printExport ExportName x = parenthesizeIfNeeds False x printExport ExportPattern x = "pattern " <> x + printExport ExportFamily x = parenthesizeIfNeeds True x printExport ExportAll x = parenthesizeIfNeeds True x <> "(..)" isTopLevel :: Range -> Bool @@ -613,7 +614,7 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul exportsAs (TyClD _ SynDecl{tcdLName}) = Just (ExportName, reLoc tcdLName) exportsAs (TyClD _ DataDecl{tcdLName}) = Just (ExportAll, reLoc tcdLName) exportsAs (TyClD _ ClassDecl{tcdLName}) = Just (ExportAll, reLoc tcdLName) - exportsAs (TyClD _ FamDecl{tcdFam}) = Just (ExportName, reLoc $ fdLName tcdFam) + exportsAs (TyClD _ FamDecl{tcdFam}) = Just (ExportFamily, reLoc $ fdLName tcdFam) exportsAs _ = Nothing suggestAddTypeAnnotationToSatisfyContraints :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])] diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 26f377b756..43e8081394 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -17,7 +17,8 @@ module Main (main) where import Control.Applicative.Combinators import Control.Concurrent -import Control.Exception (bracket_, catch, finally) +import Control.Exception (bracket_, catch, + finally) import qualified Control.Lens as Lens import Control.Monad import Control.Monad.IO.Class (MonadIO, liftIO) @@ -44,6 +45,7 @@ import Development.IDE.Plugin.TypeLenses (typeLensCommandId) import Development.IDE.Spans.Common import Development.IDE.Test (Cursor, canonicalizeUri, + configureCheckProject, diagnostic, expectCurrentDiagnostics, expectDiagnostics, @@ -51,15 +53,15 @@ import Development.IDE.Test (Cursor, expectMessages, expectNoMoreDiagnostics, flushMessages, - standardizeQuotes, getInterfaceFilesDir, - waitForAction, getStoredKeys, - waitForTypecheck, waitForGC, configureCheckProject) + standardizeQuotes, + waitForAction, + waitForGC, + waitForTypecheck) import Development.IDE.Test.Runfiles import qualified Development.IDE.Types.Diagnostics as Diagnostics import Development.IDE.Types.Location -import qualified Language.LSP.Types.Lens as Lens (label) import Development.Shake (getDirectoryFilesIO) import qualified Experiments as Bench import Ide.Plugin.Config @@ -70,6 +72,7 @@ import Language.LSP.Types hiding SemanticTokensEdit (_start), mkRange) import Language.LSP.Types.Capabilities +import qualified Language.LSP.Types.Lens as Lens (label) import qualified Language.LSP.Types.Lens as Lsp (diagnostics, message, params) @@ -82,7 +85,7 @@ import System.Exit (ExitCode (ExitSuccess import System.FilePath import System.IO.Extra hiding (withTempDir) import qualified System.IO.Extra -import System.Info.Extra (isWindows, isMac) +import System.Info.Extra (isMac, isWindows) import System.Mem (performGC) import System.Process.Extra (CreateProcess (cwd), createPipe, proc, @@ -90,7 +93,7 @@ import System.Process.Extra (CreateProcess (cwd), import Test.QuickCheck -- import Test.QuickCheck.Instances () import Control.Concurrent.Async -import Control.Lens ((^.), to) +import Control.Lens (to, (^.)) import Control.Monad.Extra (whenJust) import Data.IORef import Data.IORef.Extra (atomicModifyIORef_) @@ -102,6 +105,7 @@ import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide import Development.IDE.Plugin.Test (TestRequest (BlockSeconds), WaitForIdeRuleResult (..), blockCommandId) +import qualified HieDbRetry import Ide.PluginUtils (pluginDescToIdePlugins) import Ide.Types import qualified Language.LSP.Types as LSP @@ -115,7 +119,6 @@ import Test.Tasty.Ingredients.Rerun import Test.Tasty.QuickCheck import Text.Printf (printf) import Text.Regex.TDFA ((=~)) -import qualified HieDbRetry -- | Wait for the next progress begin step waitForProgressBegin :: Session () @@ -3540,7 +3543,7 @@ exportUnusedTests = testGroup "export unused actions" (Just $ T.unlines [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "{-# LANGUAGE TypeOperators #-}" - , "module A (type (:<)(..)) where" + , "module A (type (:<)) where" , "class (:<) a"]) , testSession "newtype operator" $ template (T.unlines From e9d3e845acc9cf82173f6d8a114dbbaacad09a03 Mon Sep 17 00:00:00 2001 From: Nick Suchecki Date: Wed, 26 Jan 2022 20:51:37 -0500 Subject: [PATCH 3/3] Swap unintended test change with real test change. --- ghcide/test/exe/Main.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 43e8081394..da2439e3bb 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -3530,7 +3530,7 @@ exportUnusedTests = testGroup "export unused actions" [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "{-# LANGUAGE TypeFamilies #-}" , "{-# LANGUAGE TypeOperators #-}" - , "module A (type (:<)(..)) where" + , "module A (type (:<)) where" , "type family (:<)"]) , testSession "typeclass operator" $ template (T.unlines @@ -3543,7 +3543,7 @@ exportUnusedTests = testGroup "export unused actions" (Just $ T.unlines [ "{-# OPTIONS_GHC -Wunused-top-binds #-}" , "{-# LANGUAGE TypeOperators #-}" - , "module A (type (:<)) where" + , "module A (type (:<)(..)) where" , "class (:<) a"]) , testSession "newtype operator" $ template (T.unlines