Switch to normal field selectors and generic-lens

This adopts the approach discussed here: #465 (comment) That is: - We export normal, non-prefixed record selectors (still using `DuplicateRecordFields`, of course). - Users who want lenses can use `generic-lens`; `lsp` and `lsp-test` do this. - It's sensible for `lsp-types` to define some useful lenses that aren't derived from fields; these go in a `lsp-types-lens` component. I think the result is... fine? kcsongor/generic-lens#96 is a pain in some cases, but by and large using the generic lenses is quite nice. I also tried to just use `OverloadedRecordDot` instead of lenses where I could, since we now support 9.2 as our earliest version. I couldn't quite get rid of `lens` in `lsp`, it's too useful. I did get rid of it entirely in `lsp-types`, which was quite painful in at least one place. This would obviously be a huge breaking change, but I think it's the right direction.
haskell · Dec 24, 2024 · d98af68 · d98af68
1 parent f1c17c3
commit d98af68
Show file tree

Hide file tree

Showing 402 changed files with 2,000 additions and 2,031 deletions.
diff --git a/.gitignore b/.gitignore
@@ -21,3 +21,4 @@ hie
 hie.yaml
 .envrc
 **/.golden/*/actual
+.jj
diff --git a/lsp-test/bench/SimpleBench.hs b/lsp-test/bench/SimpleBench.hs
@@ -61,10 +61,10 @@ main = do
     replicateM_ n $ do
       v <- liftIO $ readIORef i
       liftIO $ when (v `mod` 1000 == 0) $ putStrLn $ show v
-      TResponseMessage{_result = Right (InL _)} <-
+      TResponseMessage{result = Right (InL _)} <-
         Test.request SMethod_TextDocumentHover $
           HoverParams (TextDocumentIdentifier $ Uri "test") (Position 1 100) Nothing
-      TResponseMessage{_result = Right (InL _)} <-
+      TResponseMessage{result = Right (InL _)} <-
         Test.request SMethod_TextDocumentDefinition $
           DefinitionParams (TextDocumentIdentifier $ Uri "test") (Position 1000 100) Nothing Nothing
 

diff --git a/lsp-test/func-test/FuncTest.hs b/lsp-test/func-test/FuncTest.hs
@@ -1,5 +1,7 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -14,10 +16,13 @@ import Control.Lens hiding (Iso, List)
 import Control.Monad
 import Control.Monad.IO.Class
 import Data.Aeson qualified as J
+import Data.Generics.Labels ()
+import Data.Generics.Product.Fields (field')
 import Data.Maybe
 import Data.Proxy
-import Language.LSP.Protocol.Lens qualified as L
-import Language.LSP.Protocol.Message
+import Data.Set qualified as Set
+import Language.LSP.Protocol.Lens
+import Language.LSP.Protocol.Message hiding (error)
 import Language.LSP.Protocol.Types
 import Language.LSP.Server
 import Language.LSP.Test qualified as Test
@@ -90,36 +95,36 @@ spec = do
         -- has happened and the server has been able to send us a begin message
         skipManyTill Test.anyMessage $ do
           x <- Test.message SMethod_Progress
-          guard $ has (L.params . L.value . _workDoneProgressBegin) x
+          guard $ has (field' @"params" . #value . workDoneProgressBegin) x
 
         -- allow the hander to send us updates
         liftIO $ signalBarrier startBarrier ()
 
         do
           u <- Test.message SMethod_Progress
           liftIO $ do
-            u ^? L.params . L.value . _workDoneProgressReport . L.message `shouldBe` Just (Just "step1")
-            u ^? L.params . L.value . _workDoneProgressReport . L.percentage `shouldBe` Just (Just 25)
+            u ^? field' @"params" . #value . workDoneProgressReport . #message `shouldBe` Just (Just "step1")
+            u ^? field' @"params" . #value . workDoneProgressReport . #percentage `shouldBe` Just (Just 25)
         liftIO $ signalBarrier b1 ()
 
         do
           u <- Test.message SMethod_Progress
           liftIO $ do
-            u ^? L.params . L.value . _workDoneProgressReport . L.message `shouldBe` Just (Just "step2")
-            u ^? L.params . L.value . _workDoneProgressReport . L.percentage `shouldBe` Just (Just 50)
+            u ^? field' @"params" . #value . workDoneProgressReport . #message `shouldBe` Just (Just "step2")
+            u ^? field' @"params" . #value . workDoneProgressReport . #percentage `shouldBe` Just (Just 50)
         liftIO $ signalBarrier b2 ()
 
         do
           u <- Test.message SMethod_Progress
           liftIO $ do
-            u ^? L.params . L.value . _workDoneProgressReport . L.message `shouldBe` Just (Just "step3")
-            u ^? L.params . L.value . _workDoneProgressReport . L.percentage `shouldBe` Just (Just 75)
+            u ^? field' @"params" . #value . workDoneProgressReport . #message `shouldBe` Just (Just "step3")
+            u ^? field' @"params" . #value . workDoneProgressReport . #percentage `shouldBe` Just (Just 75)
         liftIO $ signalBarrier b3 ()
 
         -- Then make sure we get a $/progress end notification
         skipManyTill Test.anyMessage $ do
           x <- Test.message SMethod_Progress
-          guard $ has (L.params . L.value . _workDoneProgressEnd) x
+          guard $ has (field' @"params" . #value . workDoneProgressEnd) x
 
     it "handles cancellation" $ do
       wasCancelled <- newMVar False
@@ -150,19 +155,19 @@ spec = do
         -- Wait until we have created the progress so the updates will be sent individually
         token <- skipManyTill Test.anyMessage $ do
           x <- Test.message SMethod_WindowWorkDoneProgressCreate
-          pure $ x ^. L.params . L.token
+          pure $ x ^. field' @"params" . #token
 
         -- First make sure that we get a $/progress begin notification
         skipManyTill Test.anyMessage $ do
           x <- Test.message SMethod_Progress
-          guard $ has (L.params . L.value . _workDoneProgressBegin) x
+          guard $ has (field' @"params" . #value . workDoneProgressBegin) x
 
         Test.sendNotification SMethod_WindowWorkDoneProgressCancel (WorkDoneProgressCancelParams token)
 
         -- Then make sure we still get a $/progress end notification
         skipManyTill Test.anyMessage $ do
           x <- Test.message SMethod_Progress
-          guard $ has (L.params . L.value . _workDoneProgressEnd) x
+          guard $ has (field' @"params" . #value . workDoneProgressEnd) x
 
       c <- readMVar wasCancelled
       c `shouldBe` True
@@ -194,15 +199,15 @@ spec = do
         -- First make sure that we get a $/progress begin notification
         skipManyTill Test.anyMessage $ do
           x <- Test.message SMethod_Progress
-          guard $ has (L.params . L.value . _workDoneProgressBegin) x
+          guard $ has (field' @"params" . #value . workDoneProgressBegin) x
 
         -- Then kill the thread
         liftIO $ putMVar killVar ()
 
         -- Then make sure we still get a $/progress end notification
         skipManyTill Test.anyMessage $ do
           x <- Test.message SMethod_Progress
-          guard $ has (L.params . L.value . _workDoneProgressEnd) x
+          guard $ has (field' @"params" . #value . workDoneProgressEnd) x
 
   describe "client-initiated progress reporting" $ do
     it "sends updates" $ do
@@ -226,7 +231,7 @@ spec = do
           handlers :: Handlers (LspM ())
           handlers =
             requestHandler SMethod_TextDocumentCodeLens $ \req resp -> void $ forkIO $ do
-              withProgress "Doing something" (req ^. L.params . L.workDoneToken) NotCancellable $ \updater -> do
+              withProgress "Doing something" (req ^. field' @"params" . #workDoneToken) NotCancellable $ \updater -> do
                 liftIO $ waitBarrier startBarrier
                 updater $ ProgressAmount (Just 25) (Just "step1")
                 liftIO $ waitBarrier b1
@@ -241,35 +246,35 @@ spec = do
         -- First make sure that we get a $/progress begin notification
         skipManyTill Test.anyMessage $ do
           x <- Test.message SMethod_Progress
-          guard $ has (L.params . L.value . _workDoneProgressBegin) x
+          guard $ has (field' @"params" . #value . workDoneProgressBegin) x
 
         liftIO $ signalBarrier startBarrier ()
 
         do
           u <- Test.message SMethod_Progress
           liftIO $ do
-            u ^? L.params . L.value . _workDoneProgressReport . L.message `shouldBe` Just (Just "step1")
-            u ^? L.params . L.value . _workDoneProgressReport . L.percentage `shouldBe` Just (Just 25)
+            u ^? field' @"params" . #value . workDoneProgressReport . #message `shouldBe` Just (Just "step1")
+            u ^? field' @"params" . #value . workDoneProgressReport . #percentage `shouldBe` Just (Just 25)
         liftIO $ signalBarrier b1 ()
 
         do
           u <- Test.message SMethod_Progress
           liftIO $ do
-            u ^? L.params . L.value . _workDoneProgressReport . L.message `shouldBe` Just (Just "step2")
-            u ^? L.params . L.value . _workDoneProgressReport . L.percentage `shouldBe` Just (Just 50)
+            u ^? field' @"params" . #value . workDoneProgressReport . #message `shouldBe` Just (Just "step2")
+            u ^? field' @"params" . #value . workDoneProgressReport . #percentage `shouldBe` Just (Just 50)
         liftIO $ signalBarrier b2 ()
 
         do
           u <- Test.message SMethod_Progress
           liftIO $ do
-            u ^? L.params . L.value . _workDoneProgressReport . L.message `shouldBe` Just (Just "step3")
-            u ^? L.params . L.value . _workDoneProgressReport . L.percentage `shouldBe` Just (Just 75)
+            u ^? field' @"params" . #value . workDoneProgressReport . #message `shouldBe` Just (Just "step3")
+            u ^? field' @"params" . #value . workDoneProgressReport . #percentage `shouldBe` Just (Just 75)
         liftIO $ signalBarrier b3 ()
 
         -- Then make sure we get a $/progress end notification
         skipManyTill Test.anyMessage $ do
           x <- Test.message SMethod_Progress
-          guard $ has (L.params . L.value . _workDoneProgressEnd) x
+          guard $ has (field' @"params" . #value . workDoneProgressEnd) x
 
   describe "workspace folders" $
     it "keeps track of open workspace folders" $ do

diff --git a/lsp-test/lsp-test.cabal b/lsp-test/lsp-test.cabal
@@ -1,4 +1,4 @@
-cabal-version:      2.4
+cabal-version:      3.0
 name:               lsp-test
 version:            0.17.1.0
 synopsis:           Functional test framework for LSP servers.
@@ -62,11 +62,13 @@ library
     , exceptions          ^>=0.10
     , extra               ^>=1.7
     , filepath            >=1.4 && < 1.6
+    , generic-lens        ^>=2.2
     , Glob                >=0.9   && <0.11
     , lens                >=5.1   && <5.4
     , lens-aeson          ^>=1.2
     , lsp                 ^>=2.7
     , lsp-types           ^>=2.3
+    , lsp-types:lsp-types-lens
     , mtl                 >=2.2   && <2.4
     , parser-combinators  ^>=1.3
     , process             ^>=1.6
@@ -108,6 +110,7 @@ test-suite tests
     , directory
     , extra
     , filepath
+    , generic-lens
     , hspec
     , lens
     , lsp
@@ -128,11 +131,14 @@ test-suite func-test
     , base
     , aeson
     , co-log-core
+    , containers
     , extra
+    , generic-lens
     , hspec
     , lens
     , lsp
     , lsp-test
+    , lsp-types:lsp-types-lens
     , parser-combinators
     , process
     , unliftio
-Original file line number
+Diff line change
@@ Expand Up / @@ -21,3 +21,4 @@ hie @@
     hie.yaml
     .envrc
     **/.golden/*/actual
+    .jj