Skip to content

Commit 1167017

Browse files
michaelpjmichaelpj
committed
Switch to using microlens and not having a separate component
1 parent d98af68 commit 1167017

File tree

14 files changed

+72
-87
lines changed

14 files changed

+72
-87
lines changed

‎lsp-test/func-test/FuncTest.hs

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,6 @@ import Data.Generics.Product.Fields (field')
2121
import Data.Maybe
2222
import Data.Proxy
2323
import Data.Set qualified as Set
24-
import Language.LSP.Protocol.Lens
2524
import Language.LSP.Protocol.Message hiding (error)
2625
import Language.LSP.Protocol.Types
2726
import Language.LSP.Server

‎lsp-test/lsp-test.cabal

Lines changed: 0 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,6 @@ library
6868
, lens-aeson ^>=1.2
6969
, lsp ^>=2.7
7070
, lsp-types ^>=2.3
71-
, lsp-types:lsp-types-lens
7271
, mtl >=2.2 && <2.4
7372
, parser-combinators ^>=1.3
7473
, process ^>=1.6
@@ -138,7 +137,6 @@ test-suite func-test
138137
, lens
139138
, lsp
140139
, lsp-test
141-
, lsp-types:lsp-types-lens
142140
, parser-combinators
143141
, process
144142
, unliftio

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

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -167,7 +167,6 @@ import Data.Text qualified as T
167167
import Data.Text.IO qualified as T
168168
import Data.Traversable (for)
169169
import Language.LSP.Protocol.Capabilities qualified as C
170-
import Language.LSP.Protocol.Lens qualified as L
171170
import Language.LSP.Protocol.Message (MessageDirection (..), MessageKind (..), Method (..), SMethod (..))
172171
import Language.LSP.Protocol.Message qualified as L
173172
import Language.LSP.Protocol.Types (ClientCapabilities, type (|?) (..))
@@ -773,8 +772,8 @@ executeCommand cmd = do
773772
-}
774773
executeCodeAction :: L.CodeAction -> Session ()
775774
executeCodeAction action = do
776-
maybe (return ()) handleEdit action.edit
777-
maybe (return ()) executeCommand action.command
775+
maybe (return ()) handleEdit action.edit
776+
maybe (return ()) executeCommand action.command
778777
where
779778
handleEdit :: L.WorkspaceEdit -> Session ()
780779
handleEdit e =

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -69,10 +69,10 @@ getRequestMap = foldl' helper emptyIxMap
6969
helper acc msg = case msg of
7070
FromClientMess m mess -> case splitClientMethod m of
7171
IsClientNot -> acc
72-
IsClientReq -> fromJust $ updateRequestMap acc (mess.id) m
72+
IsClientReq -> fromJust $ updateRequestMap acc mess.id m
7373
IsClientEither -> case mess of
7474
NotMess _ -> acc
75-
ReqMess msg -> fromJust $ updateRequestMap acc (msg.id) m
75+
ReqMess msg -> fromJust $ updateRequestMap acc msg.id m
7676
_ -> acc
7777

7878
decodeFromServerMsg :: RequestMap -> B.ByteString -> (RequestMap, FromServerMessage)

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

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,6 @@ import Data.Maybe
6868
import Data.Function
6969
import Language.LSP.Protocol.Types as LSP hiding (to)
7070
import Language.LSP.Protocol.Message as LSP hiding (error)
71-
import Language.LSP.Protocol.Lens
7271
import Language.LSP.VFS
7372
import Language.LSP.Test.Compat
7473
import Language.LSP.Test.Decoding
@@ -385,9 +384,9 @@ updateState :: (MonadIO m, HasReader SessionContext m, HasState SessionState m)
385384
=> FromServerMessage -> m ()
386385
updateState (FromServerMess SMethod_Progress req) = case req.params.value of
387386
v | Just _ <- v ^? workDoneProgressBegin ->
388-
modify $ \s -> s { curProgressSessions = Set.insert (req.params.token) $ curProgressSessions s }
387+
modify $ \s -> s { curProgressSessions = Set.insert req.params.token $ curProgressSessions s }
389388
v | Just _ <- v ^? workDoneProgressEnd ->
390-
modify $ \s -> s { curProgressSessions = Set.delete (req.params.token) $ curProgressSessions s }
389+
modify $ \s -> s { curProgressSessions = Set.delete req.params.token $ curProgressSessions s }
391390
_ -> pure ()
392391

393392
-- Keep track of dynamic capability registration

‎lsp-types/lens/Language/LSP/Protocol/Lens.hs

Lines changed: 0 additions & 39 deletions
This file was deleted.

‎lsp-types/lsp-types.cabal

