Skip to content

Only expand positional records if the DataCon application is fully saturated #4586

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Only expand positional records if the DataCon application is fully saturated #4586

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
845af5e
Add issue reproducer as test
ozkutuk May 10, 2025
5cd6aea
Generate the CA only for fully saturated DataCon applications
ozkutuk May 10, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
43 changes: 35 additions & 8 deletions plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -151,10 +151,17 @@ descriptor recorder plId =
codeActionProvider :: PluginMethodHandler IdeState 'Method_TextDocumentCodeAction
codeActionProvider ideState _ (CodeActionParams _ _ docId range _) = do
nfp <- getNormalizedFilePathE (docId ^. L.uri)
CRR {crCodeActions, enabledExtensions} <- runActionE "ExplicitFields.CollectRecords" ideState $ useE CollectRecords nfp
CRR {crCodeActions, crCodeActionResolve, 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)
let recordUids = [ uid
| uid <- RangeMap.filterByRange range crCodeActions
, Just record <- [IntMap.lookup uid crCodeActionResolve]
-- Only fully saturated constructor applications can be
-- converted to the record syntax through the code action
, isConvertible record
]
let actions = map (mkCodeAction enabledExtensions) recordUids
pure $ InL actions
where
mkCodeAction :: [Extension] -> Int -> Command |? CodeAction
Expand All @@ -169,6 +176,11 @@ codeActionProvider ideState _ (CodeActionParams _ _ docId range _) = do
, _data_ = Just $ toJSON uid
}

isConvertible :: RecordInfo -> Bool
isConvertible = \case
RecordInfoApp _ (RecordAppExpr Unsaturated _ _) -> False
_ -> True
Comment on lines +181 to +182
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Since it is only two cases, maybe we should be exhaustive?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Maybe I misunderstood you, but I can't see how it is only two cases. This is what I come up with if I try to make this fully exhaustive:

    isConvertible :: RecordInfo -> Bool
    isConvertible = \case
      RecordInfoApp _ (RecordAppExpr Unsaturated _ _) -> False
      RecordInfoApp _ (RecordAppExpr Saturated _ _) -> True
      RecordInfoPat {} -> True
      RecordInfoCon {} -> True

I personally find this a bit too verbose, but if that's the style the codebase favors, I would be happy to change.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

It is just my preference, but since you are maintaining the plugin right now, your opinion matters more than mine in style preferences.

Also, thought it would be two, not 4, so yeah, that's more verbose than anticipated.


codeActionResolveProvider :: ResolveFunction IdeState Int 'Method_CodeActionResolve
codeActionResolveProvider ideState pId ca uri uid = do
nfp <- getNormalizedFilePathE uri
Expand Down Expand Up @@ -253,7 +265,7 @@ inlayHintPosRecProvider _ state _pId InlayHintParams {_textDocument = TextDocume
pure $ InL (concatMap (mkInlayHints nameMap pm) records)
where
mkInlayHints :: UniqFM Name [Name] -> PositionMapping -> RecordInfo -> [InlayHint]
mkInlayHints nameMap pm record@(RecordInfoApp _ (RecordAppExpr _ fla)) =
mkInlayHints nameMap pm record@(RecordInfoApp _ (RecordAppExpr _ _ fla)) =
let textEdits = renderRecordInfoAsTextEdit nameMap record
in mapMaybe (mkInlayHint textEdits pm) fla
mkInlayHints _ _ _ = []
Expand Down Expand Up @@ -379,7 +391,16 @@ instance Show CollectNamesResult where

type instance RuleResult CollectNames = CollectNamesResult

data RecordAppExpr = RecordAppExpr (LHsExpr GhcTc) [(Located FieldLabel, HsExpr GhcTc)]
data Saturated = Saturated | Unsaturated
deriving (Generic)

instance NFData Saturated

data RecordAppExpr
= RecordAppExpr
Saturated -- ^ Is the DataCon application fully saturated or partially applied?
(LHsExpr GhcTc)
[(Located FieldLabel, HsExpr GhcTc)]
deriving (Generic)

data RecordInfo
Expand All @@ -391,7 +412,7 @@ data RecordInfo
instance Pretty RecordInfo where
pretty (RecordInfoPat ss p) = pretty (printOutputable ss) <> ":" <+> pretty (printOutputable p)
pretty (RecordInfoCon ss e) = pretty (printOutputable ss) <> ":" <+> pretty (printOutputable e)
pretty (RecordInfoApp ss (RecordAppExpr _ fla))
pretty (RecordInfoApp ss (RecordAppExpr _ _ fla))
= pretty (printOutputable ss) <> ":" <+> hsep (map (pretty . printOutputable) fla)

recordInfoToRange :: RecordInfo -> Range
Expand Down Expand Up @@ -536,7 +557,7 @@ showRecordConFlds (RecordCon _ _ flds) =
showRecordConFlds _ = Nothing

showRecordApp :: RecordAppExpr -> Maybe Text
showRecordApp (RecordAppExpr recConstr fla)
showRecordApp (RecordAppExpr _ recConstr fla)
= Just $ printOutputable recConstr <> " { "
<> T.intercalate ", " (showFieldWithArg <$> fla)
<> " }"
Expand Down Expand Up @@ -588,8 +609,14 @@ getRecCons expr@(unLoc -> app@(HsApp _ _ _)) =

getFields :: HsExpr GhcTc -> [LHsExpr GhcTc] -> Maybe RecordAppExpr
getFields (HsApp _ constr@(unLoc -> expr) arg) args
| not (null fls)
= Just (RecordAppExpr constr labelWithArgs)
| not (null fls) = Just $
-- Code action is only valid if the constructor application is fully
-- saturated, but we still want to display the inlay hints for partially
-- applied constructors
RecordAppExpr
(if length fls <= length args + 1 then Saturated else Unsaturated)
constr
labelWithArgs
where fls = getExprFields expr
labelWithArgs = zipWith mkLabelWithArg fls (arg : args)
mkLabelWithArg label arg = (L (getLoc arg) label, unLoc arg)
Expand Down
1 change: 1 addition & 0 deletions plugins/hls-explicit-record-fields-plugin/test/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,7 @@ test = testGroup "explicit-fields"
, mkTestNoAction "Puns" "Puns" 12 10 12 31
, mkTestNoAction "Infix" "Infix" 11 11 11 31
, mkTestNoAction "Prefix" "Prefix" 10 11 10 28
, mkTestNoAction "PartiallyAppliedCon" "PartiallyAppliedCon" 7 8 7 12
, mkTest "PolymorphicRecordConstruction" "PolymorphicRecordConstruction" 15 5 15 15
]
, testGroup "inlay hints"
Expand Down
8 changes: 8 additions & 0 deletions plugins/hls-explicit-record-fields-plugin/test/testdata/noop/PartiallyAppliedCon.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
{-# LANGUAGE Haskell2010 #-}

module PartiallyAppliedCon where

data T = MkT { fa :: Int, fb :: Char }

foo :: Int -> Char -> T
foo x = MkT x
Loading