diff --git a/lsp/lsp.cabal b/lsp/lsp.cabal index 938ae624..50d4f2c2 100644 --- a/lsp/lsp.cabal +++ b/lsp/lsp.cabal @@ -66,7 +66,8 @@ library , filepath >=1.4 && < 1.6 , generic-lens ^>=2.2 , hashable ^>=1.4 - , lens >=5.1 && <5.4 + , microlens ^>=0.4 + , microlens-ghc ^>=0.4 , lens-aeson ^>=1.2 , lsp-types ^>=2.3 , mtl >=2.2 && <2.4 diff --git a/lsp/src/Language/LSP/Server/Processing.hs b/lsp/src/Language/LSP/Server/Processing.hs index 9232fefd..a24ca9fd 100644 --- a/lsp/src/Language/LSP/Server/Processing.hs +++ b/lsp/src/Language/LSP/Server/Processing.hs @@ -21,7 +21,6 @@ import Colog.Core ( import Control.Concurrent.Extra as C import Control.Concurrent.STM import Control.Exception qualified as E -import Control.Lens hiding (Empty) import Control.Monad import Control.Monad.Except () import Control.Monad.IO.Class @@ -34,6 +33,7 @@ import Data.Aeson hiding ( Null, Options, ) +import Data.Aeson.KeyMap qualified as Aeson import Data.Aeson.Lens () import Data.Aeson.Types hiding ( Error, @@ -42,6 +42,7 @@ import Data.Aeson.Types hiding ( ) import Data.ByteString.Lazy qualified as BSL import Data.Foldable (traverse_) +import Data.Functor.Const (Const (Const)) import Data.Functor.Product qualified as P import Data.IxMap import Data.List @@ -582,7 +583,7 @@ initialDynamicRegistrations logger = do See Note [LSP configuration] -} lookForConfigSection :: T.Text -> Value -> Value -lookForConfigSection section (Object o) | Just s' <- o ^. at (fromString $ T.unpack section) = s' +lookForConfigSection section (Object o) | Just s' <- Aeson.lookup (fromString $ T.unpack section) o = s' lookForConfigSection _ o = o -- | Handle a workspace/didChangeConfiguration request. diff --git a/lsp/src/Language/LSP/VFS.hs b/lsp/src/Language/LSP/VFS.hs index 551147dc..68a0baa9 100644 --- a/lsp/src/Language/LSP/VFS.hs +++ b/lsp/src/Language/LSP/VFS.hs @@ -1,10 +1,8 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} -{-# LANGUAGE FunctionalDependencies #-} -{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} {- | @@ -31,13 +29,9 @@ module Language.LSP.VFS ( -- * Positions and transformations CodePointPosition (..), - line, - character, codePointPositionToPosition, positionToCodePointPosition, CodePointRange (..), - start, - end, codePointRangeToRange, rangeToCodePointRange, @@ -51,7 +45,6 @@ module Language.LSP.VFS ( ) where import Colog.Core (LogAction (..), Severity (..), WithSeverity (..), (<&)) -import Control.Lens hiding (parts, (<.>)) import Control.Monad import Control.Monad.State import Data.Foldable (traverse_) @@ -70,6 +63,9 @@ import Data.Text.Utf16.Rope.Mixed qualified as Rope import GHC.Generics import Language.LSP.Protocol.Message qualified as J import Language.LSP.Protocol.Types qualified as J +import Lens.Micro +import Lens.Micro.Extras +import Lens.Micro.GHC () import Prettyprinter hiding (line) import System.Directory import System.FilePath @@ -79,6 +75,8 @@ import System.IO {-# ANN module ("hlint: ignore Eta reduce" :: String) #-} {-# ANN module ("hlint: ignore Redundant do" :: String) #-} +infix 4 .=, %= + -- --------------------------------------------------------------------- data VirtualFile = VirtualFile @@ -137,8 +135,8 @@ emptyVFS = VFS mempty openVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.TMessage 'J.Method_TextDocumentDidOpen -> m () openVFS logger msg = do let - p = msg ^. #params - J.TextDocumentItem (J.toNormalizedUri -> uri) _ version text = p ^. #textDocument + p = msg.params + J.TextDocumentItem (J.toNormalizedUri -> uri) _ version text = p.textDocument vfile = VirtualFile version 0 (Rope.fromText text) logger <& Opening uri `WithSeverity` Debug #vfsMap . at uri .= Just vfile @@ -149,11 +147,11 @@ openVFS logger msg = do changeFromClientVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.TMessage 'J.Method_TextDocumentDidChange -> m () changeFromClientVFS logger msg = do let - J.DidChangeTextDocumentParams vid changes = msg ^. #params + J.DidChangeTextDocumentParams vid changes = msg.params -- the client shouldn't be sending over a null version, only the server, but we just use 0 if that happens J.VersionedTextDocumentIdentifier (J.toNormalizedUri -> uri) version = vid vfs <- get - case vfs ^. #vfsMap . at uri of + case vfs ^. #vfsMap . at @(Map.Map J.NormalizedUri VirtualFile) uri of Just (VirtualFile _ file_ver contents) -> do contents' <- applyChanges logger contents changes #vfsMap . at uri .= Just (VirtualFile version (file_ver + 1) contents') @@ -216,7 +214,8 @@ applyDeleteFile logger (J.DeleteFile _ann _kind (J.toNormalizedUri -> uri) optio when (options ^? _Just . #recursive . _Just == Just True) $ logger <& CantRecursiveDelete uri `WithSeverity` Warning -- Remove and get the old value so we can check if it was missing - old <- #vfsMap . at uri <.= Nothing + old <- gets (view $ #vfsMap . at uri) + #vfsMap . at uri .= Nothing case old of -- It's not entirely clear what the semantics of 'ignoreIfNotExists' are, but if it -- doesn't exist and we're not ignoring it, let's at least log it. @@ -232,18 +231,18 @@ applyTextDocumentEdit logger (J.TextDocumentEdit vid edits) = do let sortedEdits = sortOn (Down . editRange) edits changeEvents = map editToChangeEvent sortedEdits -- TODO: is this right? - vid' = J.VersionedTextDocumentIdentifier (vid ^. #uri) (case vid ^. #version of J.InL v -> v; J.InR _ -> 0) + vid' = J.VersionedTextDocumentIdentifier vid.uri (case vid.version of J.InL v -> v; J.InR _ -> 0) ps = J.DidChangeTextDocumentParams vid' changeEvents notif = J.TNotificationMessage "" J.SMethod_TextDocumentDidChange ps changeFromClientVFS logger notif where editRange :: J.TextEdit J.|? J.AnnotatedTextEdit -> J.Range - editRange (J.InR e) = e ^. #range - editRange (J.InL e) = e ^. #range + editRange (J.InR e) = e.range + editRange (J.InL e) = e.range editToChangeEvent :: J.TextEdit J.|? J.AnnotatedTextEdit -> J.TextDocumentContentChangeEvent - editToChangeEvent (J.InR e) = J.TextDocumentContentChangeEvent $ J.InL $ J.TextDocumentContentChangePartial{range = e ^. #range, rangeLength = Nothing, text = e ^. #newText} - editToChangeEvent (J.InL e) = J.TextDocumentContentChangeEvent $ J.InL $ J.TextDocumentContentChangePartial{range = e ^. #range, rangeLength = Nothing, text = e ^. #newText} + editToChangeEvent (J.InR e) = J.TextDocumentContentChangeEvent $ J.InL $ J.TextDocumentContentChangePartial{range = e.range, rangeLength = Nothing, text = e.newText} + editToChangeEvent (J.InL e) = J.TextDocumentContentChangeEvent $ J.InL $ J.TextDocumentContentChangePartial{range = e.range, rangeLength = Nothing, text = e.newText} applyDocumentChange :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.DocumentChange -> m () applyDocumentChange logger (J.InL change) = applyTextDocumentEdit logger change @@ -254,7 +253,7 @@ applyDocumentChange logger (J.InR (J.InR (J.InR change))) = applyDeleteFile logg -- | Applies the changes from a 'ApplyWorkspaceEditRequest' to the 'VFS' changeFromServerVFS :: forall m. MonadState VFS m => LogAction m (WithSeverity VfsLog) -> J.TMessage 'J.Method_WorkspaceApplyEdit -> m () changeFromServerVFS logger msg = do - let J.ApplyWorkspaceEditParams _label edit = msg ^. #params + let J.ApplyWorkspaceEditParams _label edit = msg.params J.WorkspaceEdit mChanges mDocChanges _anns = edit case mDocChanges of Just docChanges -> applyDocumentChanges docChanges @@ -270,7 +269,7 @@ changeFromServerVFS logger msg = do -- for sorting [DocumentChange] project :: J.DocumentChange -> Maybe J.Int32 - project (J.InL textDocumentEdit) = case textDocumentEdit ^. #textDocument . #version of + project (J.InL textDocumentEdit) = case textDocumentEdit.textDocument.version of J.InL v -> Just v _ -> Nothing project _ = Nothing @@ -313,7 +312,7 @@ persistFileVFS logger dir vfs uri = closeVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.TMessage 'J.Method_TextDocumentDidClose -> m () closeVFS logger msg = do - let J.DidCloseTextDocumentParams (J.TextDocumentIdentifier (J.toNormalizedUri -> uri)) = msg ^. #params + let J.DidCloseTextDocumentParams (J.TextDocumentIdentifier (J.toNormalizedUri -> uri)) = msg.params logger <& Closing uri `WithSeverity` Debug #vfsMap . at uri .= Nothing @@ -330,11 +329,11 @@ applyChanges logger = foldM (applyChange logger) applyChange :: (Monad m) => LogAction m (WithSeverity VfsLog) -> Rope -> J.TextDocumentContentChangeEvent -> m Rope applyChange logger str (J.TextDocumentContentChangeEvent (J.InL e)) - | J.Range (J.Position sl sc) (J.Position fl fc) <- e ^. #range - , txt <- e ^. #text = + | J.Range (J.Position sl sc) (J.Position fl fc) <- e.range + , txt <- e.text = changeChars logger str (Utf16.Position (fromIntegral sl) (fromIntegral sc)) (Utf16.Position (fromIntegral fl) (fromIntegral fc)) txt applyChange _ _ (J.TextDocumentContentChangeEvent (J.InR e)) = - pure $ Rope.fromText $ e ^. #text + pure $ Rope.fromText $ e.text -- --------------------------------------------------------------------- @@ -356,9 +355,9 @@ changeChars logger str start finish new = do Unicode code points instead of UTF-16 code units. -} data CodePointPosition = CodePointPosition - { _line :: J.UInt + { line :: J.UInt -- ^ Line position in a document (zero-based). - , _character :: J.UInt + , character :: J.UInt -- ^ Character offset on a line in a document in *code points* (zero-based). } deriving (Show, Read, Eq, Ord) @@ -367,16 +366,13 @@ data CodePointPosition = CodePointPosition Unicode code points instead of UTF-16 code units. -} data CodePointRange = CodePointRange - { _start :: CodePointPosition + { start :: CodePointPosition -- ^ The range's start position. - , _end :: CodePointPosition + , end :: CodePointPosition -- ^ The range's end position. } deriving (Show, Read, Eq, Ord) -makeFieldsNoPrefix ''CodePointPosition -makeFieldsNoPrefix ''CodePointRange - {- Note [Converting between code points and code units] This is inherently a somewhat expensive operation, but we take some care to minimize the cost. In particular, we use the good asymptotics of 'Rope' to our advantage: @@ -464,3 +460,9 @@ rangeLinesFromVfs (VirtualFile _ _ ropetext) (J.Range (J.Position lf _cf) (J.Pos (_, s1) = Rope.splitAtLine (fromIntegral lf) ropetext (s2, _) = Rope.splitAtLine (fromIntegral (lt - lf)) s1 r = Rope.toText s2 + +(.=) :: MonadState s m => ASetter s s a b -> b -> m () +l .= b = modify (l .~ b) + +(%=) :: MonadState s m => ASetter s s a b -> (a -> b) -> m () +l %= f = modify (l %~ f)