Greg/wildcard hint

app/App/Arguments.hs

@@ -104,6 +104,7 @@ staticEnvOptParser =
       )
     <*> (flag' True (long "enableInlays" <> help "Explicitly enable inlay hints.") Options.Applicative.<|> flag False defaultStaticEnvOptions.provideInlays (long "disableInlays" <> help "Explicitly disable inlay hints."))
     <*> (maybe defaultStaticEnvOptions.inlayLengthCap id <$> Control.Applicative.optional readInlayLen)
+    <*> switch (long "experimentalFeatures" <> help "Enable experimental features.")
  where
   -- Parse a list of comma delimited strings
   listOption = option $ eitherReader (either (Left . show) Right . runParser (sepEndBy (many alphaNum) (char ',')) () "")

src/StaticLS/IDE/InlayHints.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE LambdaCase #-}
 
-{- HLINT ignore "Use camelCase" -}
+{- HLINT ignore "Use :" -}
 
 module StaticLS.IDE.InlayHints (
   getInlayHints,
@@ -9,13 +9,14 @@ module StaticLS.IDE.InlayHints (
 import Data.Path
 import StaticLS.IDE.InlayHints.TypeAnnotations qualified as TypeAnnotations
 import StaticLS.IDE.InlayHints.Types
+import StaticLS.IDE.InlayHints.Wildcard qualified as Wildcard
 import StaticLS.Monad
 import StaticLS.StaticEnv.Options
 
 getInlayHints :: AbsPath -> StaticEnvOptions -> StaticLsM [InlayHint]
-getInlayHints path options =
-  concat
-    <$> sequenceA
-      [ TypeAnnotations.getInlayHints path options.inlayLengthCap
-      -- , Wildcard.getInlayHints path
-      ]
+getInlayHints path options = concat <$> sequenceA hints
+ where
+  hints =
+    ( [TypeAnnotations.getInlayHints options path]
+        ++ [Wildcard.getInlayHints path | options.experimentalFeatures]
+    )

src/StaticLS/IDE/InlayHints/TypeAnnotations.hs

@@ -5,6 +5,7 @@ module StaticLS.IDE.InlayHints.TypeAnnotations (getInlayHints) where
 import AST.Cast
 import AST.Haskell.Generated qualified as Haskell
 import AST.Node
+import Control.Applicative as Applicative
 import Control.Monad
 import Control.Monad.Trans.Maybe
 import Data.LineCol
@@ -21,15 +22,25 @@ import StaticLS.IDE.InlayHints.Common
 import StaticLS.IDE.InlayHints.Types
 import StaticLS.IDE.Monad
 import StaticLS.Monad
+import StaticLS.StaticEnv.Options
 
-getInlayHints :: AbsPath -> Maybe Int -> StaticLsM [InlayHint]
-getInlayHints path maxLen = getTypedefInlays_ path maxLen
+getInlayHints :: StaticEnvOptions -> AbsPath -> StaticLsM [InlayHint]
+getInlayHints options absPath = do
+  hieView' <- runMaybeT $ getHieView absPath
+  case hieView' of
+    Nothing -> pure []
+    Just hieView -> do
+      let getTypes lineCol = do
+            let tys = HieView.Query.fileTysAtRangeList hieView (LineColRange.point lineCol)
+            fmap HieView.Type.printType tys
+      getTypedefInlays options absPath getTypes
 
-getTypedefInlays :: AbsPath -> (LineCol -> [Text]) -> Maybe Int -> StaticLsM [InlayHint]
-getTypedefInlays absPath getTypes maxLen = do
+getTypedefInlays :: StaticEnvOptions -> AbsPath -> (LineCol -> [Text]) -> StaticLsM [InlayHint]
+getTypedefInlays options absPath getTypes = do
   haskell <- getHaskell absPath
   rope <- getSourceRope absPath
-  let targetNodes = selectNodesToType (getDynNode haskell)
+  let maxLen = options.inlayLengthCap
+  let targetNodes = selectNodesToType options (getDynNode haskell)
   let ranges = nodeToRange <$> targetNodes
   let srcLineCols' = posToLineCol rope . (.start) <$> ranges
   hieLineCols' <- traverse (runMaybeT . lineColToHieLineCol absPath) srcLineCols'
@@ -45,17 +56,6 @@ fmtTypeStr text
   | text == "" = ""
   | otherwise = ":: " <> text
 
-getTypedefInlays_ :: AbsPath -> Maybe Int -> StaticLsM [InlayHint]
-getTypedefInlays_ absPath maxLen = do
-  hieView' <- runMaybeT $ getHieView absPath
-  case hieView' of
-    Nothing -> pure []
-    Just hieView -> do
-      let getTypes lineCol = do
-            let tys = HieView.Query.fileTysAtRangeList hieView (LineColRange.point lineCol)
-            fmap HieView.Type.printType tys
-      getTypedefInlays absPath getTypes maxLen
-
 nodeIsVarAtBinding :: ASTLoc -> Bool
 nodeIsVarAtBinding astLoc = isJust $ do
   let curNode = nodeAtLoc astLoc
@@ -75,11 +75,10 @@ nodeIsRecordVar astLoc = isJust $ do
   _ <- cast @Haskell.Variable curNode
   let name = curNode.nodeFieldName
   let isBound = maybe False (`elem` ["pattern", "element", "left_operand", "right_operand"]) name
-  let isPun = isNothing name
   fpParent <- findAncestor (isJust . cast @Haskell.FieldPattern . nodeAtLoc) astLoc
   let fpChildren = children fpParent
   case length fpChildren of
-    1 -> guard isPun
+    1 -> Applicative.empty
     _ -> guard isBound
 
 nodeIsUpdatedField :: ASTLoc -> Bool
@@ -106,10 +105,11 @@ isBind = isJust . cast @Haskell.Bind
 isLet :: DynNode -> Bool
 isLet = isJust . cast @Haskell.Let
 
-selectNodesToType :: DynNode -> [DynNode]
-selectNodesToType root = do
+selectNodesToType :: StaticEnvOptions -> DynNode -> [DynNode]
+selectNodesToType options root = do
   let leafNodes = leaves (rootToASTLoc root)
-  let selectedLeafNodes = filter (\x -> nodeIsVarAtBinding x || nodeIsRecordVar x || nodeIsUpdatedField x) leafNodes
+  let checks = [nodeIsVarAtBinding, nodeIsUpdatedField] <> [nodeIsRecordVar | options.experimentalFeatures]
+  let selectedLeafNodes = filter (or . sequenceA checks) leafNodes
   fmap nodeAtLoc selectedLeafNodes
 
 lastSafe :: [a] -> Maybe a

src/StaticLS/Server.hs

@@ -224,7 +224,7 @@ serverDef argOptions logger = do
                   -- , handleFormat
                   handleCompletionItemResolve
                 ]
-                  ++ if argOptions.provideInlays then [handleInlayHintRequest argOptions, handleResolveInlayHint] else []
+                  <> (Monad.guard argOptions.provideInlays *> [handleInlayHintRequest argOptions, handleResolveInlayHint])
               )
       , interpretHandler = \env -> Iso (LSP.runLspT env) liftIO
       , options = lspOptions

src/StaticLS/StaticEnv/Options.hs

@@ -20,6 +20,8 @@ data StaticEnvOptions = StaticEnvOptions
   , optionSrcDirs :: [FilePath]
   , provideInlays :: Bool
   , inlayLengthCap :: Maybe Int
+  , -- Include experimental features?
+    experimentalFeatures :: Bool
   }
   deriving (Show, Eq)
 
