New plugin: Explicit record fields

.github/workflows/test.yml

@@ -250,6 +250,10 @@ jobs:
         name: Test hls-explicit-fixity-plugin test suite
         run: cabal test hls-explicit-fixity-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-explicit-fixity-plugin --test-options="$TEST_OPTS"
 
+      - if: matrix.test
+        name: Test hls-explicit-record-fields-plugin test suite
+        run: cabal test hls-explicit-record-fields-plugin --test-options="$TEST_OPTS" || LSP_TEST_LOG_COLOR=0 LSP_TEST_LOG_MESSAGES=true LSP_TEST_LOG_STDERR=true cabal test hls-explicit-record-fields-plugin --test-options="$TEST_OPTS"
+
   test_post_job:
     if: always()
     runs-on: ubuntu-latest

cabal.project

@@ -33,6 +33,7 @@ packages:
          ./plugins/hls-stan-plugin
          ./plugins/hls-gadt-plugin
          ./plugins/hls-explicit-fixity-plugin
+         ./plugins/hls-explicit-record-fields-plugin
          ./plugins/hls-refactor-plugin
 
 -- Standard location for temporary packages needed for particular environments
@@ -55,6 +56,8 @@ constraints:
   entropy >= 0.4.1.10,
   -- For GHC 9.4
   basement >= 0.0.15,
+  -- For GHC 9.4
+  hw-prim >= 0.6.3.2,
   hyphenation +embed,
   -- remove this when hlint sets ghc-lib to true by default
   -- https://github.com/ndmitchell/hlint/issues/1376

docs/features.md

@@ -291,6 +291,16 @@ Convert a datatype to GADT syntax.
 
 ![Link to Docs](../plugins/hls-gadt-plugin/README.md)
 
+### Expand record wildcard
+
+Provided by: `hls-explicit-record-fields-plugin`
+
+Code action kind: `refactor.rewrite`
+
+Expand record wildcards, explicitly listing all record fields as field puns.
+
+![Explicit Wildcard Demo](../plugins/hls-explicit-record-fields-plugin/wildcard.gif)
+
 ## Code lenses
 
 ### Add type signature

docs/support/plugin-support.md

@@ -50,6 +50,7 @@ For example, a plugin to provide a formatter which has itself been abandoned has
 | `hls-change-type-signature-plugin`  | 2    |                          |
 | `hls-eval-plugin`                   | 2    | 9.4                      |
 | `hls-explicit-fixity-plugin`        | 2    |                          |
+| `hls-explicit-record-fields-plugin` | 2    |                          |
 | `hls-floskell-plugin`               | 2    | 9.4                      |
 | `hls-fourmolu-plugin`               | 2    | 9.4                      |
 | `hls-gadt-plugin`                   | 2    | 9.4                      |

flake.nix

@@ -111,6 +111,10 @@
       url = "https://hackage.haskell.org/package/hiedb-0.4.2.0/hiedb-0.4.2.0.tar.gz";
       flake = false;
     };
+    hw-prim = {
+      url = "https://hackage.haskell.org/package/hw-prim-0.6.3.2/hw-prim-0.6.3.2.tar.gz";
+      flake = false;
+    };
   };
   outputs =
     inputs@{ self, nixpkgs, flake-compat, flake-utils, gitignore, all-cabal-hashes-unpacked, ... }:
@@ -182,6 +186,7 @@
 
               entropy = hsuper.callCabal2nix "entropy" inputs.entropy {};
               hiedb = hsuper.callCabal2nix "hiedb" inputs.hiedb {};
+              hw-prim = hsuper.callCabal2nix "hw-prim" inputs.hw-prim {};
 
               implicit-hie-cradle = hself.callCabal2nix "implicit-hie-cradle" inputs.implicit-hie-cradle {};
               ghc-check = hself.callCabal2nix "ghc-check" inputs.ghc-check {};

