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 · Mar 28, 2024 · 463025b · 463025b
1 parent 7a87841
commit 463025b
Show file tree

Hide file tree

Showing 401 changed files with 1,890 additions and 1,942 deletions.
diff --git a/lsp-test/bench/SimpleBench.hs b/lsp-test/bench/SimpleBench.hs
@@ -62,10 +62,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 #-}
 
@@ -13,11 +15,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 Data.Set qualified as Set
-import Language.LSP.Protocol.Lens qualified as L
-import Language.LSP.Protocol.Message
+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
@@ -85,33 +89,33 @@ 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
         putMVar 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)
 
         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)
 
         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)
 
         -- 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
@@ -142,19 +146,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
@@ -186,15 +190,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
@@ -213,7 +217,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
                 updater $ ProgressAmount (Just 25) (Just "step1")
                 updater $ ProgressAmount (Just 50) (Just "step2")
                 updater $ ProgressAmount (Just 75) (Just "step3")
@@ -224,30 +228,30 @@ 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
 
         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)
 
         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)
 
         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)
 
         -- 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.0.0
 synopsis:           Functional test framework for LSP servers.
@@ -58,11 +58,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.3
     , lens-aeson          ^>=1.2
     , lsp                 ^>=2.4
-    , lsp-types           ^>=2.1
+    , lsp-types
+    , lsp-types:lsp-types-lens
     , mtl                 >=2.2   && <2.4
     , parser-combinators  ^>=1.3
     , process             ^>=1.6
@@ -104,6 +106,7 @@ test-suite tests
     , directory
     , extra
     , filepath
+    , generic-lens
     , hspec
     , lens
     , lsp
@@ -124,10 +127,12 @@ test-suite func-test
     , aeson
     , co-log-core
     , containers
+    , generic-lens
     , hspec
     , lens
     , lsp
     , lsp-test
+    , lsp-types:lsp-types-lens
     , parser-combinators
     , process
     , unliftio