Separate lens module from the general type file

Author: joyfulmantis

lsp-test/bench/SimpleBench.hs

@@ -6,7 +6,7 @@ module Main where
 
 import Language.LSP.Server
 import qualified Language.LSP.Test as Test
-import Language.LSP.Protocol.Types hiding (options, range, start, end)
+import Language.LSP.Protocol.Types
 import Language.LSP.Protocol.Message
 import Control.Monad.IO.Class
 import Control.Monad

lsp-test/func-test/FuncTest.hs

@@ -4,7 +4,8 @@ module Main where
 
 import Language.LSP.Server
 import qualified Language.LSP.Test as Test
-import Language.LSP.Protocol.Types hiding (options, error)
+import Language.LSP.Protocol.Types hiding (error)
+import Language.LSP.Protocol.Types.Lens hiding (options)
 import Language.LSP.Protocol.Message hiding (options, error)
 import Control.Monad.IO.Class
 import System.IO

lsp-test/lsp-test.cabal

@@ -105,6 +105,7 @@ test-suite tests
     , lsp           ^>=2.0
     , lsp-test
     , mtl           <2.4
+    , parser-combinators
     , process
     , text
     , unliftio
@@ -122,6 +123,7 @@ test-suite func-test
     , lens
     , lsp
     , lsp-test
+    , parser-combinators
     , process
     , unliftio
 

lsp-test/src/Language/LSP/Test.hs

@@ -118,9 +118,8 @@ import Data.Default
 import Data.List
 import Data.Maybe
 import Language.LSP.Protocol.Types
-  hiding (capabilities, message, executeCommand, applyEdit, rename, to, id)
-import Language.LSP.Protocol.Message
-import qualified Language.LSP.Protocol.Types as LSP
+import Language.LSP.Protocol.Message hiding (id)
+import qualified Language.LSP.Protocol.Types.Lens as J
 import qualified Language.LSP.Protocol.Message as LSP
 import qualified Language.LSP.Protocol.Capabilities as C
 import Language.LSP.VFS
@@ -293,7 +292,7 @@ envOverrideConfig cfg = do
 documentContents :: TextDocumentIdentifier -> Session T.Text
 documentContents doc = do
   vfs <- vfs <$> get
-  let Just file = vfs ^. vfsMap . at (toNormalizedUri (doc ^. uri))
+  let Just file = vfs ^. vfsMap . at (toNormalizedUri (doc ^. J.uri))
   return (virtualFileText file)
 
 -- | Parses an ApplyEditRequest, checks that it is for the passed document
@@ -308,14 +307,14 @@ getDocumentEdit doc = do
   documentContents doc
   where
     checkDocumentChanges req =
-      let changes = req ^. params . edit . documentChanges
+      let changes = req ^. params . J.edit . J.documentChanges
           maybeDocs = fmap (fmap documentChangeUri) changes
       in case maybeDocs of
-        Just docs -> (doc ^. uri) `elem` docs
+        Just docs -> (doc ^. J.uri) `elem` docs
         Nothing -> False
     checkChanges req =
-      let mMap = req ^. params . edit . changes
-        in maybe False (Map.member (doc ^. uri)) mMap
+      let mMap = req ^. params . J.edit . J.changes
+        in maybe False (Map.member (doc ^. J.uri)) mMap
 
 -- | Sends a request to the server and waits for its response.
 -- Will skip any messages in between the request and the response
@@ -434,10 +433,10 @@ createDoc file languageId contents = do
       createHits _ = False
 
       regHits :: TRegistration Method_WorkspaceDidChangeWatchedFiles -> Bool
-      regHits reg = foldl' (\acc w -> acc || watchHits w) False (reg ^. registerOptions . _Just . watchers)
+      regHits reg = foldl' (\acc w -> acc || watchHits w) False (reg ^. registerOptions . _Just . J.watchers)
 
       clientCapsSupports =
-          caps ^? workspace . _Just . didChangeWatchedFiles . _Just . dynamicRegistration . _Just
+          caps ^? J.workspace . _Just . J.didChangeWatchedFiles . _Just . J.dynamicRegistration . _Just
             == Just True
       shouldSend = clientCapsSupports && foldl' (\acc r -> acc || regHits r) False regs
 
@@ -469,14 +468,14 @@ openDoc' file languageId contents = do
 -- | Closes a text document and sends a textDocument/didOpen notification to the server.
 closeDoc :: TextDocumentIdentifier -> Session ()
 closeDoc docId = do