ghcide/src/Development/IDE/GHC/Compat/Core.hs

@@ -130,6 +130,8 @@ module Development.IDE.GHC.Compat.Core (
       ),
     pattern FunTy,
     pattern ConPatIn,
+    conPatDetails,
+    mapConPatDetail,
 #if !MIN_VERSION_ghc(9,2,0)
     Development.IDE.GHC.Compat.Core.splitForAllTyCoVars,
 #endif
@@ -253,6 +255,7 @@ module Development.IDE.GHC.Compat.Core (
     SrcLoc.noSrcSpan,
     SrcLoc.noSrcLoc,
     SrcLoc.noLoc,
+    SrcLoc.mapLoc,
     -- * Finder
     FindResult(..),
     mkHomeModLocation,
@@ -461,6 +464,18 @@ module Development.IDE.GHC.Compat.Core (
     module GHC.Unit.Finder.Types,
     module GHC.Unit.Env,
     module GHC.Driver.Phases,
+#endif
+# if !MIN_VERSION_ghc(9,4,0)
+    pattern HsFieldBind,
+    hfbAnn,
+    hfbLHS,
+    hfbRHS,
+    hfbPun,
+#endif
+#if !MIN_VERSION_ghc_boot_th(9,4,1)
+    Extension(.., NamedFieldPuns),
+#else
+    Extension(..)
 #endif
     ) where
 
@@ -710,12 +725,12 @@ import           TcRnMonad                    hiding (Applicative (..), IORef,
                                                allM, anyM, concatMapM, foldrM,
                                                mapMaybeM, (<$>))
 import           TcRnTypes
-import           TcType                       
+import           TcType
 import qualified TcType
 import           TidyPgm                     as GHC
 import qualified TyCoRep
 import           TyCon
-import           Type                         
+import           Type
 import           TysPrim
 import           TysWiredIn
 import           Unify
@@ -755,6 +770,11 @@ import qualified GHC.Driver.Finder as GHC
 import qualified Finder as GHC
 #endif
 
+-- NOTE(ozkutuk): Cpp clashes Phase.Cpp, so we hide it.
+-- Not the greatest solution, but gets the job done
+-- (until the CPP extension is actually needed).
+import GHC.LanguageExtensions.Type hiding (Cpp)
+
 
 mkHomeModLocation :: DynFlags -> ModuleName -> FilePath -> IO Module.ModLocation
 #if MIN_VERSION_ghc(9,3,0)
@@ -936,6 +956,25 @@ pattern ConPatIn con args = ConPat NoExtField con args
 #endif
 #endif
 
+conPatDetails :: Pat p -> Maybe (HsConPatDetails p)
+#if MIN_VERSION_ghc(9,0,0)
+conPatDetails (ConPat _ _ args) = Just args
+conPatDetails _ = Nothing
+#else
+conPatDetails (ConPatIn _ args) = Just args
+conPatDetails _ = Nothing
+#endif
+
+mapConPatDetail :: (HsConPatDetails p -> Maybe (HsConPatDetails p)) -> Pat p -> Maybe (Pat p)
+#if MIN_VERSION_ghc(9,0,0)
+mapConPatDetail f pat@(ConPat _ _ args) = (\args' -> pat { pat_args = args'}) <$> f args
+mapConPatDetail _ _ = Nothing
+#else
+mapConPatDetail f (ConPatIn ss args) = ConPatIn ss <$> f args
+mapConPatDetail _ _ = Nothing
+#endif
+
+
 initDynLinker, initObjLinker :: HscEnv -> IO ()
 initDynLinker =
 #if !MIN_VERSION_ghc(9,0,0)
@@ -1101,3 +1140,21 @@ driverNoStop =
 hscUpdateHPT :: (HomePackageTable -> HomePackageTable) -> HscEnv -> HscEnv
 hscUpdateHPT k session = session { hsc_HPT = k (hsc_HPT session) }
 #endif
