Nested Positional Constructor + Tests

Author: vidit-od

plugins/hls-explicit-record-fields-plugin/src/Ide/Plugin/ExplicitFields.hs

@@ -101,6 +101,7 @@ import           Ide.Plugin.Error                     (PluginError (PluginIntern
 import           Ide.Plugin.RangeMap                  (RangeMap)
 import qualified Ide.Plugin.RangeMap                  as RangeMap
 import           Ide.Plugin.Resolve                   (mkCodeActionWithResolveAndCommand)
+import           Ide.PluginUtils                      (subRange)
 import           Ide.Types                            (PluginDescriptor (..),
                                                        PluginId (..),
                                                        PluginMethodHandler,
@@ -269,9 +270,12 @@ 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)) =
-       let textEdits = renderRecordInfoAsTextEdit nameMap record
-       in mapMaybe (mkInlayHint textEdits pm) fla
+     mkInlayHints nameMap pm record@(RecordInfoApp _ (RecordAppExpr sat _ fla)) =
+       -- Only create inlay hints for fully saturated constructors
+       case sat of
+         Saturated -> let textEdits = renderRecordInfoAsTextEdit nameMap record
+                      in mapMaybe (mkInlayHint textEdits pm) fla
+         Unsaturated -> []
      mkInlayHints _ _ _ = []
 
      mkInlayHint :: Maybe TextEdit -> PositionMapping -> (Located FieldLabel, HsExpr GhcTc) -> Maybe InlayHint
@@ -299,13 +303,10 @@ mkTitle exts = "Expand record wildcard"
                    then mempty
                    else " (needs extension: NamedFieldPuns)"
 
-containsRange :: Range -> Range -> Bool
-containsRange (Range s1 e1) (Range s2 e2) = s1 <= s2 && e2 <= e1 && (s1 /= s2 || e1 /= e2)
-
 recordDepth :: [(Int, RecordInfo)] -> RecordInfo -> Int
 recordDepth allRecords record =
   let r = recordInfoToRange record
-  in length [ ()| (_, other) <- allRecords, let r' = recordInfoToRange other, containsRange r' r]
+  in length [ ()| (_, other) <- allRecords, let r' = recordInfoToRange other, subRange r' r]
 
 pragmaEdit :: [Extension] -> NextPragmaInfo -> Maybe TextEdit
 pragmaEdit exts pragma = if NamedFieldPuns `elem` exts
@@ -612,7 +613,11 @@ getRecCons e@(unLoc -> RecordCon _ _ flds)
 getRecCons expr@(unLoc -> app@(HsApp _ _ _)) =
   let fieldss = maybeToList $ getFields app []
       recInfo = concatMap mkRecInfo fieldss
-  in (recInfo, not (null recInfo))
+  -- Search control for positional constructors.
+  -- True stops further (nested) searching; False allows recursive search.
+  -- Currently hardcoded to False to enable nested positional searches.
+  -- Use `in (recInfo, not (null recInfo))` to disable nested searching.
+  in (recInfo, False)
   where
     mkRecInfo :: RecordAppExpr -> [RecordInfo]
     mkRecInfo appExpr =

plugins/hls-explicit-record-fields-plugin/test/Main.hs

@@ -292,6 +292,89 @@ test = testGroup "explicit-fields"
                          , _paddingLeft = Nothing
                          }
           ]