-  let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. uri))
+  let params = DidCloseTextDocumentParams (TextDocumentIdentifier (docId ^. J.uri))
   sendNotification SMethod_TextDocumentDidClose params
 
 -- | Changes a text document and sends a textDocument/didOpen notification to the server.
 changeDoc :: TextDocumentIdentifier -> [TextDocumentContentChangeEvent] -> Session ()
 changeDoc docId changes = do
   verDoc <- getVersionedDoc docId
-  let params = DidChangeTextDocumentParams (verDoc & version +~ 1) changes
+  let params = DidChangeTextDocumentParams (verDoc & J.version +~ 1) changes
   sendNotification SMethod_TextDocumentDidChange params
 
 -- | Gets the Uri for the file corrected to the session directory.
@@ -490,7 +489,7 @@ getDocUri file = do
 waitForDiagnostics :: Session [Diagnostic]
 waitForDiagnostics = do
   diagsNot <- skipManyTill anyMessage (message SMethod_TextDocumentPublishDiagnostics)
-  let diags = diagsNot ^. params . LSP.diagnostics
+  let diags = diagsNot ^. params . J.diagnostics
   return diags
 
 -- | The same as 'waitForDiagnostics', but will only match a specific
@@ -504,15 +503,15 @@ waitForDiagnosticsSource src = do
     else return res
   where
     matches :: Diagnostic -> Bool
-    matches d = d ^. source == Just (T.pack src)
+    matches d = d ^. J.source == Just (T.pack src)
 
 -- | Expects a 'PublishDiagnosticsNotification' and throws an
 -- 'UnexpectedDiagnostics' exception if there are any diagnostics
 -- returned.
 noDiagnostics :: Session ()
 noDiagnostics = do
   diagsNot <- message SMethod_TextDocumentPublishDiagnostics
-  when (diagsNot ^. params . LSP.diagnostics /= []) $ liftIO $ throw UnexpectedDiagnostics
+  when (diagsNot ^. params . J.diagnostics /= []) $ liftIO $ throw UnexpectedDiagnostics
 
 -- | Returns the symbols in a document.
 getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [SymbolInformation] [DocumentSymbol])
@@ -533,7 +532,7 @@ getCodeActions doc range = do
   case rsp ^. result of
     Right (InL xs) -> return xs
     Right (InR _) -> return []
-    Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) error)
+    Left error -> throw (UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. J.id) error)
 
 -- | Returns all the code actions in a document by
 -- querying the code actions at each of the current
@@ -547,7 +546,7 @@ getAllCodeActions doc = do
   where
     go :: CodeActionContext -> [Command |? CodeAction] -> Diagnostic -> Session [Command |? CodeAction]
     go ctx acc diag = do
-      TResponseMessage _ rspLid res <- request SMethod_TextDocumentCodeAction (CodeActionParams Nothing Nothing doc (diag ^. range) ctx)
+      TResponseMessage _ rspLid res <- request SMethod_TextDocumentCodeAction (CodeActionParams Nothing Nothing doc (diag ^. J.range) ctx)
 
       case res of
         Left e -> throw (UnexpectedResponseError (SomeLspId $ fromJust rspLid) e)
@@ -582,7 +581,7 @@ getCodeActionContext doc = do
 -- | Returns the current diagnostics that have been sent to the client.
 -- Note that this does not wait for more to come in.
 getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic]
-getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. uri) . curDiagnostics <$> get
+getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. J.uri) . curDiagnostics <$> get
 
 -- | Returns the tokens of all progress sessions that have started but not yet ended.
 getIncompleteProgressSessions :: Session (Set.Set ProgressToken)
@@ -591,8 +590,8 @@ getIncompleteProgressSessions = curProgressSessions <$> get
 -- | Executes a command.
 executeCommand :: Command -> Session ()
 executeCommand cmd = do
-  let args = decode $ encode $ fromJust $ cmd ^. arguments
-      execParams = ExecuteCommandParams Nothing (cmd ^. command) args
+  let args = decode $ encode $ fromJust $ cmd ^. J.arguments
+      execParams = ExecuteCommandParams Nothing (cmd ^. J.command) args
   void $ sendRequest SMethod_WorkspaceExecuteCommand execParams
 
 -- | Executes a code action.
@@ -601,8 +600,8 @@ executeCommand cmd = do
 -- be applied first.
 executeCodeAction :: CodeAction -> Session ()
 executeCodeAction action = do