+
+#if !MIN_VERSION_ghc(9,2,0)
+match :: HsRecField' id arg -> ((), id, arg, Bool)
+match (HsRecField lhs rhs pun) = ((), SrcLoc.unLoc lhs, rhs, pun)
+
+pattern HsFieldBind :: () -> id -> arg -> Bool -> HsRecField' id arg
+pattern HsFieldBind {hfbAnn, hfbLHS, hfbRHS, hfbPun} <- (match -> (hfbAnn, hfbLHS, hfbRHS, hfbPun)) where
+  HsFieldBind _ lhs rhs pun = HsRecField (SrcLoc.noLoc lhs) rhs pun
+#elif !MIN_VERSION_ghc(9,4,0)
+pattern HsFieldBind :: XHsRecField id -> id -> arg -> Bool -> HsRecField' id arg
+pattern HsFieldBind {hfbAnn, hfbLHS, hfbRHS, hfbPun} <- HsRecField hfbAnn (SrcLoc.unLoc -> hfbLHS) hfbRHS hfbPun where
+  HsFieldBind ann lhs rhs pun = HsRecField ann (SrcLoc.noLoc lhs) rhs pun
+#endif
+
+#if !MIN_VERSION_ghc_boot_th(9,4,1)
+pattern NamedFieldPuns :: Extension
+pattern NamedFieldPuns = RecordPuns
+#endif

ghcide/src/Development/IDE/GHC/Util.hs

@@ -26,10 +26,12 @@ module Development.IDE.GHC.Util(
     setHieDir,
     dontWriteHieFiles,
     disableWarningsAsErrors,
-    printOutputable
+    printOutputable,
+    getExtensions
     ) where
 
 #if MIN_VERSION_ghc(9,2,0)
+import           GHC.Data.EnumSet
 import           GHC.Data.FastString
 import           GHC.Data.StringBuffer
 import           GHC.Driver.Env                    hiding (hscSetFlags)
@@ -73,7 +75,7 @@ import           Development.IDE.Types.Location
 import           Foreign.ForeignPtr
 import           Foreign.Ptr
 import           Foreign.Storable
-import           GHC
+import           GHC                               hiding (ParsedModule (..))
 import           GHC.IO.BufferedIO                 (BufferedIO)
 import           GHC.IO.Device                     as IODevice
 import           GHC.IO.Encoding
@@ -295,3 +297,6 @@ printOutputable =
     -- More discussion at https://github.com/haskell/haskell-language-server/issues/3115.
     unescape . T.pack . printWithoutUniques
 {-# INLINE printOutputable #-}
+
+getExtensions :: ParsedModule -> [Extension]
+getExtensions = toList . extensionFlags . ms_hspp_opts . pm_mod_summary

ghcide/src/Development/IDE/Spans/Pragmas.hs

@@ -6,19 +6,24 @@ module Development.IDE.Spans.Pragmas
   ( NextPragmaInfo(..)
   , LineSplitTextEdits(..)
   , getNextPragmaInfo
-  , insertNewPragma ) where
+  , insertNewPragma
+  , getFirstPragma ) where
 
 import           Data.Bits                       (Bits (setBit))
 import           Data.Function                   ((&))
 import qualified Data.List                       as List
 import qualified Data.Maybe                      as Maybe
 import           Data.Text                       (Text, pack)
 import qualified Data.Text                       as Text
-import           Development.IDE                 (srcSpanToRange)
+import           Development.IDE                 (srcSpanToRange, IdeState, NormalizedFilePath, runAction, useWithStale, GhcSession (..), getFileContents, hscEnv)
 import           Development.IDE.GHC.Compat
 import           Development.IDE.GHC.Compat.Util
-import           GHC.LanguageExtensions.Type     (Extension)
 import qualified Language.LSP.Types              as LSP
