Add sig lens for where clauses

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

@@ -315,7 +315,9 @@ module Development.IDE.GHC.Compat.Core (
     gre_par,
 #if MIN_VERSION_ghc(9,2,0)
     collectHsBindsBinders,
+    NHsValBindsLR(..),
 #endif
+    grhssLocalBindsCompat,
     -- * Util Module re-exports
 #if MIN_VERSION_ghc(9,0,0)
     module GHC.Builtin.Names,
@@ -482,6 +484,7 @@ import           GHC.Types.Unique.FM
 #if MIN_VERSION_ghc(9,2,0)
 import           GHC.Data.Bag
 import           GHC.Core.Multiplicity        (scaledThing)
+import           GHC.Hs.Binds                 (NHsValBindsLR(..))
 #else
 import           GHC.Core.Ppr.TyThing         hiding (pprFamInst)
 import           GHC.Core.TyCo.Rep            (scaledThing)
@@ -1084,3 +1087,10 @@ pattern LetStmt xlet localBinds <- GHC.LetStmt xlet (SrcLoc.unLoc -> localBinds)
 rationalFromFractionalLit :: FractionalLit -> Rational
 rationalFromFractionalLit = fl_value
 #endif
+
+grhssLocalBindsCompat :: GRHSs p body -> HsLocalBinds p
+#if MIN_VERSION_ghc(9,2,0)
+grhssLocalBindsCompat = grhssLocalBinds
+#else
+grhssLocalBindsCompat = SrcLoc.unLoc . grhssLocalBinds
+#endif

ghcide/test/data/local-sig-lens/Infix.expected.hs

@@ -0,0 +1,7 @@
+module Infix where
+
+f :: a
+f = undefined
+    where
+        g :: p1 -> p -> p1
+        a `g` b = a

ghcide/test/data/local-sig-lens/Infix.hs

@@ -0,0 +1,6 @@
+module Infix where
+
+f :: a
+f = undefined
+    where
+        a `g` b = a

ghcide/test/data/local-sig-lens/Inline.expected.hs

@@ -0,0 +1,6 @@
+module Inline where
+
+f :: a
+f = undefined
+    where g :: Bool
+          g = True

ghcide/test/data/local-sig-lens/Inline.hs

@@ -0,0 +1,5 @@
+module Inline where
+
+f :: a
+f = undefined
+    where g = True

ghcide/test/data/local-sig-lens/Nest.expected.hs

@@ -0,0 +1,10 @@
+module Nest where
+
+f :: Int
+f = g
+    where
+        g :: Int
+        g = h
+        h :: Int
+        h = k where k :: Int
+                    k = 3

ghcide/test/data/local-sig-lens/Nest.hs

@@ -0,0 +1,7 @@
+module Nest where
+
+f :: Int
+f = g
+    where
+        g = h
+        h = k where k = 3

ghcide/test/data/local-sig-lens/NoLens.expected.hs

@@ -0,0 +1,13 @@
+module NoLens where
+
+f :: a
+f = undefined
+    where
+        g = 3
+
+
+
+
+
+
+        g :: Int

ghcide/test/data/local-sig-lens/NoLens.hs

@@ -0,0 +1,13 @@
+module NoLens where
+
+f :: a
+f = undefined
+    where
+        g = 3
+
+
+
+
+
+
+        g :: Int

ghcide/test/data/local-sig-lens/Operator.expected.hs

@@ -0,0 +1,7 @@
+module Operator where
+
+f :: a
+f = undefined
+    where
+        g :: (a -> b) -> a -> b
+        g = ($)

ghcide/test/data/local-sig-lens/Operator.hs

@@ -0,0 +1,6 @@
+module Operator where
+
+f :: a
+f = undefined
+    where
+        g = ($)

ghcide/test/data/local-sig-lens/Qualified.expected.hs

@@ -0,0 +1,9 @@
+module Qualified where
+
+import qualified Data.Map as Map
+
+f :: a
+f = undefined
+    where
+         g :: Map.Map Bool Char
+         g = Map.singleton True 'c'

ghcide/test/data/local-sig-lens/Qualified.hs

@@ -0,0 +1,8 @@
+module Qualified where
+
+import qualified Data.Map as Map
+
+f :: a
+f = undefined
+    where
+         g = Map.singleton True 'c'

ghcide/test/data/local-sig-lens/ScopedTypeVariables.expected.hs

@@ -0,0 +1,8 @@
+{-# LANGUAGE ExplicitForAll #-}
+module ScopedTypeVariables where
+
+f :: forall a b. a -> b -> (a, b)
+f aa bb = (aa, ida bb)
+    where
+        ida :: b -> b
+        ida = id

ghcide/test/data/local-sig-lens/ScopedTypeVariables.hs

@@ -0,0 +1,7 @@
+{-# LANGUAGE ExplicitForAll #-}
+module ScopedTypeVariables where
+
+f :: forall a b. a -> b -> (a, b)
+f aa bb = (aa, ida bb)
+    where
+        ida = id

ghcide/test/data/local-sig-lens/Simple.expected.hs

@@ -0,0 +1,7 @@
+module Simple where
+
+f :: a
+f = undefined
+    where
+        g :: Bool
+        g = True

ghcide/test/data/local-sig-lens/Simple.hs

@@ -0,0 +1,6 @@
+module Simple where
+
+f :: a
+f = undefined
+    where
+        g = True

ghcide/test/data/local-sig-lens/Tuple.expected.hs

@@ -0,0 +1,8 @@
+module Typle where
+
+f :: a
+f = undefined
+    where
+        g :: Integer
+        h :: Bool
+        (g, h) = (1, True)

ghcide/test/data/local-sig-lens/Tuple.hs

@@ -0,0 +1,6 @@
+module Typle where
+
+f :: a
+f = undefined
+    where
+        (g, h) = (1, True)

ghcide/test/data/local-sig-lens/Typeclass.expected.hs

@@ -0,0 +1,7 @@
+module Typeclass where
+
+f :: a
+f = undefined
+    where
+        g :: Num a => a -> a -> a
+        g a b = a + b

ghcide/test/data/local-sig-lens/Typeclass.hs

@@ -0,0 +1,6 @@
+module Typeclass where
+
+f :: a
+f = undefined
+    where
+        g a b = a + b

ghcide/test/exe/Main.hs

@@ -848,6 +848,7 @@ codeActionHelperFunctionTests = testGroup "code action helpers"
 codeLensesTests :: TestTree
 codeLensesTests = testGroup "code lenses"
   [ addSigLensesTests
+  , addSigLensesForWhereClausesTests
   ]
 
 watchedFilesTests :: TestTree
@@ -4230,6 +4231,61 @@ addSigLensesTests =
             ]
         ]
 
+addSigLensesForWhereClausesTests :: TestTree
+addSigLensesForWhereClausesTests = testGroup
+  "add signature for where clauses"
+  [ testSession "No lens if disbled" $ do
+      let content = T.unlines
+            [ "module Sigs where"
+            , "f :: b"
+            , "f = undefined"
+            , "  where"
+            , "    g = True"
+            ]
+      sendNotification SWorkspaceDidChangeConfiguration
+        $ DidChangeConfigurationParams
+        $ A.object
+            ["haskell" A..= A.object
+                ["plugin" A..= A.object
+                    ["ghcide-type-lenses" A..= A.object
+                        ["config" A..= A.object
+                            ["whereLensOn" A..= A.Bool False]]]]]
+      doc <- createDoc "Sigs.hs" "haskell" content
+      waitForProgressDone
+      lenses <- getCodeLenses doc
+      liftIO $ length lenses @?= 0
+  , test "Simple" "Simple"
+  , test "Tuple" "Tuple"
+  , test "Inline" "Inline"
+  , test "Infix" "Infix"
+  , test "Operator" "Operator"
+  , expectFail $ test "ScopedTypeVariables" "ScopedTypeVariables"
+  , test "Nest" "Nest"
+  , test "No lens" "NoLens"
+  , expectFail $ test "Typeclass" "Typeclass"
+  , test "Quqlified" "Qualified"
+  ]
+  where
+    test :: String -> FilePath -> TestTree
+    test title file = testSessionWithExtraFiles "local-sig-lens" title $ \dir -> do
+        doc <- openDoc (dir </> file ++ ".hs") "haskell"
+        executeAllLens doc
+        real <- documentContents doc
+        expectedDoc <- openDoc (dir </> file ++ ".expected.hs") "haskell"
+        expected <- documentContents expectedDoc
+        liftIO $ real @?= expected
+
+    executeAllLens :: TextDocumentIdentifier -> Session ()
+    executeAllLens doc = do
+        void $ waitForTypecheck doc
+        lenses <- getCodeLenses doc
+        let cmds = mapMaybe (^. L.command) lenses
+        unless (null cmds) $ do
+            let cmd = head cmds
+            executeCommand cmd
+            void $ skipManyTill anyMessage (getDocumentEdit doc)
+            executeAllLens doc
+
 linkToLocation :: [LocationLink] -> [Location]
 linkToLocation = map (\LocationLink{_targetUri,_targetRange} -> Location _targetUri _targetRange)