git.iko.soy/ghcide
on master help sign in
use GHC language extension names (#362)
commit46c76341110d83a4efe42c934f0b64552323a1d1 authorsheaf <sam.derbyshire@gmail.com> dateSun 26 Jan 2020, 15:45 (7 years ago) parent742df7d
3 files changed+65−21
compare with master
unifiedsplit
src/Development/IDE/GHC/Compat.hs−15 src/Development/IDE/Plugin/CodeAction.hs+8−6 test/exe/Main.hs+57
src/Development/IDE/GHC/Compat.hs−15
@@ -16,7 +16,6 @@ module Development.IDE.GHC.Compat(
1616 includePathsGlobal,
1717 includePathsQuote,
1818 addIncludePathsQuote,
19− ghcEnumerateExtensions,
2019 pattern DerivD,
2120 pattern ForD,
2221 pattern InstD,
@@ -31,11 +30,6 @@ module Development.IDE.GHC.Compat(
3130import StringBuffer
3231import DynFlags
3332import FieldLabel
34−import GHC.LanguageExtensions.Type
35−
36−#if MIN_GHC_API_VERSION(8,8,0)
37−import Data.List.Extra (enumerate)
38−#endif
3933
4034import qualified GHC
4135import GHC hiding (ClassOpSig, DerivD, ForD, IEThingWith, InstD, TyClD, ValD)
@@ -88,15 +82,6 @@ addIncludePathsQuote path x = x{includePaths = f $ includePaths x}
8882addIncludePathsQuote path x = x{includePaths = path : includePaths x}
8983#endif
9084
91−ghcEnumerateExtensions :: [Extension]
92−#if MIN_GHC_API_VERSION(8,8,0)
93−ghcEnumerateExtensions = enumerate
94−#elif MIN_GHC_API_VERSION(8,6,0)
95−ghcEnumerateExtensions = [Cpp .. StarIsType]
96−#else
97−ghcEnumerateExtensions = [Cpp .. EmptyDataDeriving]
98−#endif
99−
10085pattern DerivD :: DerivDecl p -> HsDecl p
10186pattern DerivD x <-
10287#if MIN_GHC_API_VERSION(8,6,0)
src/Development/IDE/Plugin/CodeAction.hs+8−6
@@ -21,7 +21,6 @@ import Development.IDE.LSP.Server
2121import Development.IDE.Types.Location
2222import Development.IDE.Types.Options
2323import qualified Data.HashMap.Strict as Map
24−import qualified Data.HashSet as Set
2524import qualified Language.Haskell.LSP.Core as LSP
2625import Language.Haskell.LSP.VFS
2726import Language.Haskell.LSP.Messages
@@ -32,9 +31,12 @@ import Data.Char
3231import Data.Maybe
3332import Data.List.Extra
3433import qualified Data.Text as T
34+import Data.Tuple.Extra ((&&&))
3535import Text.Regex.TDFA ((=~), (=~~))
3636import Text.Regex.TDFA.Text()
3737import Outputable (ppr, showSDocUnsafe)
38+import DynFlags (xFlags, FlagSpec(..))
39+import GHC.LanguageExtensions.Type (Extension)
3840
3941plugin :: Plugin
4042plugin = codeActionPlugin codeAction <> Plugin mempty setHandlersCodeLens
@@ -210,10 +212,14 @@ suggestAddExtension Diagnostic{_range=_range@Range{..},..}
210212-- * In the context: a ~ ()
211213-- While checking an instance declaration
212214-- In the instance declaration for `Unit (m a)'
213− | exts@(_:_) <- filter (`Set.member` ghcExtensions) $ T.split (not . isAlpha) $ T.replace "-X" "" _message
215+ | exts@(_:_) <- filter (`Map.member` ghcExtensions) $ T.split (not . isAlpha) $ T.replace "-X" "" _message
214216 = [("Add " <> x <> " extension", [TextEdit (Range (Position 0 0) (Position 0 0)) $ "{-# LANGUAGE " <> x <> " #-}\n"]) | x <- exts]
215217 | otherwise = []
216218
219+-- | All the GHC extensions
220+ghcExtensions :: Map.HashMap T.Text Extension
221+ghcExtensions = Map.fromList . map ( ( T.pack . flagSpecName ) &&& flagSpecFlag ) $ xFlags
222+
217223suggestModuleTypo :: Diagnostic -> [(T.Text, [TextEdit])]
218224suggestModuleTypo Diagnostic{_range=_range@Range{..},..}
219225-- src/Development/IDE/Core/Compile.hs:58:1: error:
@@ -367,10 +373,6 @@ extendToWholeLineIfPossible contents range@Range{..} =
367373 extend = newlineAfter && _character _start == 0 -- takes up an entire line, so remove the whole line
368374 in if extend then Range _start (Position (_line _end + 1) 0) else range
369375
370−-- | All the GHC extensions
371−ghcExtensions :: Set.HashSet T.Text
372−ghcExtensions = Set.fromList $ map (T.pack . show) ghcEnumerateExtensions
373−
374376splitTextAtPosition :: Position -> T.Text -> (T.Text, T.Text)
375377splitTextAtPosition (Position row col) x
376378 | (preRow, mid:postRow) <- splitAt row $ T.splitOn "\n" x
test/exe/Main.hs+57
@@ -392,6 +392,7 @@ codeActionTests = testGroup "code actions"
392392 , typeWildCardActionTests
393393 , removeImportTests
394394 , extendImportTests
395+ , addExtensionTests
395396 , fixConstructorImportTests
396397 , importRenameActionTests
397398 , fillTypedHoleTests
@@ -806,6 +807,62 @@ extendImportTests = testGroup "extend import actions"
806807 contentAfterAction <- documentContents docB
807808 liftIO $ expectedContentB @=? contentAfterAction
808809
810+addExtensionTests :: TestTree
811+addExtensionTests = testGroup "add language extension actions"
812+ [ testSession "add NamedFieldPuns language extension" $ template
813+ (T.unlines
814+ [ "module Module where"
815+ , ""
816+ , "data A = A { getA :: Bool }"
817+ , ""
818+ , "f :: A -> Bool"
819+ , "f A { getA } = getA"
820+ ])
821+ (Range (Position 0 0) (Position 0 0))
822+ "Add NamedFieldPuns extension"
823+ (T.unlines
824+ [ "{-# LANGUAGE NamedFieldPuns #-}"
825+ , "module Module where"
826+ , ""
827+ , "data A = A { getA :: Bool }"
828+ , ""
829+ , "f :: A -> Bool"
830+ , "f A { getA } = getA"
831+ ])
832+ , testSession "add RecordWildCards language extension" $ template
833+ (T.unlines
834+ [ "module Module where"
835+ , ""
836+ , "data A = A { getA :: Bool }"
837+ , ""
838+ , "f :: A -> Bool"
839+ , "f A { .. } = getA"
840+ ])
841+ (Range (Position 0 0) (Position 0 0))
842+ "Add RecordWildCards extension"
843+ (T.unlines
844+ [ "{-# LANGUAGE RecordWildCards #-}"
845+ , "module Module where"
846+ , ""
847+ , "data A = A { getA :: Bool }"
848+ , ""
849+ , "f :: A -> Bool"
850+ , "f A { .. } = getA"
851+ ])
852+ ]
853+ where
854+ template initialContent range expectedAction expectedContents = do
855+ doc <- openDoc' "Module.hs" "haskell" initialContent
856+ _ <- waitForDiagnostics
857+ CACodeAction action@CodeAction { _title = actionTitle } : _
858+ <- sortOn (\(CACodeAction CodeAction{_title=x}) -> x) <$>
859+ getCodeActions doc range
860+ liftIO $ expectedAction @=? actionTitle
861+ executeCodeAction action
862+ contentAfterAction <- documentContents doc
863+ liftIO $ expectedContents @=? contentAfterAction
864+
865+
809866insertNewDefinitionTests :: TestTree
810867insertNewDefinitionTests = testGroup "insert new definition actions"
811868 [ testSession "insert new function definition" $ do