-  maybe (return ()) handleEdit $ action ^. edit
-  maybe (return ()) executeCommand $ action ^. command
+  maybe (return ()) handleEdit $ action ^. J.edit
+  maybe (return ()) executeCommand $ action ^. J.command
 
   where handleEdit :: WorkspaceEdit -> Session ()
         handleEdit e =
@@ -627,14 +626,14 @@ applyEdit doc edit = do
 
   caps <- asks sessionCapabilities
 
-  let supportsDocChanges = fromMaybe False $ caps ^? LSP.workspace . _Just . LSP.workspaceEdit . _Just . documentChanges . _Just
+  let supportsDocChanges = fromMaybe False $ caps ^? J.workspace . _Just . J.workspaceEdit . _Just . J.documentChanges . _Just
 
   let wEdit = if supportsDocChanges
       then
         let docEdit = TextDocumentEdit (review _versionedTextDocumentIdentifier verDoc) [InL edit]
         in WorkspaceEdit Nothing (Just [InL docEdit]) Nothing
       else
-        let changes = Map.singleton (doc ^. uri) [edit]
+        let changes = Map.singleton (doc ^. J.uri) [edit]
         in WorkspaceEdit (Just changes) Nothing Nothing
 
   let req = TRequestMessage "" (IdInt 0) SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
@@ -650,7 +649,7 @@ getCompletions doc pos = do
 
   case getResponseResult rsp of
     InL items -> return items
-    InR (InL c) -> return $ c ^. LSP.items
+    InR (InL c) -> return $ c ^. J.items
     InR (InR _) -> return []
 
 -- | Returns the references for the position in the document.
@@ -725,7 +724,7 @@ getResponseResult :: (ToJSON (ErrorData m)) => TResponseMessage m -> MessageResu
 getResponseResult rsp =
   case rsp ^. result of
     Right x -> x
-    Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. LSP.id) err
+    Left err -> throw $ UnexpectedResponseError (SomeLspId $ fromJust $ rsp ^. J.id) err
 
 -- | Applies formatting to the specified document.
 formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session ()
@@ -743,7 +742,7 @@ formatRange doc opts range = do
 
 applyTextEdits :: TextDocumentIdentifier -> [TextEdit] -> Session ()
 applyTextEdits doc edits =
-  let wEdit = WorkspaceEdit (Just (Map.singleton (doc ^. uri) edits)) Nothing Nothing
+  let wEdit = WorkspaceEdit (Just (Map.singleton (doc ^. J.uri) edits)) Nothing Nothing
       -- Send a dummy message to updateState so it can do bookkeeping
       req = TRequestMessage "" (IdInt 0) SMethod_WorkspaceApplyEdit (ApplyWorkspaceEditParams Nothing wEdit)
   in updateState (FromServerMess SMethod_WorkspaceApplyEdit req)

lsp-test/src/Language/LSP/Test/Decoding.hs

@@ -16,7 +16,7 @@ import           Data.Maybe
 import           System.IO
 import           System.IO.Error
 import           Language.LSP.Protocol.Message hiding (error)
-import           Language.LSP.Protocol.Types
+import qualified Language.LSP.Protocol.Types.Lens as J
 import           Language.LSP.Test.Exceptions
 
 import Data.IxMap
@@ -64,10 +64,10 @@ getRequestMap = foldl' helper emptyIxMap
   helper acc msg = case msg of
     FromClientMess m mess -> case splitClientMethod m of
       IsClientNot -> acc
-      IsClientReq -> fromJust $ updateRequestMap acc (mess ^. id) m
+      IsClientReq -> fromJust $ updateRequestMap acc (mess ^. J.id) m
       IsClientEither -> case mess of
         NotMess _ -> acc
-        ReqMess msg -> fromJust $ updateRequestMap acc (msg ^. id) m
+        ReqMess msg -> fromJust $ updateRequestMap acc (msg ^. J.id) m
     _ -> acc
 
 decodeFromServerMsg :: RequestMap -> B.ByteString -> (RequestMap, FromServerMessage)

lsp-test/src/Language/LSP/Test/Files.hs

@@ -10,8 +10,9 @@ module Language.LSP.Test.Files
   )
 where
 
-import           Language.LSP.Protocol.Message hiding (error)
-import           Language.LSP.Protocol.Types hiding (id)
+import           Language.LSP.Protocol.Message hiding (error, id)
+import           Language.LSP.Protocol.Types
+import           Language.LSP.Protocol.Types.Lens hiding (id)
 import           Control.Lens
 import qualified Data.Map.Strict           as M
 import qualified Data.Text                     as T

