Skip to content

Commit 0905e68

Browse files
authored
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.
1 parent f62ec3e commit 0905e68

File tree

2 files changed

+16
-12
lines changed

2 files changed

+16
-12
lines changed

ghcide/src/Development/IDE/Plugin/CodeAction.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -548,7 +548,7 @@ suggestDeleteUnusedBinding
548548
isSameName :: IdP GhcPs -> String -> Bool
549549
isSameName x name = showSDocUnsafe (ppr x) == name
550550

551-
data ExportsAs = ExportName | ExportPattern | ExportAll
551+
data ExportsAs = ExportName | ExportPattern | ExportFamily | ExportAll
552552
deriving (Eq)
553553

554554
getLocatedRange :: Located a -> Maybe Range
@@ -602,6 +602,7 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul
602602
printExport :: ExportsAs -> T.Text -> T.Text
603603
printExport ExportName x = parenthesizeIfNeeds False x
604604
printExport ExportPattern x = "pattern " <> x
605+
printExport ExportFamily x = parenthesizeIfNeeds True x
605606
printExport ExportAll x = parenthesizeIfNeeds True x <> "(..)"
606607

607608
isTopLevel :: Range -> Bool
@@ -613,7 +614,7 @@ suggestExportUnusedTopBinding srcOpt ParsedModule{pm_parsed_source = L _ HsModul
613614
exportsAs (TyClD _ SynDecl{tcdLName}) = Just (ExportName, reLoc tcdLName)
614615
exportsAs (TyClD _ DataDecl{tcdLName}) = Just (ExportAll, reLoc tcdLName)
615616
exportsAs (TyClD _ ClassDecl{tcdLName}) = Just (ExportAll, reLoc tcdLName)
616-
exportsAs (TyClD _ FamDecl{tcdFam}) = Just (ExportAll, reLoc $ fdLName tcdFam)
617+
exportsAs (TyClD _ FamDecl{tcdFam}) = Just (ExportFamily, reLoc $ fdLName tcdFam)
617618
exportsAs _ = Nothing
618619

619620
suggestAddTypeAnnotationToSatisfyContraints :: Maybe T.Text -> Diagnostic -> [(T.Text, [TextEdit])]

ghcide/test/exe/Main.hs

Lines changed: 13 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -17,7 +17,8 @@ module Main (main) where
1717

1818
import Control.Applicative.Combinators
1919
import Control.Concurrent
20-
import Control.Exception (bracket_, catch, finally)
20+
import Control.Exception (bracket_, catch,
21+
finally)
2122
import qualified Control.Lens as Lens
2223
import Control.Monad
2324
import Control.Monad.IO.Class (MonadIO, liftIO)
@@ -44,22 +45,23 @@ import Development.IDE.Plugin.TypeLenses (typeLensCommandId)
4445
import Development.IDE.Spans.Common
4546
import Development.IDE.Test (Cursor,
4647
canonicalizeUri,
48+
configureCheckProject,
4749
diagnostic,
4850
expectCurrentDiagnostics,
4951
expectDiagnostics,
5052
expectDiagnosticsWithTags,
5153
expectMessages,
5254
expectNoMoreDiagnostics,
5355
flushMessages,
54-
standardizeQuotes,
5556
getInterfaceFilesDir,
56-
waitForAction,
5757
getStoredKeys,
58-
waitForTypecheck, waitForGC, configureCheckProject)
58+
standardizeQuotes,
59+
waitForAction,
60+
waitForGC,
61+
waitForTypecheck)
5962
import Development.IDE.Test.Runfiles
6063
import qualified Development.IDE.Types.Diagnostics as Diagnostics
6164
import Development.IDE.Types.Location
62-
import qualified Language.LSP.Types.Lens as Lens (label)
6365
import Development.Shake (getDirectoryFilesIO)
6466
import qualified Experiments as Bench
6567
import Ide.Plugin.Config
@@ -70,6 +72,7 @@ import Language.LSP.Types hiding
7072
SemanticTokensEdit (_start),
7173
mkRange)
7274
import Language.LSP.Types.Capabilities
75+
import qualified Language.LSP.Types.Lens as Lens (label)
7376
import qualified Language.LSP.Types.Lens as Lsp (diagnostics,
7477
message,
7578
params)
@@ -82,15 +85,15 @@ import System.Exit (ExitCode (ExitSuccess
8285
import System.FilePath
8386
import System.IO.Extra hiding (withTempDir)
8487
import qualified System.IO.Extra
85-
import System.Info.Extra (isWindows, isMac)
88+
import System.Info.Extra (isMac, isWindows)
8689
import System.Mem (performGC)
8790
import System.Process.Extra (CreateProcess (cwd),
8891
createPipe, proc,
8992
readCreateProcessWithExitCode)
9093
import Test.QuickCheck
9194
-- import Test.QuickCheck.Instances ()
9295
import Control.Concurrent.Async
93-
import Control.Lens ((^.), to)
96+
import Control.Lens (to, (^.))
9497
import Control.Monad.Extra (whenJust)
9598
import Data.IORef
9699
import Data.IORef.Extra (atomicModifyIORef_)
@@ -102,6 +105,7 @@ import qualified Development.IDE.Plugin.HLS.GhcIde as Ghcide
102105
import Development.IDE.Plugin.Test (TestRequest (BlockSeconds),
103106
WaitForIdeRuleResult (..),
104107
blockCommandId)
108+
import qualified HieDbRetry
105109
import Ide.PluginUtils (pluginDescToIdePlugins)
106110
import Ide.Types
107111
import qualified Language.LSP.Types as LSP
@@ -115,7 +119,6 @@ import Test.Tasty.Ingredients.Rerun
115119
import Test.Tasty.QuickCheck
116120
import Text.Printf (printf)
117121
import Text.Regex.TDFA ((=~))
118-
import qualified HieDbRetry
119122

120123
-- | Wait for the next progress begin step
121124
waitForProgressBegin :: Session ()
@@ -3466,7 +3469,7 @@ exportUnusedTests = testGroup "export unused actions"
34663469
(Just $ T.unlines
34673470
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
34683471
, "{-# LANGUAGE TypeFamilies #-}"
3469-
, "module A (Foo(..)) where"
3472+
, "module A (Foo) where"
34703473
, "type family Foo p"])
34713474
, testSession "unused typeclass" $ template
34723475
(T.unlines
@@ -3527,7 +3530,7 @@ exportUnusedTests = testGroup "export unused actions"
35273530
[ "{-# OPTIONS_GHC -Wunused-top-binds #-}"
35283531
, "{-# LANGUAGE TypeFamilies #-}"
35293532
, "{-# LANGUAGE TypeOperators #-}"
3530-
, "module A (type (:<)(..)) where"
3533+
, "module A (type (:<)) where"
35313534
, "type family (:<)"])
35323535
, testSession "typeclass operator" $ template
35333536
(T.unlines

0 commit comments

Comments
 (0)