Lines changed: 2 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -78,6 +78,7 @@ library
7878
, mod ^>=0.2
7979
, mtl >=2.2 && <2.4
8080
, network-uri ^>=2.6
81+
, profunctors ^>=5.6
8182
, prettyprinter ^>=1.7
8283
, row-types ^>=1.0
8384
, safe ^>=0.3
@@ -126,6 +127,7 @@ library
126127
Language.LSP.Protocol.Types.LspEnum
127128
Language.LSP.Protocol.Types.MarkupContent
128129
Language.LSP.Protocol.Types.Orphans
130+
Language.LSP.Protocol.Types.Progress
129131
Language.LSP.Protocol.Types.SemanticTokens
130132
Language.LSP.Protocol.Types.Singletons
131133
Language.LSP.Protocol.Types.Uri
@@ -611,21 +613,6 @@ library lsp-types-quickcheck
611613
, generic-arbitrary
612614
, template-haskell
613615

614-
library lsp-types-lens
615-
visibility: public
616-
hs-source-dirs: lens
617-
default-language: GHC2021
618-
619-
exposed-modules:
620-
Language.LSP.Protocol.Lens
621-
622-
build-depends:
623-
, aeson >=2
624-
, base >=4.11 && <5
625-
, lsp-types
626-
, lens >=5.1 && <5.3
627-
, text >=1 && <2.2
628-
629616
executable generator
630617
hs-source-dirs: generator
631618
default-language: GHC2021

‎lsp-types/src/Language/LSP/Protocol/Capabilities.hs