lsp-test/src/Language/LSP/Test/Session.hs

@@ -64,7 +64,8 @@ import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Data.Maybe
 import Data.Function
-import Language.LSP.Protocol.Types as LSP hiding (to)
+import Language.LSP.Protocol.Types as LSP
+import qualified Language.LSP.Protocol.Types.Lens as J
 import Language.LSP.Protocol.Message as LSP hiding (error)
 import Language.LSP.VFS
 import Language.LSP.Test.Compat
@@ -305,63 +306,63 @@ updateStateC = awaitForever $ \msg -> do
   where
     respond :: (MonadIO m, HasReader SessionContext m) => FromServerMessage -> m ()
     respond (FromServerMess SMethod_WindowWorkDoneProgressCreate req) =
-      sendMessage $ TResponseMessage "2.0" (Just $ req ^. LSP.id) (Right Null)
+      sendMessage $ TResponseMessage "2.0" (Just $ req ^. J.id) (Right Null)
     respond (FromServerMess SMethod_WorkspaceApplyEdit r) = do
-      sendMessage $ TResponseMessage "2.0" (Just $ r ^. LSP.id) (Right $ ApplyWorkspaceEditResult True Nothing Nothing)
+      sendMessage $ TResponseMessage "2.0" (Just $ r ^. J.id) (Right $ ApplyWorkspaceEditResult True Nothing Nothing)
     respond _ = pure ()
 
 
 -- extract Uri out from DocumentChange
 -- didn't put this in `lsp-types` because TH was getting in the way
 documentChangeUri :: DocumentChange -> Uri
-documentChangeUri (InL x) = x ^. textDocument . uri
-documentChangeUri (InR (InL x)) = x ^. uri
-documentChangeUri (InR (InR (InL x))) = x ^. oldUri
-documentChangeUri (InR (InR (InR x))) = x ^. uri
+documentChangeUri (InL x) = x ^. J.textDocument . J.uri
+documentChangeUri (InR (InL x)) = x ^. J.uri
+documentChangeUri (InR (InR (InL x))) = x ^. J.oldUri
+documentChangeUri (InR (InR (InR x))) = x ^. J.uri
 
 updateState :: (MonadIO m, HasReader SessionContext m, HasState SessionState m)
             => FromServerMessage -> m ()
-updateState (FromServerMess SMethod_Progress req) = case req ^. params . value of
+updateState (FromServerMess SMethod_Progress req) = case req ^. params . J.value of
   v | Just _ <- v ^? _workDoneProgressBegin ->
-    modify $ \s -> s { curProgressSessions = Set.insert (req ^. params . token) $ curProgressSessions s }
+    modify $ \s -> s { curProgressSessions = Set.insert (req ^. params . J.token) $ curProgressSessions s }
   v | Just _ <- v ^? _workDoneProgressEnd ->
-    modify $ \s -> s { curProgressSessions = Set.delete (req ^. params . token) $ curProgressSessions s }
+    modify $ \s -> s { curProgressSessions = Set.delete (req ^. params . J.token) $ curProgressSessions s }
   _ -> pure ()
 
 -- Keep track of dynamic capability registration
 updateState (FromServerMess SMethod_ClientRegisterCapability req) = do
   let
     regs :: [SomeRegistration]
-    regs = req ^.. params . registrations . traversed . to toSomeRegistration . _Just
+    regs = req ^.. params . J.registrations . traversed . to toSomeRegistration . _Just
   let newRegs = (\sr@(SomeRegistration r) -> (r ^. LSP.id, sr)) <$> regs
   modify $ \s ->
     s { curDynCaps = Map.union (Map.fromList newRegs) (curDynCaps s) }
 
 updateState (FromServerMess SMethod_ClientUnregisterCapability req) = do
-  let unRegs = (^. LSP.id) <$> req ^. params . unregisterations
+  let unRegs = (^. J.id) <$> req ^. params . J.unregisterations
   modify $ \s ->
     let newCurDynCaps = foldr' Map.delete (curDynCaps s) unRegs
     in s { curDynCaps = newCurDynCaps }
 
 updateState (FromServerMess SMethod_TextDocumentPublishDiagnostics n) = do
-  let diags = n ^. params . diagnostics
-      doc = n ^. params . uri
+  let diags = n ^. params . J.diagnostics
+      doc = n ^. params . J.uri
   modify $ \s ->
     let newDiags = Map.insert (toNormalizedUri doc) diags (curDiagnostics s)
       in s { curDiagnostics = newDiags }
 
 updateState (FromServerMess SMethod_WorkspaceApplyEdit r) = do
 
   -- First, prefer the versioned documentChanges field
