From 0905e682de8cc3e2bfe509313924cff0527b6791 Mon Sep 17 00:00:00 2001
From: Nick Suchecki <40047416+drsooch@users.noreply.github.com>
Date: Thu, 27 Jan 2022 06:30:00 -0500
Subject: [PATCH] Change Type Family Export pattern (#2643)
* Change Type Family Export pattern
* Add new ExportAs case for TypeFamily's.
- Updated tests to match
* Swap unintended test change with real test change.
---
.../src/Development/IDE/Plugin/CodeAction.hs | 5 ++--
ghcide/test/exe/Main.hs | 23 +++++++++++--------
2 files changed, 16 insertions(+), 12 deletions(-)
diff --git a/ghcide/src/Development/IDE/Plugin/CodeAction.hs b/ghcide/src/Development/IDE/Plugin/CodeAction.hs
index e1667ef6..37a4c7ec 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 (ExportAll, 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 3c4f870a..da2439e3 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 ()
@@ -3466,7 +3469,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
@@ -3527,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
--
GitLab