+    , mkInlayHintsTest "CursorRecords" Nothing 9 $ \ih -> do
+        let mkLabelPart' = mkLabelPartOffsetLength "CursorRecords"
+        a0  <- mkLabelPart' 3 14 "a0"
+        a1  <- mkLabelPart' 4 14 "a1"
+        a11 <- mkLabelPart' 4 25 "a11"
+        a2  <- mkLabelPart' 5 14 "a2"
+        a3  <- mkLabelPart' 6 14 "a3"
+        (@?=) ih
+          [ defInlayHint
+              { _position = Position 9 52
+              , _label = InR [ a3 ]
+              , _textEdits = Just [ mkLineTextEdit "L1 {l2 = L2 {l3 = L3 {l4 = L4 {..}, ..}, ..}, a3}" 9 5 53 ]
+              , _tooltip = Just $ InL "Expand record wildcard"
+              , _paddingLeft = Just True
+              , _paddingRight = Nothing
+              , _data_ = Nothing
+              }
+          , defInlayHint
+              { _position = Position 9 47
+              , _label = InR [ a2 ]
+              , _textEdits = Just [ mkLineTextEdit "L2 {l3 = L3 {l4 = L4 {..}, ..}, a2}" 9 14 48 ]
+              , _tooltip = Just $ InL "Expand record wildcard"
+              , _paddingLeft = Just True
+              , _paddingRight = Nothing
+              , _data_ = Nothing
+              }
+          , defInlayHint
+              { _position = Position 9 42
+              , _label = InR [ a1 , InlayHintLabelPart ", " Nothing Nothing Nothing , a11 ]
+              , _textEdits = Just [ mkLineTextEdit "L3 {l4 = L4 {..}, a1, a11}" 9 23 43 ]
+              , _tooltip = Just $ InL "Expand record wildcard"
+              , _paddingLeft = Just True
+              , _paddingRight = Nothing
+              , _data_ = Nothing
+              }
+          , defInlayHint
+              { _position = Position 9 37
+              , _label = InR [ a0 ]
+              , _textEdits = Just [ mkLineTextEdit "L4 {a0}" 9 31 38 ]
+              , _tooltip = Just $ InL "Expand record wildcard"
+              , _paddingLeft = Just True
+              , _paddingRight = Nothing
+              , _data_ = Nothing
+              }
+          ]
+    , mkInlayHintsTest "CursorPositional" Nothing 15 $ \ih -> do
+        let mkLabelPart' = mkLabelPartOffsetLengthSub1 "CursorPositional"
+        middle <- mkLabelPart' 2 2 "middle="
+        inner  <- mkLabelPart' 6 2 "inner="
+        foo    <- mkLabelPart' 10 2 "foo="
+        bar    <- mkLabelPart' 11 4 "bar="
+        (@?=) ih
+          [ defInlayHint
+              { _position = Position 15 14
+              , _label = InR [ middle ]
+              , _textEdits = Just [ mkLineTextEdit "RecOuter { middle = (RecMiddle (RecInner 'c' 42)) }" 15 5 43 ]
+              , _tooltip = Just $ InL "Expand positional record"
+              , _paddingLeft = Nothing
+              }
+          , defInlayHint
+              { _position = Position 15 25
+              , _label = InR [ inner ]
+              , _textEdits = Just [ mkLineTextEdit "RecMiddle { inner = (RecInner 'c' 42) }" 15 15 42 ]
+              , _tooltip = Just $ InL "Expand positional record"
+              , _paddingLeft = Nothing
+              }
+          , defInlayHint
+              { _position = Position 15 35
+              , _label = InR [ foo ]
+              , _textEdits =
+                  Just [ mkLineTextEdit "RecInner { foo = 'c', bar = 42 }" 15 26 41 ]
+              , _tooltip = Just $ InL "Expand positional record"
+              , _paddingLeft = Nothing
+              }
+          , defInlayHint
+              { _position = Position 15 39
+              , _label = InR [ bar ]
+              , _textEdits =
+                  Just [ mkLineTextEdit "RecInner { foo = 'c', bar = 42 }" 15 26 41 ]
+              , _tooltip = Just $ InL "Expand positional record"
+              , _paddingLeft = Nothing
+              }
+          ]
     ]
   ]
 

plugins/hls-explicit-record-fields-plugin/test/testdata/CursorPositional.hs

@@ -0,0 +1,16 @@
+module CursorPositional where
+data RecOuter = RecOuter{
+  middle :: RecMiddle
+}
+
+data RecMiddle = RecMiddle {
+  inner :: RecInner
+}
+
+data RecInner = RecInner{
+  foo   :: Char
+  , bar :: Int
+}
+
+ex :: RecOuter
+ex = RecOuter (RecMiddle (RecInner 'c' 42))

plugins/hls-explicit-record-fields-plugin/test/testdata/CursorRecords.hs

@@ -0,0 +1,11 @@
+{-# LANGUAGE RecordWildCards #-}
+module CursorRecords where
+
+data L4 = L4{ a0 :: Int}
+data L3 = L3{ a1 :: Int, a11 :: Int, l4 :: L4}
+data L2 = L2{ a2 :: Int, l3 :: L3}
+data L1 = L1{ a3 :: Int, l2 :: L2}
+
+test :: L1 -> Int
+test L1 {l2 = L2{ l3 = L3{l4 = L4 {..}, ..}, ..}, ..} =
+    a0 + a1 + a2 + a3 + a11