Lines changed: 14 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
{-# LANGUAGE DuplicateRecordFields #-}
22
{-# LANGUAGE LambdaCase #-}
3+
{-# LANGUAGE OverloadedLabels #-}
34
{-# LANGUAGE OverloadedRecordDot #-}
45
{-# LANGUAGE OverloadedStrings #-}
5-
{-# LANGUAGE OverloadedLabels #-}
66

77
module Language.LSP.Protocol.Capabilities (
88
LSPVersion (..),
@@ -20,17 +20,17 @@ module Language.LSP.Protocol.Capabilities (
2020
serverCapability,
2121
) where
2222

23+
import Data.Function ((&))
24+
import Data.Generics.Labels ()
2325
import Data.Kind (Type)
2426
import Data.Maybe
2527
import Data.Set qualified as Set
2628
import Data.Void
2729
import Language.LSP.Protocol.Message
2830
import Language.LSP.Protocol.Types
29-
import Prelude hiding (min)
31+
import Lens.Micro (Lens', lens, non, (.~), (^.), (^?), _Just)
3032
import Lens.Micro qualified as L
31-
import Lens.Micro (Lens', (.~), (^.), lens, non, (^?), _Just)
32-
import Data.Generics.Labels ()
33-
import Data.Function ((&))
33+
import Prelude hiding (min)
3434

3535
-- | A specific version of the LSP specification.
3636
data LSPVersion = LSPVersion Int Int
@@ -307,7 +307,7 @@ dynamicRegistrationSupported m caps = fromMaybe False $ case m of
307307
-- Notebook document methods alway support dynamic registration, it seems?
308308
_ -> Just False
309309
where
310-
--dyn :: L.HasDynamicRegistration (ClientCapability m) (Maybe Bool) => SMethod m -> Traversal' ClientCapabilities Bool
310+
-- dyn :: L.HasDynamicRegistration (ClientCapability m) (Maybe Bool) => SMethod m -> Traversal' ClientCapabilities Bool
311311
dyn m1 = clientCapability m1 . _Just . #dynamicRegistration . _Just
312312

313313
-- | Client capabilities for full support of the current LSP specification.
@@ -328,12 +328,12 @@ fullClientCapsForVersion v@(LSPVersion maj min) = caps
328328

329329
caps =
330330
ClientCapabilities
331-
{ workspace = Just workspace
332-
, textDocument = Just td
333-
, window = Just window
334-
, general = since 3 16 general
335-
, notebookDocument = NotebookDocumentClientCapabilities <$> methCaps SMethod_NotebookDocumentDidOpen
336-
, experimental = Nothing
331+
{ workspace = Just workspace
332+
, textDocument = Just td
333+
, window = Just window
334+
, general = since 3 16 general
335+
, notebookDocument = NotebookDocumentClientCapabilities <$> methCaps SMethod_NotebookDocumentDidOpen
336+
, experimental = Nothing
337337
}
338338

339339
window =
@@ -353,8 +353,8 @@ fullClientCapsForVersion v@(LSPVersion maj min) = caps
353353

354354
workspace =
355355
WorkspaceClientCapabilities
356-
{ applyEdit = methCaps SMethod_WorkspaceApplyEdit
357-
, workspaceEdit =
356+
{ applyEdit = methCaps SMethod_WorkspaceApplyEdit
357+
, workspaceEdit =
358358
Just
359359
( WorkspaceEditClientCapabilities
360360
(Just True)

‎lsp-types/src/Language/LSP/Protocol/Types.hs

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -34,6 +34,9 @@ module Language.LSP.Protocol.Types (
3434
-- ** WatchKinds
3535
module WatchKinds,
3636

37+
-- ** Progress
38+
module Progress,
39+
3740
-- * Main LSP types and functions
3841
module Generated,
3942
) where
@@ -46,6 +49,7 @@ import Language.LSP.Protocol.Types.Location as Locations
4649
import Language.LSP.Protocol.Types.LspEnum as LspEnum
4750
import Language.LSP.Protocol.Types.MarkupContent as Markup
4851
import Language.LSP.Protocol.Types.Orphans ()
52+
import Language.LSP.Protocol.Types.Progress as Progress
4953
import Language.LSP.Protocol.Types.SemanticTokens as SemanticTokens
5054
import Language.LSP.Protocol.Types.Singletons as Singletons
5155
import Language.LSP.Protocol.Types.Uri as Uri

‎lsp-types/src/Language/LSP/Protocol/Types/Edit.hs

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,4 @@
11
{-# LANGUAGE DuplicateRecordFields #-}
2-
{-# LANGUAGE OverloadedStrings #-}
32

43
module Language.LSP.Protocol.Types.Edit where
54

@@ -8,6 +7,7 @@ import Data.Text qualified as T
87

98
import Language.LSP.Protocol.Internal.Types
109
import Language.LSP.Protocol.Types.Common
10+
import Language.LSP.Protocol.Utils.Misc (Prism, prism)
1111

1212
-- | Convenience alias for the type in the 'WorkspaceEdit._documentChanges' field.
1313
type DocumentChange = TextDocumentEdit |? CreateFile |? RenameFile |? DeleteFile
@@ -48,3 +48,11 @@ editTextEdit :: TextEdit -> TextEdit -> TextEdit
4848
editTextEdit (TextEdit origRange origText) innerEdit =
4949
let newText = applyTextEdit innerEdit origText
5050
in TextEdit origRange newText
51+
52+
-- | Conversion between 'OptionalVersionedTextDocumentIdentifier' and 'VersionedTextDocumentIdentifier'.
53+
versionedTextDocumentIdentifier :: Prism OptionalVersionedTextDocumentIdentifier OptionalVersionedTextDocumentIdentifier VersionedTextDocumentIdentifier VersionedTextDocumentIdentifier
54+
versionedTextDocumentIdentifier = prism down up
55+
where
56+
down (VersionedTextDocumentIdentifier uri v) = OptionalVersionedTextDocumentIdentifier uri (InL v)
57+
up (OptionalVersionedTextDocumentIdentifier uri (InL v)) = Right $ VersionedTextDocumentIdentifier uri v
58+
up i@(OptionalVersionedTextDocumentIdentifier _ (InR _)) = Left i

‎lsp-types/src/Language/LSP/Protocol/Types/Progress.hs

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
module Language.LSP.Protocol.Types.Progress (workDoneProgressBegin, workDoneProgressEnd, workDoneProgressReport) where
2+
3+
import Data.Aeson
4+
import Language.LSP.Protocol.Internal.Types
5+
import Language.LSP.Protocol.Utils.Misc (Prism, prism)
6+
7+
-- From lens-aeson
8+
_JSON :: (ToJSON a, FromJSON a) => Prism Value Value a a
9+
_JSON = prism toJSON $ \v -> case fromJSON v of
10+
Success y -> Right y
11+
_ -> Left v
12+
13+
-- | Prism for extracting the 'WorkDoneProgressBegin' case from the unstructured 'value' field of 'ProgressParams'.
14+
workDoneProgressBegin :: Prism Value Value WorkDoneProgressBegin WorkDoneProgressBegin
15+
workDoneProgressBegin = _JSON
16+
17+
-- | Prism for extracting the 'WorkDoneProgressEnd' case from the unstructured 'value' field of 'ProgressParams'.
18+
workDoneProgressEnd :: Prism Value Value WorkDoneProgressEnd WorkDoneProgressEnd
19+
workDoneProgressEnd = _JSON
20+
21+
-- | Prism for extracting the 'WorkDoneProgressReport' case from the unstructured 'value' field of 'ProgressParams'.
22+
workDoneProgressReport :: Prism Value Value WorkDoneProgressReport WorkDoneProgressReport
23+
workDoneProgressReport = _JSON

‎lsp-types/src/Language/LSP/Protocol/Utils/Misc.hs

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,8 @@ module Language.LSP.Protocol.Utils.Misc (
99
lspOptionsUntagged,
1010
prettyJSON,
1111
ViaJSON (..),
12+
Prism,
13+
prism,
1214
) where
1315

1416
import Control.Monad
@@ -19,6 +21,8 @@ import Data.Foldable.WithIndex qualified as F
1921
import Data.Functor.WithIndex.Instances qualified ()
2022
import Data.List hiding (group)
2123
import Data.Maybe (mapMaybe)
24+
import Data.Profunctor (dimap)
25+
import Data.Profunctor.Choice (Choice, right')
2226
import Language.Haskell.TH as TH
2327
import Prettyprinter
2428

@@ -132,3 +136,8 @@ newtype ViaJSON a = ViaJSON a
132136

133137
instance ToJSON a => Pretty (ViaJSON a) where
134138
pretty (ViaJSON a) = prettyJSON $ toJSON a
139+
140+
type Prism s t a b = forall p f. (Choice p, Applicative f) => p a (f b) -> p s (f t)
141+
142+
prism :: (b -> t) -> (s -> Either t a) -> Prism s t a b
143+
prism bt seta = dimap seta (either pure (fmap bt)) . right'

‎lsp/example/Reactor.hs

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,6 @@ import Data.Text qualified as T
3737
import GHC.Generics (Generic)
3838
import Language.LSP.Diagnostics
3939
import Language.LSP.Logging (defaultClientLogger)
40-
import Language.LSP.Protocol.Lens
4140
import Language.LSP.Protocol.Message qualified as LSP
4241
import Language.LSP.Protocol.Types qualified as LSP
4342
import Language.LSP.Server
@@ -241,7 +240,7 @@ handle logger =
241240
, notificationHandler LSP.SMethod_TextDocumentDidChange $ \msg -> do
242241
let
243242
params = msg.params
244-
doc = LSP.toNormalizedUri (params.textDocument.uri)
243+
doc = LSP.toNormalizedUri params.textDocument.uri
245244
logger <& ("Processing DidChangeTextDocument for: " <> T.pack (show doc)) `WithSeverity` Info
246245
mdoc <- getVirtualFile doc
247246
case mdoc of
@@ -261,10 +260,10 @@ handle logger =
261260
let params = req.params
262261
LSP.Position l c = params.position
263262
newName = params.newName
264-
vdoc <- getVersionedTextDoc (params.textDocument)
263+
vdoc <- getVersionedTextDoc params.textDocument
265264
-- Replace some text at the position with what the user entered
266265
let edit = LSP.InL $ LSP.TextEdit (LSP.mkRange l c l (c + fromIntegral (T.length newName))) newName
267-
tde = LSP.TextDocumentEdit (versionedTextDocumentIdentifier # vdoc) [edit]
266+
tde = LSP.TextDocumentEdit (LSP.versionedTextDocumentIdentifier # vdoc) [edit]
268267
-- "documentChanges" field is preferred over "changes"
269268
rsp = LSP.WorkspaceEdit Nothing (Just [LSP.InL tde]) Nothing
270269
responder (Right $ LSP.InL rsp)
@@ -279,7 +278,7 @@ handle logger =
279278
, requestHandler LSP.SMethod_TextDocumentDocumentSymbol $ \req responder -> do
280279
logger <& "Processing a textDocument/documentSymbol request" `WithSeverity` Info
281280
let LSP.DocumentSymbolParams _ _ doc = req.params
282-
loc = LSP.Location (doc.uri) (LSP.Range (LSP.Position 0 0) (LSP.Position 0 0))
281+
loc = LSP.Location doc.uri (LSP.Range (LSP.Position 0 0) (LSP.Position 0 0))
283282
rsp = [LSP.SymbolInformation "lsp-hello" LSP.SymbolKind_Function Nothing Nothing Nothing loc]
284283
responder (Right $ LSP.InL rsp)
285284
, requestHandler LSP.SMethod_TextDocumentCodeAction $ \req responder -> do
@@ -315,7 +314,7 @@ handle logger =
315314

316315
logger <& ("The arguments are: " <> T.pack (show margs)) `WithSeverity` Debug
317316
responder (Right $ LSP.InL (J.Object mempty)) -- respond to the request
318-
void $ withProgress "Executing some long running command" (params.workDoneToken) Cancellable $ \update ->
317+
void $ withProgress "Executing some long running command" params.workDoneToken Cancellable $ \update ->
319318
forM [(0 :: LSP.UInt) .. 10] $ \i -> do
320319
update (ProgressAmount (Just (i * 10)) (Just "Doing stuff"))
321320
liftIO $ threadDelay (1 * 1000000)

‎lsp/lsp.cabal

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -91,7 +91,6 @@ executable lsp-demo-reactor-server
9191
, co-log-core
9292
, lens
9393
, lsp
94-
, lsp-types:lsp-types-lens
9594
, prettyprinter
9695
, stm
9796
, text

0 commit comments

Comments
 (0)