hls-gadt-plugin 1.0.0.0 → 1.0.1.0
raw patch · 4 files changed
+47/−55 lines, 4 filesdep ~ghcidedep ~hls-plugin-apidep ~hls-test-utilsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ghcide, hls-plugin-api, hls-test-utils
API changes (from Hackage documentation)
Files
- hls-gadt-plugin.cabal +8/−12
- src/Ide/Plugin/GADT.hs +16/−29
- src/Ide/Plugin/GHC.hs +16/−7
- test/Main.hs +7/−7
hls-gadt-plugin.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-gadt-plugin-version: 1.0.0.0+version: 1.0.1.0 synopsis: Convert to GADT syntax plugin description: Please see the README on GitHub at <https://github.com/haskell/haskell-language-server/tree/master/plugins/hls-gadt-plugin#readme>@@ -15,11 +15,11 @@ LICENSE test/testdata/*.hs +source-repository head+ type: git+ location: https://github.com/haskell/haskell-language-server.git+ library- if impl(ghc >= 9.3)- buildable: False- else- buildable: True exposed-modules: Ide.Plugin.GADT other-modules: Ide.Plugin.GHC @@ -30,10 +30,10 @@ , containers , extra , ghc- , ghcide ^>= 1.8+ , ghcide ^>= 1.9 , ghc-boot-th , ghc-exactprint- , hls-plugin-api ^>= 1.5+ , hls-plugin-api ^>= 1.6 , hls-refactor-plugin , lens , lsp >=1.2.0.1@@ -50,10 +50,6 @@ default-extensions: DataKinds test-suite tests- if impl(ghc >= 9.3)- buildable: False- else- buildable: True type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test@@ -63,7 +59,7 @@ , base , filepath , hls-gadt-plugin- , hls-test-utils ^>=1.4+ , hls-test-utils ^>=1.5 , lens , lsp , lsp-test
src/Ide/Plugin/GADT.hs view
@@ -8,30 +8,26 @@ {-# LANGUAGE ViewPatterns #-} module Ide.Plugin.GADT (descriptor) where -import Control.Lens ((^.))+import Control.Lens ((^.)) import Control.Monad.Except-import Data.Aeson (FromJSON, ToJSON,- Value (Null), toJSON)-import Data.Either.Extra (maybeToEither)-import qualified Data.HashMap.Lazy as HashMap-import qualified Data.Text as T+import Data.Aeson (FromJSON, ToJSON, Value (Null),+ toJSON)+import Data.Either.Extra (maybeToEither)+import qualified Data.HashMap.Lazy as HashMap+import qualified Data.Text as T import Development.IDE import Development.IDE.GHC.Compat -import Control.Monad.Trans.Except (throwE)-import Data.Maybe (mapMaybe)-import Development.IDE.GHC.Compat.Util (toList)-import Development.IDE.Spans.Pragmas (NextPragmaInfo,- getNextPragmaInfo,- insertNewPragma)-import GHC.Generics (Generic)-import GHC.LanguageExtensions.Type (Extension (GADTSyntax, GADTs))+import Control.Monad.Trans.Except (throwE)+import Data.Maybe (mapMaybe)+import Development.IDE.Spans.Pragmas (getFirstPragma, insertNewPragma)+import GHC.Generics (Generic) import Ide.Plugin.GHC import Ide.PluginUtils import Ide.Types-import Language.LSP.Server (sendRequest)+import Language.LSP.Server (sendRequest) import Language.LSP.Types-import qualified Language.LSP.Types.Lens as L+import qualified Language.LSP.Types.Lens as L descriptor :: PluginId -> PluginDescriptor IdeState descriptor plId = (defaultPluginDescriptor plId)@@ -52,20 +48,20 @@ -- | A command replaces H98 data decl with GADT decl in place toGADTCommand :: PluginId -> CommandFunction IdeState ToGADTParams-toGADTCommand _ state ToGADTParams{..} = pluginResponse $ do+toGADTCommand pId@(PluginId pId') state ToGADTParams{..} = pluginResponse $ do nfp <- getNormalizedFilePath uri (decls, exts) <- getInRangeH98DeclsAndExts state range nfp (L ann decl) <- case decls of [d] -> pure d _ -> throwE $ "Expected 1 declaration, but got " <> show (Prelude.length decls)- deps <- liftIO $ runAction "GADT.GhcSessionDeps" state $ use GhcSessionDeps nfp+ deps <- liftIO $ runAction (T.unpack pId' <> ".GhcSessionDeps") state $ use GhcSessionDeps nfp (hsc_dflags . hscEnv -> df) <- liftEither $ maybeToEither "Get GhcSessionDeps failed" deps txt <- liftEither $ T.pack <$> (prettyGADTDecl df . h98ToGADTDecl) decl range <- liftEither $ maybeToEither "Unable to get data decl range" $ srcSpanToRange $ locA ann- pragma <- getNextPragma state nfp+ pragma <- getFirstPragma pId state nfp let insertEdit = [insertNewPragma pragma GADTs | all (`notElem` exts) [GADTSyntax, GADTs]] _ <- lift $ sendRequest@@ -118,14 +114,5 @@ decls = filter isH98DataDecl $ mapMaybe getDataDecl $ filter (inRange range) hsDecls- exts = (toList . extensionFlags . ms_hspp_opts . pm_mod_summary) pm+ exts = getExtensions pm pure (decls, exts)---- Copy from hls-alternate-number-format-plugin-getNextPragma :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT String m NextPragmaInfo-getNextPragma state nfp = handleMaybeM "Error: Could not get NextPragmaInfo" $ do- ghcSession <- liftIO $ runAction "GADT.GhcSession" state $ useWithStale GhcSession nfp- (_, fileContents) <- liftIO $ runAction "GADT.GetFileContents" state $ getFileContents nfp- case ghcSession of- Just (hscEnv -> hsc_dflags -> sessionDynFlags, _) -> pure $ Just $ getNextPragmaInfo sessionDynFlags fileContents- Nothing -> pure Nothing
src/Ide/Plugin/GHC.hs view
@@ -79,13 +79,13 @@ } x -> x --- | Convert H98 data constuctor to GADT data constructor+-- | Convert H98 data constructor to GADT data constructor h98ToGADTConDecl ::- LIdP GP -- ^Type constuctor name,- -- used for constucting final result type in GADT+ LIdP GP -- ^Type constructor name,+ -- used for constructing final result type in GADT -> LHsQTyVars GP -- ^Type variable names- -- used for constucting final result type in GADT+ -- used for constructing final result type in GADT -> Maybe (LHsContext GP) -- ^Data type context -> ConDecl GP@@ -111,7 +111,12 @@ renderDetails :: HsConDeclH98Details GP -> HsConDeclGADTDetails GP renderDetails (PrefixCon _ args) = PrefixConGADT args renderDetails (InfixCon arg1 arg2) = PrefixConGADT [arg1, arg2]+#if MIN_VERSION_ghc(9,3,0)+ renderDetails (RecCon recs) = RecConGADT recs noHsUniTok+#else renderDetails (RecCon recs) = RecConGADT recs+#endif+ #else renderDetails (PrefixCon args) = PrefixCon args renderDetails (InfixCon arg1 arg2) = PrefixCon [arg1, arg2]@@ -185,7 +190,11 @@ adjustTyClD = \case Right (L _ (TyClD _ tycld)) -> Right $ adjustDataDecl tycld Right x -> Left $ "Expect TyClD but got " <> showAst x+#if MIN_VERSION_ghc(9,3,0)+ Left err -> Left $ printWithoutUniques err+#else Left err -> Left $ show err+#endif adjustDataDecl DataDecl{..} = DataDecl { tcdDExt = adjustWhere tcdDExt@@ -203,7 +212,7 @@ where go (Anchor a _) = Anchor a (MovedAnchor (DifferentLine 1 2)) - -- Adjust where annotation to the same line of the type constuctor+ -- Adjust where annotation to the same line of the type constructor adjustWhere tcdDExt = tcdDExt <&> map (\(AddEpAnn ann l) -> if ann == AnnWhere@@ -237,7 +246,7 @@ | isConDeclGADTAnn key = adjustCon ann | otherwise = ann - -- Adjust where annotation to the same line of the type constuctor+ -- Adjust where annotation to the same line of the type constructor adjustWhere Ann{..} = Ann { annsDP = annsDP <&> (\(keyword, dp) ->@@ -249,7 +258,7 @@ -- Make every data constructor start with a new line and 2 spaces --- -- Here we can't force every GADT constuctor has (1, 2)+ -- Here we can't force every GADT constructor has (1, 2) -- delta. For the first constructor with (1, 2), it prints -- a new line with 2 spaces, but for other constructors -- with (1, 2), it will print a new line with 4 spaces.
test/Main.hs view
@@ -15,8 +15,8 @@ main :: IO () main = defaultTestRunner tests -gadtPlugin :: PluginDescriptor IdeState-gadtPlugin = GADT.descriptor "GADT"+gadtPlugin :: PluginTestDescriptor ()+gadtPlugin = mkPluginTestDescriptor' GADT.descriptor "GADT" tests :: TestTree tests = testGroup "GADT"@@ -32,16 +32,16 @@ , runTest "DataContext" "DataContext" 2 0 2 31 , runTest "DataContextParen" "DataContextParen" 2 0 3 6 , runTest "Forall" "Forall" 2 0 2 44- , runTest "ConstuctorContext" "ConstructorContext" 2 0 2 38+ , runTest "ConstructorContext" "ConstructorContext" 2 0 2 38 , runTest "Context" "Context" 2 0 4 41 , runTest "Pragma" "Pragma" 2 0 3 29- , onlyWorkForGhcVersions (==GHC92) "Single deriving has different output on ghc9.2" $+ , onlyWorkForGhcVersions (`elem`[GHC92, GHC94]) "Single deriving has different output on ghc9.2+" $ runTest "SingleDerivingGHC92" "SingleDerivingGHC92" 2 0 3 14- , knownBrokenForGhcVersions [GHC92] "Single deriving has different output on ghc9.2" $+ , knownBrokenForGhcVersions [GHC92,GHC94] "Single deriving has different output on ghc9.2+" $ runTest "SingleDeriving" "SingleDeriving" 2 0 3 14- , onlyWorkForGhcVersions (==GHC92) "only ghc-9.2 enabled GADTs pragma implicitly" $+ , onlyWorkForGhcVersions (`elem`[GHC92, GHC94]) "only ghc-9.2+ enabled GADTs pragma implicitly" $ gadtPragmaTest "ghc-9.2 don't need to insert GADTs pragma" False- , knownBrokenForGhcVersions [GHC92] "ghc-9.2 has enabled GADTs pragma implicitly" $+ , knownBrokenForGhcVersions [GHC92,GHC94] "ghc-9.2 has enabled GADTs pragma implicitly" $ gadtPragmaTest "insert pragma" True ]