hls-explicit-record-fields-plugin 2.1.0.0 → 2.2.0.0

raw patch · 7 files changed

+277/−149 lines, 7 filesdep +aesondep +ghcdep ~ghcidedep ~hls-plugin-apiPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, ghc

Dependency ranges changed: ghcide, hls-plugin-api

API changes (from Hackage documentation)

Files

• hls-explicit-record-fields-plugin.cabal +14/−3
• src/Ide/Plugin/ExplicitFields.hs +163/−139
• test/Main.hs +12/−7
• test/testdata/HsExpanded1.expected.hs +19/−0
• test/testdata/HsExpanded1.hs +19/−0
• test/testdata/HsExpanded2.expected.hs +25/−0
• test/testdata/HsExpanded2.hs +25/−0

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               hls-explicit-record-fields-plugin-version:            2.1.0.0+version:            2.2.0.0 synopsis:           Explicit record fields plugin for Haskell Language Server description:   Please see the README on GitHub at <https://github.com/haskell/haskell-language-server#readme>@@ -19,6 +19,11 @@   type:     git   location: https://github.com/haskell/haskell-language-server +flag pedantic+  description: Enable -Werror+  default:     False+  manual:      True+ common warnings     ghc-options: -Wall @@ -29,8 +34,9 @@     -- other-extensions:     build-depends:       , base                  >=4.12 && <5-      , ghcide                == 2.1.0.0-      , hls-plugin-api        == 2.1.0.0+      , ghc+      , ghcide                == 2.2.0.0+      , hls-plugin-api        == 2.2.0.0       , lsp       , lens       , hls-graph@@ -40,9 +46,14 @@       , ghc-boot-th       , unordered-containers       , containers+      , aeson     hs-source-dirs:   src     default-language: Haskell2010 +  if flag(pedantic)+    ghc-options: -Werror+                 -Wwarn=incomplete-record-updates+     test-suite tests     import:           warnings     default-language: Haskell2010