+import Control.Monad.IO.Class (MonadIO (..))
+import Control.Monad.Trans.Except (ExceptT)
+import Ide.Types (PluginId(..))
+import qualified Data.Text as T
+import Ide.PluginUtils (handleMaybeM)
 
 getNextPragmaInfo :: DynFlags -> Maybe Text -> NextPragmaInfo
 getNextPragmaInfo dynFlags sourceText =
@@ -31,13 +36,29 @@ getNextPragmaInfo dynFlags sourceText =
      | otherwise
      -> NextPragmaInfo 0 Nothing
 
+-- NOTE(ozkutuk): `RecordPuns` extension is renamed to `NamedFieldPuns`
+-- in GHC 9.4, but we still want to insert `NamedFieldPuns` in pre-9.4
+-- GHC as well, hence the replacement.
+-- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/6156
+showExtension :: Extension -> Text
+showExtension NamedFieldPuns = "NamedFieldPuns"
+showExtension ext = pack (show ext)
+
 insertNewPragma :: NextPragmaInfo -> Extension -> LSP.TextEdit
-insertNewPragma (NextPragmaInfo _ (Just (LineSplitTextEdits ins _))) newPragma = ins { LSP._newText = "{-# LANGUAGE " <> pack (show newPragma) <> " #-}\n" } :: LSP.TextEdit
-insertNewPragma (NextPragmaInfo nextPragmaLine _) newPragma =  LSP.TextEdit pragmaInsertRange $ "{-# LANGUAGE " <> pack (show newPragma) <> " #-}\n"
+insertNewPragma (NextPragmaInfo _ (Just (LineSplitTextEdits ins _))) newPragma = ins { LSP._newText = "{-# LANGUAGE " <> showExtension newPragma <> " #-}\n" } :: LSP.TextEdit
+insertNewPragma (NextPragmaInfo nextPragmaLine _) newPragma =  LSP.TextEdit pragmaInsertRange $ "{-# LANGUAGE " <> showExtension newPragma <> " #-}\n"
     where
         pragmaInsertPosition = LSP.Position (fromIntegral nextPragmaLine) 0
         pragmaInsertRange = LSP.Range pragmaInsertPosition pragmaInsertPosition
 
+getFirstPragma :: MonadIO m => PluginId -> IdeState -> NormalizedFilePath -> ExceptT String m NextPragmaInfo
+getFirstPragma (PluginId pId) state nfp = handleMaybeM "Could not get NextPragmaInfo" $ do
+  ghcSession <- liftIO $ runAction (T.unpack pId <> ".GhcSession") state $ useWithStale GhcSession nfp
+  (_, fileContents) <- liftIO $ runAction (T.unpack pId <> ".GetFileContents") state $ getFileContents nfp
+  case ghcSession of
+    Just (hscEnv -> hsc_dflags -> sessionDynFlags, _) -> pure $ Just $ getNextPragmaInfo sessionDynFlags fileContents
+    Nothing                                           -> pure Nothing
+
 -- Pre-declaration comments parser -----------------------------------------------------
 
 -- | Each mode represents the "strongest" thing we've seen so far.

haskell-language-server.cabal

@@ -163,6 +163,11 @@ flag explicitFixity
   default:     True
   manual:      True
 
+flag explicitFields
+  description: Enable explicitFields plugin
+  default:     True
+  manual:      True
+
 -- formatters
 
 flag floskell
@@ -300,6 +305,11 @@ common explicitFixity
     build-depends: hls-explicit-fixity-plugin ^>= 1.0
     cpp-options: -DexplicitFixity
 
+common explicitFields
+  if flag(explicitFields)
+    build-depends: hls-explicit-record-fields-plugin ^>= 1.0
+    cpp-options: -DexplicitFields
+
 -- formatters
 
 common floskell
@@ -358,6 +368,7 @@ library
                   , codeRange
                   , gadt
                   , explicitFixity
+                  , explicitFields
                   , floskell
                   , fourmolu
                   , ormolu