-  allChangeParams <- case r ^. params . edit . documentChanges of
+  allChangeParams <- case r ^. params . J.edit . J.documentChanges of
     Just (cs) -> do
       mapM_ (checkIfNeedsOpened . documentChangeUri) cs
       -- replace the user provided version numbers with the VFS ones + 1
       -- (technically we should check that the user versions match the VFS ones)
-      cs' <- traverseOf (traverse . _L . textDocument . _versionedTextDocumentIdentifier) bumpNewestVersion cs
+      cs' <- traverseOf (traverse . _L . J.textDocument . _versionedTextDocumentIdentifier) bumpNewestVersion cs
       return $ mapMaybe getParamsFromDocumentChange cs'
     -- Then fall back to the changes field
-    Nothing -> case r ^. params . edit . changes of
+    Nothing -> case r ^. params . J.edit . J.changes of
       Just cs -> do
         mapM_ checkIfNeedsOpened (Map.keys cs)
         concat <$> mapM (uncurry getChangeParams) (Map.toList cs)
@@ -372,15 +373,15 @@ updateState (FromServerMess SMethod_WorkspaceApplyEdit r) = do
     let newVFS = flip execState (vfs s) $ changeFromServerVFS logger r
     return $ s { vfs = newVFS }
 
-  let groupedParams = groupBy (\a b -> a ^. textDocument == b ^. textDocument) allChangeParams
+  let groupedParams = groupBy (\a b -> a ^. J.textDocument == b ^. J.textDocument) allChangeParams
       mergedParams = map mergeParams groupedParams
 
   -- TODO: Don't do this when replaying a session
   forM_ mergedParams (sendMessage . TNotificationMessage "2.0" SMethod_TextDocumentDidChange)
 
   -- Update VFS to new document versions
-  let sortedVersions = map (sortBy (compare `on` (^. textDocument . version))) groupedParams
-      latestVersions = map ((^. textDocument) . last) sortedVersions
+  let sortedVersions = map (sortBy (compare `on` (^. J.textDocument . J.version))) groupedParams
+      latestVersions = map ((^. J.textDocument) . last) sortedVersions
 
   forM_ latestVersions $ \(VersionedTextDocumentIdentifier uri v) ->
     modify $ \s ->
@@ -412,8 +413,8 @@ updateState (FromServerMess SMethod_WorkspaceApplyEdit r) = do
 
         -- TODO: move somewhere reusable
         editToChangeEvent :: TextEdit |? AnnotatedTextEdit -> TextDocumentContentChangeEvent
-        editToChangeEvent (InR e) = TextDocumentContentChangeEvent $ InL $ #range .== (e ^. range) .+ #rangeLength .== Nothing .+ #text .== (e ^. newText)
-        editToChangeEvent (InL e) = TextDocumentContentChangeEvent $ InL $ #range .== (e ^. range) .+ #rangeLength .== Nothing .+ #text .== (e ^. newText)
+        editToChangeEvent (InR e) = TextDocumentContentChangeEvent $ InL $ #range .== (e ^. J.range) .+ #rangeLength .== Nothing .+ #text .== (e ^. J.newText)
+        editToChangeEvent (InL e) = TextDocumentContentChangeEvent $ InL $ #range .== (e ^. J.range) .+ #rangeLength .== Nothing .+ #text .== (e ^. J.newText)
 
         getParamsFromDocumentChange :: DocumentChange -> Maybe DidChangeTextDocumentParams
         getParamsFromDocumentChange (InL textDocumentEdit) = getParamsFromTextDocumentEdit textDocumentEdit
@@ -438,8 +439,8 @@ updateState (FromServerMess SMethod_WorkspaceApplyEdit r) = do
           pure $ catMaybes $ map getParamsFromTextDocumentEdit edits
 
         mergeParams :: [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams
-        mergeParams params = let events = concat (toList (map (toList . (^. contentChanges)) params))
-                              in DidChangeTextDocumentParams (head params ^. textDocument) events
+        mergeParams params = let events = concat (toList (map (toList . (^. J.contentChanges)) params))
+                              in DidChangeTextDocumentParams (head params ^. J.textDocument) events
 updateState _ = return ()
 
 sendMessage :: (MonadIO m, HasReader SessionContext m, ToJSON a) => a -> m ()