@@ -1,38 +1,43 @@-{-# LANGUAGE DataKinds             #-}-{-# LANGUAGE DeriveGeneric         #-}-{-# LANGUAGE DerivingStrategies    #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleContexts      #-}-{-# LANGUAGE LambdaCase            #-}-{-# LANGUAGE OverloadedStrings     #-}-{-# LANGUAGE PatternSynonyms       #-}-{-# LANGUAGE TypeFamilies          #-}-{-# LANGUAGE TypeOperators         #-}-{-# LANGUAGE ViewPatterns          #-}+{-# LANGUAGE CPP                       #-}+{-# LANGUAGE DataKinds                 #-}+{-# LANGUAGE DeriveGeneric             #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE LambdaCase                #-}+{-# LANGUAGE NamedFieldPuns            #-}+{-# LANGUAGE OverloadedStrings         #-}+{-# LANGUAGE PatternSynonyms           #-}+{-# LANGUAGE TypeFamilies              #-}+{-# LANGUAGE TypeOperators             #-}+{-# LANGUAGE ViewPatterns              #-}  module Ide.Plugin.ExplicitFields   ( descriptor   , Log   ) where -import           Control.Lens                     ((^.))-import           Control.Monad.IO.Class           (MonadIO, liftIO)-import           Control.Monad.Trans.Except       (ExceptT, runExceptT)-import           Data.Functor                     ((<&>))-import           Data.Generics                    (GenericQ, everything, extQ,-                                                   mkQ)+import           Control.Lens                     ((&), (?~), (^.))+import           Control.Monad.IO.Class           (MonadIO (liftIO))+import           Control.Monad.Trans.Maybe+import           Data.Aeson                       (toJSON)+import           Data.Generics                    (GenericQ, everything,+                                                   everythingBut, extQ, mkQ)+import qualified Data.IntMap.Strict               as IntMap import qualified Data.Map                         as Map import           Data.Maybe                       (fromMaybe, isJust,-                                                   listToMaybe, maybeToList)+                                                   maybeToList) import           Data.Text                        (Text)-import           Development.IDE                  (IdeState, NormalizedFilePath,-                                                   Pretty (..), Recorder (..),-                                                   Rules, WithPriority (..),-                                                   realSrcSpanToRange)+import           Data.Unique                      (hashUnique, newUnique)++import           Control.Monad                    (replicateM)+import           Development.IDE                  (IdeState, Pretty (..), Range,+                                                   Recorder (..), Rules,+                                                   WithPriority (..),+                                                   defineNoDiagnostics,+                                                   realSrcSpanToRange, viaShow) import           Development.IDE.Core.PluginUtils import           Development.IDE.Core.RuleTypes   (TcModuleResult (..),                                                    TypeCheck (..))-import           Development.IDE.Core.Shake       (define, use) import qualified Development.IDE.Core.Shake       as Shake import           Development.IDE.GHC.Compat       (HsConDetails (RecCon),                                                    HsRecFields (..), LPat,@@ -49,134 +54,147 @@                                                    hs_valds, lookupUFM,                                                    mapConPatDetail, mapLoc,                                                    pattern RealSrcSpan,-                                                   plusUFM_C, ufmToIntMap,-                                                   unitUFM)+                                                   plusUFM_C, unitUFM) import           Development.IDE.GHC.Util         (getExtensions,                                                    printOutputable) import           Development.IDE.Graph            (RuleResult)-import           Development.IDE.Graph.Classes    (Hashable, NFData (rnf))+import           Development.IDE.Graph.Classes    (Hashable, NFData) import           Development.IDE.Spans.Pragmas    (NextPragmaInfo (..),                                                    getFirstPragma,                                                    insertNewPragma) import           GHC.Generics                     (Generic) import           Ide.Logger                       (Priority (..), cmapWithPrio,                                                    logWith, (<+>))-import           Ide.Plugin.Error                 (PluginError,-                                                   getNormalizedFilePathE)+import           Ide.Plugin.Error                 (PluginError (PluginInternalError, PluginStaleResolve),+                                                   getNormalizedFilePathE,+                                                   handleMaybe) import           Ide.Plugin.RangeMap              (RangeMap) import qualified Ide.Plugin.RangeMap              as RangeMap+import           Ide.Plugin.Resolve               (mkCodeActionWithResolveAndCommand) import           Ide.Types                        (PluginDescriptor (..),                                                    PluginId (..),                                                    PluginMethodHandler,-                                                   defaultPluginDescriptor,-                                                   mkPluginHandler)+                                                   ResolveFunction,+                                                   defaultPluginDescriptor) import qualified Language.LSP.Protocol.Lens       as L-import           Language.LSP.Protocol.Message    (Method (..), SMethod (..))+import           Language.LSP.Protocol.Message    (Method (..)) import           Language.LSP.Protocol.Types      (CodeAction (..),                                                    CodeActionKind (CodeActionKind_RefactorRewrite),                                                    CodeActionParams (..),                                                    Command, TextEdit (..),                                                    WorkspaceEdit (WorkspaceEdit),-                                                   fromNormalizedUri,-                                                   normalizedFilePathToUri,                                                    type (|?) (InL, InR)) +#if MIN_VERSION_ghc(9,0,0)+import           Development.IDE.GHC.Compat       (HsExpansion (HsExpanded),+                                                   HsExpr (XExpr))+#endif  data Log   = LogShake Shake.Log   | LogCollectedRecords [RecordInfo]-  | LogRenderedRecords [RenderedRecordInfo]+  | LogRenderedRecords [TextEdit]+  | forall a. (Pretty a) => LogResolve a + instance Pretty Log where   pretty = \case     LogShake shakeLog -> pretty shakeLog     LogCollectedRecords recs -> "Collected records with wildcards:" <+> pretty recs-    LogRenderedRecords recs -> "Rendered records:" <+> pretty recs+    LogRenderedRecords recs -> "Rendered records:" <+> viaShow recs+    LogResolve msg -> pretty msg  descriptor :: Recorder (WithPriority Log) -> PluginId -> PluginDescriptor IdeState-descriptor recorder plId = (defaultPluginDescriptor plId)-  { pluginHandlers = mkPluginHandler SMethod_TextDocumentCodeAction codeActionProvider+descriptor recorder plId =+  let resolveRecorder = cmapWithPrio LogResolve recorder+      (carCommands, caHandlers) = mkCodeActionWithResolveAndCommand resolveRecorder plId codeActionProvider codeActionResolveProvider+  in (defaultPluginDescriptor plId)+  { pluginHandlers = caHandlers+  , pluginCommands = carCommands   , pluginRules = collectRecordsRule recorder *> collectNamesRule   }  codeActionProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction-codeActionProvider ideState pId (CodeActionParams _ _ docId range _) = do+codeActionProvider ideState _ (CodeActionParams _ _ docId range _) = do   nfp <- getNormalizedFilePathE (docId ^. L.uri)-  pragma <- getFirstPragma pId ideState nfp-  CRR recMap exts <- collectRecords' ideState nfp-  let actions = map (mkCodeAction nfp exts pragma) (RangeMap.filterByRange range recMap)+  CRR {crCodeActions, enabledExtensions} <- runActionE "ExplicitFields.CollectRecords" ideState $ useE CollectRecords nfp+  -- All we need to build a code action is the list of extensions, and a int to+  -- allow us to resolve it later.+  let actions = map (mkCodeAction enabledExtensions) (RangeMap.filterByRange range crCodeActions)   pure $ InL actions-   where-    mkCodeAction :: NormalizedFilePath -> [Extension] -> NextPragmaInfo -> RenderedRecordInfo -> Command |? CodeAction-    mkCodeAction nfp exts pragma rec = InR CodeAction-      { _title = mkCodeActionTitle exts+    mkCodeAction ::  [Extension] ->  Int -> Command |? CodeAction+    mkCodeAction  exts uid = InR CodeAction+      { _title = "Expand record wildcard"+                  <> if NamedFieldPuns `elem` exts+                    then mempty+                    else " (needs extension: NamedFieldPuns)"       , _kind = Just CodeActionKind_RefactorRewrite       , _diagnostics = Nothing       , _isPreferred = Nothing       , _disabled = Nothing-      , _edit = Just $ mkWorkspaceEdit nfp edits+      , _edit = Nothing       , _command = Nothing-      , _data_ = Nothing+      , _data_ = Just $ toJSON uid       }-      where-        edits = mkTextEdit rec : maybeToList pragmaEdit -        mkTextEdit :: RenderedRecordInfo -> TextEdit-        mkTextEdit (RenderedRecordInfo ss r) = TextEdit (realSrcSpanToRange ss) r--        pragmaEdit :: Maybe TextEdit-        pragmaEdit = if NamedFieldPuns `elem` exts-                       then Nothing-                       else Just $ insertNewPragma pragma NamedFieldPuns--    mkWorkspaceEdit :: NormalizedFilePath -> [TextEdit] -> WorkspaceEdit-    mkWorkspaceEdit nfp edits = WorkspaceEdit changes Nothing Nothing-      where-        changes = Just $ Map.singleton (fromNormalizedUri (normalizedFilePathToUri nfp)) edits--    mkCodeActionTitle :: [Extension] -> Text-    mkCodeActionTitle exts =-      if NamedFieldPuns `elem` exts-        then title-        else title <> " (needs extension: NamedFieldPuns)"-        where-          title = "Expand record wildcard"+codeActionResolveProvider :: ResolveFunction IdeState Int 'Method_CodeActionResolve+codeActionResolveProvider ideState pId ca uri uid = do+  nfp <- getNormalizedFilePathE uri+  pragma <- getFirstPragma pId ideState nfp+  CRR {crCodeActionResolve, nameMap, enabledExtensions} <- runActionE "ExplicitFields.CollectRecords" ideState $ useE CollectRecords nfp+  -- If we are unable to find the unique id in our IntMap of records, it means+  -- that this resolve is stale.+  record <- handleMaybe PluginStaleResolve $ IntMap.lookup uid crCodeActionResolve+  -- We should never fail to render+  rendered <- handleMaybe (PluginInternalError "Failed to render") $ renderRecordInfo nameMap record+  let edits = [rendered]+              <> maybeToList (pragmaEdit enabledExtensions pragma)+  pure $ ca & L.edit ?~ mkWorkspaceEdit edits+  where+    mkWorkspaceEdit ::[TextEdit] -> WorkspaceEdit+    mkWorkspaceEdit edits = WorkspaceEdit (Just $ Map.singleton uri edits) Nothing Nothing+    pragmaEdit :: [Extension] -> NextPragmaInfo -> Maybe TextEdit+    pragmaEdit exts pragma = if NamedFieldPuns `elem` exts+                      then Nothing+                      else Just $ insertNewPragma pragma NamedFieldPuns  collectRecordsRule :: Recorder (WithPriority Log) -> Rules ()-collectRecordsRule recorder = define (cmapWithPrio LogShake recorder) $ \CollectRecords nfp ->-  use TypeCheck nfp >>= \case-    Nothing -> pure ([], Nothing)-    Just tmr -> do-      let exts = getEnabledExtensions tmr-          recs = getRecords tmr-      logWith recorder Debug (LogCollectedRecords recs)-      use CollectNames nfp >>= \case-        Nothing -> pure ([], Nothing)-        Just (CNR names) -> do-          let renderedRecs = traverse (renderRecordInfo names) recs-              recMap = RangeMap.fromList (realSrcSpanToRange . renderedSrcSpan) <$> renderedRecs-          logWith recorder Debug (LogRenderedRecords (concat renderedRecs))-          pure ([], CRR <$> recMap <*> Just exts)-+collectRecordsRule recorder =+  defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \CollectRecords nfp -> runMaybeT $ do+  tmr <- useMT TypeCheck nfp+  (CNR nameMap) <- useMT CollectNames nfp+  let recs = getRecords tmr+  logWith recorder Debug (LogCollectedRecords recs)+  -- We want a list of unique numbers to link our the original code action we+  -- give out, with the actual record info that we resolve it to.+  uniques <- liftIO $ replicateM (length recs) (hashUnique <$> newUnique)+  let recsWithUniques = zip uniques recs+      -- For creating the code actions, a RangeMap of unique ids+      crCodeActions = RangeMap.fromList' (toRangeAndUnique <$> recsWithUniques)+      -- For resolving the code actions, a IntMap which links the unique id to+      -- the relevant record info.+      crCodeActionResolve = IntMap.fromList recsWithUniques+      enabledExtensions = getEnabledExtensions tmr+  pure CRR {crCodeActions, crCodeActionResolve, nameMap, enabledExtensions}   where     getEnabledExtensions :: TcModuleResult -> [Extension]     getEnabledExtensions =  getExtensions . tmrParsed+    toRangeAndUnique (uid, recordInfo) = (recordInfoToRange recordInfo, uid)  getRecords :: TcModuleResult -> [RecordInfo] getRecords (tmrRenamed -> (hs_valds -> valBinds,_,_,_)) =   collectRecords valBinds  collectNamesRule :: Rules ()-collectNamesRule = define mempty $ \CollectNames nfp ->-  use TypeCheck nfp <&> \case-    Nothing  -> ([], Nothing)-    Just tmr -> ([], Just (CNR (getNames tmr)))+collectNamesRule = defineNoDiagnostics mempty $ \CollectNames nfp -> runMaybeT $ do+  tmr <- useMT TypeCheck nfp+  pure (CNR (getNames tmr))  -- | Collects all 'Name's of a given source file, to be used -- in the variable usage analysis.-getNames :: TcModuleResult -> NameMap-getNames (tmrRenamed -> (group,_,_,_)) = NameMap (collectNames group)+getNames :: TcModuleResult -> UniqFM Name [Name]+getNames (tmrRenamed -> (group,_,_,_)) = collectNames group  data CollectRecords = CollectRecords                     deriving (Eq, Show, Generic)@@ -184,13 +202,26 @@ instance Hashable CollectRecords instance NFData CollectRecords +-- |The result of our map, this record includes everything we need to provide+-- code actions and resolve them later data CollectRecordsResult = CRR-  { recordInfos       :: RangeMap RenderedRecordInfo-  , enabledExtensions :: [Extension]+  { -- |For providing the code action we need the unique id (Int) in a RangeMap+    crCodeActions       :: RangeMap Int+    -- |For resolving the code action we need to link the unique id we+    -- previously gave out with the record info that we use to make the edit+    -- with.+  , crCodeActionResolve :: IntMap.IntMap RecordInfo+    -- |The name map allows us to prune unused record fields (some of the time)+  , nameMap             :: UniqFM Name [Name]+    -- |We need to make sure NamedFieldPuns is enabled, if it's not we need to+    -- add that to the text edit. (In addition we use it in creating the code+    -- action title)+  , enabledExtensions   :: [Extension]   }   deriving (Generic)  instance NFData CollectRecordsResult+instance NFData RecordInfo  instance Show CollectRecordsResult where   show _ = "<CollectRecordsResult>"@@ -203,7 +234,7 @@ instance Hashable CollectNames instance NFData CollectNames -data CollectNamesResult = CNR NameMap+data CollectNamesResult = CNR (UniqFM Name [Name])   deriving (Generic)  instance NFData CollectNamesResult@@ -213,55 +244,42 @@  type instance RuleResult CollectNames = CollectNamesResult --- As with `GhcExtension`, this newtype exists mostly to attach--- an `NFData` instance to `UniqFM`.(without resorting to creating an orphan instance).-newtype NameMap = NameMap (UniqFM Name [Name])--instance NFData NameMap where-  rnf (NameMap (ufmToIntMap -> m)) = rnf m- data RecordInfo   = RecordInfoPat RealSrcSpan (Pat (GhcPass 'Renamed))   | RecordInfoCon RealSrcSpan (HsExpr (GhcPass 'Renamed))+  deriving (Generic)  instance Pretty RecordInfo where   pretty (RecordInfoPat ss p) = pretty (printOutputable ss) <> ":" <+> pretty (printOutputable p)   pretty (RecordInfoCon ss e) = pretty (printOutputable ss) <> ":" <+> pretty (printOutputable e) -data RenderedRecordInfo = RenderedRecordInfo-  { renderedSrcSpan :: RealSrcSpan-  , renderedRecord  :: Text-  }-  deriving (Generic)--instance Pretty RenderedRecordInfo where-  pretty (RenderedRecordInfo ss r) = pretty (printOutputable ss) <> ":" <+> pretty r--instance NFData RenderedRecordInfo+recordInfoToRange :: RecordInfo -> Range+recordInfoToRange (RecordInfoPat ss _) = realSrcSpanToRange ss+recordInfoToRange (RecordInfoCon ss _) = realSrcSpanToRange ss -renderRecordInfo :: NameMap -> RecordInfo -> Maybe RenderedRecordInfo-renderRecordInfo names (RecordInfoPat ss pat) = RenderedRecordInfo ss <$> showRecordPat names pat-renderRecordInfo _ (RecordInfoCon ss expr) = RenderedRecordInfo ss <$> showRecordCon expr+renderRecordInfo :: UniqFM Name [Name] -> RecordInfo -> Maybe TextEdit+renderRecordInfo names (RecordInfoPat ss pat) = TextEdit (realSrcSpanToRange ss) <$> showRecordPat names pat+renderRecordInfo _ (RecordInfoCon ss expr) = TextEdit (realSrcSpanToRange ss) <$> showRecordCon expr  -- | Checks if a 'Name' is referenced in the given map of names. The -- 'hasNonBindingOcc' check is necessary in order to make sure that only the -- references at the use-sites are considered (i.e. the binding occurence -- is excluded). For more information regarding the structure of the map, -- refer to the documentation of 'collectNames'.-referencedIn :: Name -> NameMap -> Bool-referencedIn name (NameMap names) = maybe True hasNonBindingOcc $ lookupUFM names name+referencedIn :: Name -> UniqFM Name [Name] -> Bool+referencedIn name names = maybe True hasNonBindingOcc $ lookupUFM names name   where     hasNonBindingOcc :: [Name] -> Bool     hasNonBindingOcc = (> 1) . length  -- Default to leaving the element in if somehow a name can't be extracted (i.e. -- `getName` returns `Nothing`).-filterReferenced :: (a -> Maybe Name) -> NameMap -> [a] -> [a]+filterReferenced :: (a -> Maybe Name) -> UniqFM Name [Name] -> [a] -> [a] filterReferenced getName names = filter (\x -> maybe True (`referencedIn` names) (getName x))  preprocessRecordPat   :: p ~ GhcPass 'Renamed-  => NameMap+  => UniqFM Name [Name]   -> HsRecFields p (LPat p)   -> HsRecFields p (LPat p) preprocessRecordPat = preprocessRecord (getFieldName . unLoc)@@ -272,7 +290,7 @@  -- No need to check the name usage in the record construction case preprocessRecordCon :: HsRecFields (GhcPass c) arg -> HsRecFields (GhcPass c) arg-preprocessRecordCon = preprocessRecord (const Nothing) (NameMap emptyUFM)+preprocessRecordCon = preprocessRecord (const Nothing) emptyUFM  -- This function does two things: -- 1) Tweak the AST type so that the pretty-printed record is in the@@ -293,7 +311,7 @@ preprocessRecord   :: p ~ GhcPass c   => (LocatedA (HsRecField p arg) -> Maybe Name)-  -> NameMap+  -> UniqFM Name [Name]   -> HsRecFields p arg   -> HsRecFields p arg preprocessRecord getName names flds = flds { rec_dotdot = Nothing , rec_flds = rec_flds' }@@ -311,7 +329,7 @@     punsUsed = filterReferenced getName names puns'     rec_flds' = no_puns <> punsUsed -showRecordPat :: Outputable (Pat (GhcPass 'Renamed)) => NameMap -> Pat (GhcPass 'Renamed) -> Maybe Text+showRecordPat :: Outputable (Pat (GhcPass 'Renamed)) => UniqFM Name [Name] -> Pat (GhcPass 'Renamed) -> Maybe Text showRecordPat names = fmap printOutputable . mapConPatDetail (\case   RecCon flds -> Just $ RecCon (preprocessRecordPat names flds)   _           -> Nothing)@@ -323,42 +341,48 @@ showRecordCon _ = Nothing  collectRecords :: GenericQ [RecordInfo]-collectRecords = everything (<>) (maybeToList . (Nothing `mkQ` getRecPatterns `extQ` getRecCons))+collectRecords = everythingBut (<>) (([], False) `mkQ` getRecPatterns `extQ` getRecCons)  -- | Collect 'Name's into a map, indexed by the names' unique identifiers. -- The 'Eq' instance of 'Name's makes use of their unique identifiers, hence -- any 'Name' referring to the same entity is considered equal. In effect,--- each individual list of names contains the binding occurence, along with--- all the occurences at the use-sites (if there are any).+-- each individual list of names contains the binding occurrence, along with+-- all the occurrences at the use-sites (if there are any). -- -- @UniqFM Name [Name]@ is morally the same as @Map Unique [Name]@. -- Using 'UniqFM' gains us a bit of performance (in theory) since it--- internally uses 'IntMap', and saves us rolling our own newtype wrapper over--- 'Unique' (since 'Unique' doesn't have an 'Ord' instance, it can't be used--- as 'Map' key as is). More information regarding 'UniqFM' can be found in+-- internally uses 'IntMap'. More information regarding 'UniqFM' can be found in -- the GHC source. collectNames :: GenericQ (UniqFM Name [Name]) collectNames = everything (plusUFM_C (<>)) (emptyUFM `mkQ` (\x -> unitUFM x [x])) -getRecCons :: LHsExpr (GhcPass 'Renamed) -> Maybe RecordInfo+getRecCons :: LHsExpr (GhcPass 'Renamed) -> ([RecordInfo], Bool)+-- When we stumble upon an occurrence of HsExpanded, we only want to follow a+-- single branch. We do this here, by explicitly returning occurrences from+-- traversing the original branch, and returning True, which keeps syb from+-- implicitly continuing to traverse. In addition, we have to return a list,+-- because there is a possibility that there were be more than one result per+-- branch++#if MIN_VERSION_ghc(9,0,0)+getRecCons (unLoc -> XExpr (HsExpanded a _)) = (collectRecords a, True)+#endif+ getRecCons e@(unLoc -> RecordCon _ _ flds)-  | isJust (rec_dotdot flds) = mkRecInfo e+  | isJust (rec_dotdot flds) = (mkRecInfo e, False)   where-    mkRecInfo :: LHsExpr (GhcPass 'Renamed) -> Maybe RecordInfo-    mkRecInfo expr = listToMaybe+    mkRecInfo :: LHsExpr (GhcPass 'Renamed) -> [RecordInfo]+    mkRecInfo expr =       [ RecordInfoCon realSpan' (unLoc expr) | RealSrcSpan realSpan' _ <- [ getLoc expr ]]-getRecCons _ = Nothing+getRecCons _ = ([], False) -getRecPatterns :: LPat (GhcPass 'Renamed) -> Maybe RecordInfo+getRecPatterns :: LPat (GhcPass 'Renamed) -> ([RecordInfo], Bool) getRecPatterns conPat@(conPatDetails . unLoc -> Just (RecCon flds))-  | isJust (rec_dotdot flds) = mkRecInfo conPat+  | isJust (rec_dotdot flds) = (mkRecInfo conPat, False)   where-    mkRecInfo :: LPat (GhcPass 'Renamed) -> Maybe RecordInfo-    mkRecInfo pat = listToMaybe+    mkRecInfo :: LPat (GhcPass 'Renamed) -> [RecordInfo]+    mkRecInfo pat =       [ RecordInfoPat realSpan' (unLoc pat) | RealSrcSpan realSpan' _ <- [ getLoc pat ]]-getRecPatterns _ = Nothing+getRecPatterns _ = ([], False) -collectRecords' :: MonadIO m => IdeState -> NormalizedFilePath -> ExceptT PluginError m CollectRecordsResult-collectRecords' ideState = runActionE "ExplicitFields" ideState-    . useE CollectRecords 

@@ -11,7 +11,6 @@ import           System.FilePath           ((<.>), (</>)) import           Test.Hls - main :: IO () main = defaultTestRunner test @@ -27,6 +26,8 @@   , mkTest "WithExplicitBind" "WithExplicitBind" 12 10 12 32   , mkTest "Mixed" "Mixed" 14 10 14 37   , mkTest "Construction" "Construction" 16 5 16 15+  , mkTest "HsExpanded1" "HsExpanded1" 17 10 17 20+  , mkTest "HsExpanded2" "HsExpanded2" 23 10 23 22   , mkTestNoAction "ExplicitBinds" "ExplicitBinds" 11 10 11 52   , mkTestNoAction "Puns" "Puns" 12 10 12 31   , mkTestNoAction "Infix" "Infix" 11 11 11 31@@ -36,23 +37,27 @@ mkTestNoAction :: TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree mkTestNoAction title fp x1 y1 x2 y2 =   testCase title $-    runSessionWithServer plugin (testDataDir </> "noop") $ do+    runSessionWithServer def plugin (testDataDir </> "noop") $ do       doc <- openDoc (fp <.> "hs") "haskell"       actions <- getExplicitFieldsActions doc x1 y1 x2 y2       liftIO $ actions @?= [] -mkTest :: TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree-mkTest title fp x1 y1 x2 y2 =-  goldenWithHaskellDoc plugin title testDataDir fp "expected" "hs" $ \doc -> do-    (act:_) <- getExplicitFieldsActions doc x1 y1 x2 y2+mkTestWithCount :: Int -> TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree+mkTestWithCount cnt title fp x1 y1 x2 y2 =+  goldenWithHaskellAndCaps def codeActionResolveCaps plugin title testDataDir fp "expected" "hs" $ \doc -> do+    acts@(act:_) <- getExplicitFieldsActions doc x1 y1 x2 y2+    liftIO $ length acts @?= cnt     executeCodeAction act +mkTest :: TestName -> FilePath -> UInt -> UInt -> UInt -> UInt -> TestTree+mkTest = mkTestWithCount 1+ getExplicitFieldsActions   :: TextDocumentIdentifier   -> UInt -> UInt -> UInt -> UInt   -> Session [CodeAction] getExplicitFieldsActions doc x1 y1 x2 y2 =-  findExplicitFieldsAction <$> getCodeActions doc range+  findExplicitFieldsAction <$> getAndResolveCodeActions doc range   where     range = Range (Position x1 y1) (Position x2 y2) 

@@ -0,0 +1,19 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE NamedFieldPuns #-}++module HsExpanded1 where+import Prelude++ifThenElse :: Int -> Int -> Int ->  Int+ifThenElse x y z = x + y + z++data MyRec = MyRec+  { foo :: Int }++myRecExample = MyRec 5++convertMe :: Int+convertMe =+  if (let MyRec {foo} = myRecExample+      in foo) then 1 else 2

@@ -0,0 +1,19 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE NamedFieldPuns #-}++module HsExpanded1 where+import Prelude++ifThenElse :: Int -> Int -> Int ->  Int+ifThenElse x y z = x + y + z++data MyRec = MyRec+  { foo :: Int }++myRecExample = MyRec 5++convertMe :: Int+convertMe =+  if (let MyRec {..} = myRecExample+      in foo) then 1 else 2

@@ -0,0 +1,25 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE NamedFieldPuns #-}++module HsExpanded2 where+import Prelude++ifThenElse :: Int -> Int -> Int ->  Int+ifThenElse x y z = x + y + z++data MyRec = MyRec+  { foo :: Int }++data YourRec = YourRec+  { bar :: Int }++myRecExample = MyRec 5++yourRecExample = YourRec 3++convertMe :: Int+convertMe =+  if (let MyRec {..} = myRecExample+          YourRec {bar} = yourRecExample+      in bar) then 1 else 2

@@ -0,0 +1,25 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RebindableSyntax #-}+{-# LANGUAGE NamedFieldPuns #-}++module HsExpanded2 where+import Prelude++ifThenElse :: Int -> Int -> Int ->  Int+ifThenElse x y z = x + y + z++data MyRec = MyRec+  { foo :: Int }++data YourRec = YourRec+  { bar :: Int }++myRecExample = MyRec 5++yourRecExample = YourRec 3++convertMe :: Int+convertMe =+  if (let MyRec {..} = myRecExample+          YourRec {..} = yourRecExample+      in bar) then 1 else 2