@@ -44,4 +46,5 @@ defaultStaticEnvOptions =
     , optionHiFilesPath = defaultHiFiles
     , provideInlays = True
     , inlayLengthCap = Just 32
+    , experimentalFeatures = False
     }

test/StaticLS/HIE/FileSpec.hs

@@ -60,6 +60,7 @@ spec = do
             , optionHiFilesPath = ""
             , provideInlays = True
             , inlayLengthCap = Just 32
+            , experimentalFeatures = False
             }
 
     check

test/StaticLS/IDE/DefinitionSpec.hs

@@ -47,6 +47,7 @@ spec = do
           , optionHiFilesPath = "test/TestData/.hifiles"
           , provideInlays = True
           , inlayLengthCap = Just 32
+          , experimentalFeatures = False
           }
         Test.myFunRef1TdiAndPosition
         (pure @[] <$> Test.myFunDefLocation)
@@ -60,6 +61,7 @@ spec = do
           , optionHiFilesPath = ""
           , provideInlays = True
           , inlayLengthCap = Just 32
+          , experimentalFeatures = False
           }
         Test.myFunRef1TdiAndPosition
         (pure [])

test/TestImport.hs

@@ -56,6 +56,7 @@ defaultTestStaticEnvOptions =
     , optionHiFilesPath = testHiDir
     , provideInlays = True
     , inlayLengthCap = Just 32
+    , experimentalFeatures = False
     }
 
 initStaticEnvOpts :: StaticEnvOptions -> IO StaticEnv