diff --git a/src/Lean/Data/Lsp/Extra.lean b/src/Lean/Data/Lsp/Extra.lean index b2914aff60..0a1478477c 100644 --- a/src/Lean/Data/Lsp/Extra.lean +++ b/src/Lean/Data/Lsp/Extra.lean @@ -5,6 +5,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Marc Huisinga, Wojciech Nawrocki -/ import Lean.Data.Lsp.Basic +import Lean.Server.Rpc.Basic /-! This file contains Lean-specific extensions to LSP. See the structures below for which additional requests and notifications are supported. -/ @@ -87,16 +88,6 @@ structure PlainTermGoal where range : Range deriving FromJson, ToJson -/-- An object which RPC clients can refer to without marshalling. -/ -structure RpcRef where - /- NOTE(WN): It is important for this to be a single-field structure - in order to deserialize as an `Object` on the JS side. -/ - p : USize - deriving BEq, Hashable, FromJson, ToJson - -instance : ToString RpcRef where - toString r := toString r.p - /-- `$/lean/rpc/connect` client->server request. Starts an RPC session at the given file's worker, replying with the new session ID. diff --git a/src/Lean/Server/FileWorker.lean b/src/Lean/Server/FileWorker.lean index 29170d366c..538500a871 100644 --- a/src/Lean/Server/FileWorker.lean +++ b/src/Lean/Server/FileWorker.lean @@ -332,20 +332,20 @@ section NotificationHandling updatePendingRequests (fun pendingRequests => pendingRequests.erase p.id) def handleRpcRelease (p : Lsp.RpcReleaseParams) : WorkerM Unit := do - let st ← get -- NOTE(WN): when the worker restarts e.g. due to changed imports, we may receive `rpc/release` -- for the previous RPC session. This is fine, just ignore. - if let some seshRef := st.rpcSessions.find? p.sessionId then + if let some seshRef := (← get).rpcSessions.find? p.sessionId then let monoMsNow ← IO.monoMsNow - seshRef.modify fun sesh => Id.run do - let mut sesh := sesh + let discardRefs : StateM RpcObjectStore Unit := do for ref in p.refs do - sesh := sesh.release ref |>.snd - sesh.keptAlive monoMsNow + discard do rpcReleaseRef ref + seshRef.modify fun st => + let st := st.keptAlive monoMsNow + let ((), objects) := discardRefs st.objects + { st with objects } def handleRpcKeepAlive (p : Lsp.RpcKeepAliveParams) : WorkerM Unit := do - let st ← get - match st.rpcSessions.find? p.sessionId with + match (← get).rpcSessions.find? p.sessionId with | none => return | some seshRef => seshRef.modify (·.keptAlive (← IO.monoMsNow)) diff --git a/src/Lean/Server/FileWorker/Utils.lean b/src/Lean/Server/FileWorker/Utils.lean index e065bd1392..9e637a0482 100644 --- a/src/Lean/Server/FileWorker/Utils.lean +++ b/src/Lean/Server/FileWorker/Utils.lean @@ -59,16 +59,7 @@ namespace EditableDocument end EditableDocument structure RpcSession where - /-- Objects that are being kept alive for the RPC client, together with their type names, - mapped to by their RPC reference. - - Note that we may currently have multiple references to the same object. It is only disposed - of once all of those are gone. This simplifies the client a bit as it can drop every reference - received separately. -/ - aliveRefs : Std.PersistentHashMap Lsp.RpcRef (Name × NonScalar) - /-- Value to use for the next `RpcRef`. It is monotonically increasing to avoid any possible - bugs resulting from its reuse. -/ - nextRef : USize + objects : RpcObjectStore /-- The `IO.monoMsNow` time when the session expires. See `$/lean/rpc/keepAlive`. -/ expireTime : Nat @@ -82,22 +73,11 @@ def new : IO (UInt64 × RpcSession) := do and worker restarts. Otherwise, the client may attempt to use outdated references. -/ let newId ← ByteArray.toUInt64LE! <$> IO.getRandomBytes 8 let newSesh := { - aliveRefs := Std.PersistentHashMap.empty - nextRef := 0 + objects := {} expireTime := (← IO.monoMsNow) + keepAliveTimeMs } return (newId, newSesh) -def store (st : RpcSession) (typeName : Name) (obj : NonScalar) : Lsp.RpcRef × RpcSession := - let ref := ⟨st.nextRef⟩ - let st' := { st with aliveRefs := st.aliveRefs.insert ref (typeName, obj) - nextRef := st.nextRef + 1 } - (ref, st') - -def release (st : RpcSession) (ref : Lsp.RpcRef) : Bool × RpcSession := - let released := st.aliveRefs.contains ref - (released, { st with aliveRefs := st.aliveRefs.erase ref }) - def keptAlive (monoMsNow : Nat) (s : RpcSession) : RpcSession := { s with expireTime := monoMsNow + keepAliveTimeMs } @@ -106,9 +86,4 @@ def hasExpired (s : RpcSession) : IO Bool := end RpcSession -instance [Monad m] [MonadStateOf RpcSession m] : MonadRpcSession m where - rpcStoreRef typeName obj := modifyGet fun st => st.store typeName obj - rpcGetRef r := return (←get).aliveRefs.find? r - rpcReleaseRef r := modifyGet fun st => st.release r - end Lean.Server.FileWorker diff --git a/src/Lean/Server/FileWorker/WidgetRequests.lean b/src/Lean/Server/FileWorker/WidgetRequests.lean index e34696e885..df9de092dc 100644 --- a/src/Lean/Server/FileWorker/WidgetRequests.lean +++ b/src/Lean/Server/FileWorker/WidgetRequests.lean @@ -20,7 +20,7 @@ open Server structure MsgToInteractive where msg : WithRpcRef MessageData indent : Nat - deriving Inhabited, RpcEncoding + deriving Inhabited, RpcEncodable builtin_initialize registerBuiltinRpcProcedure @@ -38,7 +38,7 @@ structure InfoPopup where exprExplicit : Option CodeWithInfos /-- Docstring. In markdown. -/ doc : Option String - deriving Inhabited, RpcEncoding + deriving Inhabited, RpcEncodable /-- Given elaborator info for a particular subexpression. Produce the `InfoPopup`. @@ -118,7 +118,7 @@ builtin_initialize structure GetGoToLocationParams where kind : GoToKind info : WithRpcRef InfoWithCtx - deriving RpcEncoding + deriving RpcEncodable builtin_initialize registerBuiltinRpcProcedure diff --git a/src/Lean/Server/Rpc/Basic.lean b/src/Lean/Server/Rpc/Basic.lean index 45beb67e50..e8e1bd95ad 100644 --- a/src/Lean/Server/Rpc/Basic.lean +++ b/src/Lean/Server/Rpc/Basic.lean @@ -4,7 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Wojciech Nawrocki -/ -import Lean.Data.Lsp.Extra +import Lean.Data.Json +import Std.Dynamic /-! Allows LSP clients to make Remote Procedure Calls to the server. @@ -15,98 +16,113 @@ For example, the client can format an `Expr` without transporting the whole `Env All RPC requests are relative to an open file and an RPC session for that file. The client must first connect to the session using `$/lean/rpc/connect`. -/ +namespace Lean.Lsp + +/-- An object which RPC clients can refer to without marshalling. -/ +structure RpcRef where + /- NOTE(WN): It is important for this to be a single-field structure + in order to deserialize as an `Object` on the JS side. -/ + p : USize + deriving BEq, Hashable, FromJson, ToJson + +instance : ToString RpcRef where + toString r := toString r.p + +end Lean.Lsp + namespace Lean.Server +open Std -/-- Monads with an RPC session in their state. -/ -class MonadRpcSession (m : Type → Type) where - rpcStoreRef (typeName : Name) (obj : NonScalar) : m Lsp.RpcRef - rpcGetRef (r : Lsp.RpcRef) : m (Option (Name × NonScalar)) - rpcReleaseRef (r : Lsp.RpcRef) : m Bool -export MonadRpcSession (rpcStoreRef rpcGetRef rpcReleaseRef) +structure RpcObjectStore : Type where + /-- Objects that are being kept alive for the RPC client, together with their type names, + mapped to by their RPC reference. -instance {m n : Type → Type} [MonadLift m n] [MonadRpcSession m] : MonadRpcSession n where - rpcStoreRef typeName obj := liftM (rpcStoreRef typeName obj : m _) - rpcGetRef r := liftM (rpcGetRef r : m _) - rpcReleaseRef r := liftM (rpcReleaseRef r : m _) + Note that we may currently have multiple references to the same object. It is only disposed + of once all of those are gone. This simplifies the client a bit as it can drop every reference + received separately. -/ + aliveRefs : Std.PersistentHashMap Lsp.RpcRef Dynamic := {} + /-- Value to use for the next `RpcRef`. It is monotonically increasing to avoid any possible + bugs resulting from its reuse. -/ + nextRef : USize := 0 -set_option linter.unusedVariables false in -def RpcEncodable (α : Type) : Type := default -def RpcEncodable.rpcEncode := 0 -def RpcEncodable.rpcDecode := 0 +def rpcStoreRef (any : Dynamic) : StateM RpcObjectStore Lsp.RpcRef := do + let st ← get + set { st with + aliveRefs := st.aliveRefs.insert ⟨st.nextRef⟩ any + nextRef := st.nextRef + 1 + } + return ⟨st.nextRef⟩ -/-- `RpcEncoding α β` means that `α` may participate in RPC calls with its on-the-wire LSP encoding -being `β`. This is useful when `α` contains fields which must be marshalled in a special way. In -particular, we encode `WithRpcRef` fields as opaque references rather than send their content. +def rpcGetRef (r : Lsp.RpcRef) : ReaderT RpcObjectStore Id (Option Dynamic) := + return (← read).aliveRefs.find? r -Structures with `From/ToJson` use JSON as their `RpcEncoding`. Structures containing -non-JSON-serializable fields can be auto-encoded in two ways: -- `deriving RpcEncoding` acts like `From/ToJson` but marshalls any `WithRpcRef` fields +def rpcReleaseRef (r : Lsp.RpcRef) : StateM RpcObjectStore Bool := do + let st ← get + if st.aliveRefs.contains r then + set { st with aliveRefs := st.aliveRefs.erase r } + return true + else + return false + +/-- +`RpcEncodable α` means that `α` can be serialized in the RPC system of the Lean server. +This is required when `α` contains fields which should be serialized as an RPC reference +instead of being sent in full. +The type wrapper `WithRpcRef` is used for these fields which should be sent as +a reference. + +- Any type with `FromJson` and `ToJson` instance is automatically `RpcEncodable`. +- If a type has an `Std.Dynamic` instance, then `WithRpcRef` can be used for its references. +- `deriving RpcEncodable` acts like `FromJson`/`ToJson` but marshalls any `WithRpcRef` fields as `Lsp.RpcRef`s. -- `deriving RpcEncoding with { withRef := true }` generates an encoding for - `WithRpcRef TheType`. -/ --- TODO(WN): for Lean.js, have third parameter defining the client-side structure; --- or, compile `WithRpcRef` to "opaque reference" on the client -class RpcEncoding (α : Type) (β : outParam Type) where - rpcEncode {m : Type → Type} [Monad m] [MonadRpcSession m] : α → ExceptT String m β - rpcDecode {m : Type → Type} [Monad m] [MonadRpcSession m] : β → ExceptT String m α -export RpcEncoding (rpcEncode rpcDecode) +-/ +-- TODO(WN): for Lean.js, compile `WithRpcRef` to "opaque reference" on the client +class RpcEncodable (α : Type) where + rpcEncode : α → StateM RpcObjectStore Json + rpcDecode : Json → ExceptT String (ReaderT RpcObjectStore Id) α +export RpcEncodable (rpcEncode rpcDecode) -instance : Nonempty (RpcEncoding α β) := - ⟨{ rpcEncode := fun _ => throw "unreachable", rpcDecode := fun _ => throw "unreachable" }⟩ +instance : Nonempty (RpcEncodable α) := + ⟨{ rpcEncode := default, rpcDecode := default }⟩ -instance [FromJson α] [ToJson α] : RpcEncoding α α where - rpcEncode := pure - rpcDecode := pure +instance [FromJson α] [ToJson α] : RpcEncodable α where + rpcEncode a := return toJson a + rpcDecode j := ofExcept (fromJson? j) -instance [RpcEncoding α β] : RpcEncoding (Option α) (Option β) where - rpcEncode v := match v with - | none => pure none - | some v => some <$> rpcEncode v - rpcDecode v := match v with - | none => pure none - | some v => some <$> rpcDecode v +instance [RpcEncodable α] : RpcEncodable (Option α) where + rpcEncode v := toJson <$> v.mapM rpcEncode + rpcDecode j := do Option.mapM rpcDecode (← fromJson? j) --- TODO(WN): instance [RpcEncoding α β] [Traversable t] : RpcEncoding (t α) (t β) -instance [RpcEncoding α β] : RpcEncoding (Array α) (Array β) where - rpcEncode a := a.mapM rpcEncode - rpcDecode b := b.mapM rpcDecode +-- TODO(WN): instance [RpcEncodable α β] [Traversable t] : RpcEncodable (t α) (t β) -instance [RpcEncoding α α'] [RpcEncoding β β'] : RpcEncoding (α × β) (α' × β') where - rpcEncode := fun (a, b) => do - let a' ← rpcEncode a - let b' ← rpcEncode b - return (a', b') - rpcDecode := fun (a', b') => do - let a ← rpcDecode a' - let b ← rpcDecode b' - return (a, b) +instance [RpcEncodable α] : RpcEncodable (Array α) where + rpcEncode a := toJson <$> a.mapM rpcEncode + rpcDecode b := do Array.mapM rpcDecode (← fromJson? b) -structure RpcEncoding.DerivingParams where - withRef : Bool := false +instance [RpcEncodable α] [RpcEncodable β] : RpcEncodable (α × β) where + rpcEncode := fun (a, b) => return toJson (← rpcEncode a, ← rpcEncode b) + rpcDecode j := do + let (a, b) ← fromJson? j + return (← rpcDecode a, ← rpcDecode b) /-- Marks fields to encode as opaque references in LSP packets. -/ structure WithRpcRef (α : Type u) where val : α deriving Inhabited -namespace WithRpcRef +instance [TypeName α] : RpcEncodable (WithRpcRef α) := + { rpcEncode, rpcDecode } +where + -- separate definitions to prevent inlining + rpcEncode r := toJson <$> rpcStoreRef (.mk r.val) + rpcDecode j := do + let r ← fromJson? j + match (← rpcGetRef r) with + | none => throw s!"RPC reference '{r}' is not valid" + | some any => + if let some obj := any.get? α then + return ⟨obj⟩ + else + throw s!"RPC call type mismatch in reference '{r}'\nexpected '{TypeName.typeName α}', got '{any.typeName}'" -variable {m : Type → Type} [Monad m] [MonadRpcSession m] - -/-- This is unsafe because we must ensure that: -- the stored `NonScalar` is never used to access the value as a type other than `α` -- the type `α` is not a scalar -/ -protected unsafe def encodeUnsafe [Monad m] (typeName : Name) (r : WithRpcRef α) : m Lsp.RpcRef := do - let obj := @unsafeCast α NonScalar r.val - rpcStoreRef typeName obj - -protected unsafe def decodeUnsafeAs (α) (typeName : Name) (r : Lsp.RpcRef) : ExceptT String m (WithRpcRef α) := do - match (← rpcGetRef r) with - | none => throw s!"RPC reference '{r}' is not valid" - | some (nm, obj) => - if nm != typeName then - throw s!"RPC call type mismatch in reference '{r}'\nexpected '{typeName}', got '{nm}'" - return WithRpcRef.mk <| @unsafeCast NonScalar α obj - -end WithRpcRef end Lean.Server diff --git a/src/Lean/Server/Rpc/RequestHandling.lean b/src/Lean/Server/Rpc/RequestHandling.lean index 5ad94572cf..1f11482aaf 100644 --- a/src/Lean/Server/Rpc/RequestHandling.lean +++ b/src/Lean/Server/Rpc/RequestHandling.lean @@ -20,7 +20,6 @@ that users don't need to import core Lean modules to make builtin handlers work, they *can* easily create custom handlers and use them in the same file. -/ builtin_initialize builtinRpcProcedures : IO.Ref (Std.PHashMap Name RpcProcedure) ← IO.mkRef {} - builtin_initialize userRpcProcedures : MapDeclarationExtension Name ← mkMapDeclarationExtension `userRpcProcedures @@ -56,8 +55,7 @@ builtin_initialize registerLspRequestHandler "$/lean/rpc/call" Lsp.RpcCallParams Json handleRpcCall def wrapRpcProcedure (method : Name) paramType respType - {paramLspType} [RpcEncoding paramType paramLspType] [FromJson paramLspType] - {respLspType} [RpcEncoding respType respLspType] [ToJson respLspType] + [RpcEncodable paramType] [RpcEncodable respType] (handler : paramType → RequestM (RequestTask respType)) : RpcProcedure := ⟨fun seshId j => do let rc ← read @@ -66,9 +64,7 @@ def wrapRpcProcedure (method : Name) paramType respType | throwThe RequestError { code := JsonRpc.ErrorCode.rpcNeedsReconnect message := s!"Outdated RPC session" } let t ← RequestM.asTask do - let paramsLsp ← liftExcept <| parseRequestParams paramLspType j - let act := rpcDecode (α := paramType) (β := paramLspType) (m := StateM FileWorker.RpcSession) paramsLsp - match act.run' (← seshRef.get) with + match rpcDecode j (← seshRef.get).objects with | Except.ok v => return v | Except.error e => throwThe RequestError { code := JsonRpc.ErrorCode.invalidParams @@ -81,23 +77,12 @@ def wrapRpcProcedure (method : Name) paramType respType RequestM.mapTask t fun | Except.error e => throw e - | Except.ok ret => do - let act : StateM FileWorker.RpcSession (Except String respLspType) := do - let s ← get - match ← rpcEncode (α := respType) (β := respLspType) (m := StateM FileWorker.RpcSession) ret with - | .ok x => return .ok x - | .error e => set s; return .error e - match ← seshRef.modifyGet act.run with - | .ok x => return toJson x - | .error e => - throwThe RequestError { - code := JsonRpc.ErrorCode.invalidParams - message := s!"Cannot encode result of RPC call '{method}'\n{e}" - }⟩ + | Except.ok ret => + seshRef.modifyGet fun st => + rpcEncode ret st.objects |>.map id ({st with objects := ·})⟩ def registerBuiltinRpcProcedure (method : Name) paramType respType - {paramLspType} [RpcEncoding paramType paramLspType] [FromJson paramLspType] - {respLspType} [RpcEncoding respType respLspType] [ToJson respLspType] + [RpcEncodable paramType] [RpcEncodable respType] (handler : paramType → RequestM (RequestTask respType)) : IO Unit := do let errMsg := s!"Failed to register builtin RPC call handler for '{method}'" unless (← IO.initializing) do @@ -137,7 +122,7 @@ builtin_initialize registerBuiltinAttribute { descr := "Marks a function as a Lean server RPC method. Shorthand for `registerRpcProcedure`. The function must have type `α → RequestM (RequestTask β)` with - RpcEncodings for both α and β." + `[RpcEncodable α]` and `[RpcEncodable β]`." applicationTime := AttributeApplicationTime.afterCompilation add := fun decl _ _ => registerRpcProcedure decl diff --git a/src/Lean/Widget/Basic.lean b/src/Lean/Widget/Basic.lean index 3ca433e116..52c2e442df 100644 --- a/src/Lean/Widget/Basic.lean +++ b/src/Lean/Widget/Basic.lean @@ -18,9 +18,9 @@ functionality is purpose-specific to showing the contents of infoview popups. structure InfoWithCtx where ctx : Elab.ContextInfo info : Elab.Info - deriving Inhabited, RpcEncoding with { withRef := true } + deriving Inhabited, Std.TypeName -deriving instance RpcEncoding with { withRef := true } for MessageData +deriving instance Std.TypeName for MessageData instance : ToJson FVarId := ⟨fun f => toJson f.name⟩ instance : ToJson MVarId := ⟨fun f => toJson f.name⟩ diff --git a/src/Lean/Widget/InteractiveCode.lean b/src/Lean/Widget/InteractiveCode.lean index 7f25dd8b8c..6258bc7c3f 100644 --- a/src/Lean/Widget/InteractiveCode.lean +++ b/src/Lean/Widget/InteractiveCode.lean @@ -24,7 +24,7 @@ structure SubexprInfo where subexprPos : Lean.SubExpr.Pos -- TODO(WN): add fields for semantic highlighting -- kind : Lsp.SymbolKind - deriving Inhabited, RpcEncoding + deriving Inhabited, RpcEncodable /-- Pretty-printed syntax (usually but not necessarily an `Expr`) with embedded `Info`s. -/ abbrev CodeWithInfos := TaggedText SubexprInfo diff --git a/src/Lean/Widget/InteractiveDiagnostic.lean b/src/Lean/Widget/InteractiveDiagnostic.lean index a22c58d11b..59727ebf29 100644 --- a/src/Lean/Widget/InteractiveDiagnostic.lean +++ b/src/Lean/Widget/InteractiveDiagnostic.lean @@ -15,14 +15,14 @@ inductive MsgEmbed where | expr : CodeWithInfos → MsgEmbed | goal : InteractiveGoal → MsgEmbed | lazyTrace : Nat → Name → WithRpcRef MessageData → MsgEmbed - deriving Inhabited, RpcEncoding + deriving Inhabited, RpcEncodable /-- We embed objects in LSP diagnostics by storing them in the tag of an empty subtree (`text ""`). In other words, we terminate the `MsgEmbed`-tagged tree at embedded objects and instead store the pretty-printed embed (which can itself be a `TaggedText`) in the tag. -/ abbrev InteractiveDiagnostic := Lsp.DiagnosticWith (TaggedText MsgEmbed) -deriving instance RpcEncoding for Lsp.DiagnosticWith +deriving instance RpcEncodable for Lsp.DiagnosticWith namespace InteractiveDiagnostic open MsgEmbed diff --git a/src/Lean/Widget/InteractiveGoal.lean b/src/Lean/Widget/InteractiveGoal.lean index 12b580723e..bc00558b43 100644 --- a/src/Lean/Widget/InteractiveGoal.lean +++ b/src/Lean/Widget/InteractiveGoal.lean @@ -6,6 +6,7 @@ Authors: Wojciech Nawrocki -/ import Lean.Meta.PPGoal import Lean.Widget.InteractiveCode +import Lean.Data.Lsp.Extra /-! RPC procedures for retrieving tactic and term goals with embedded `CodeWithInfos`. -/ @@ -21,7 +22,7 @@ structure InteractiveHypothesisBundle where val? : Option CodeWithInfos := none isInstance : Bool isType : Bool - deriving Inhabited, RpcEncoding + deriving Inhabited, RpcEncodable structure InteractiveGoal where hyps : Array InteractiveHypothesisBundle @@ -32,7 +33,7 @@ structure InteractiveGoal where name of the MVar that it is a goal for.) This is none when we are showing a term goal. -/ mvarId? : Option MVarId := none - deriving Inhabited, RpcEncoding + deriving Inhabited, RpcEncodable namespace InteractiveGoal @@ -69,7 +70,7 @@ structure InteractiveTermGoal where hyps : Array InteractiveHypothesisBundle type : CodeWithInfos range : Lsp.Range - deriving Inhabited, RpcEncoding + deriving Inhabited, RpcEncodable namespace InteractiveTermGoal @@ -80,7 +81,7 @@ end InteractiveTermGoal structure InteractiveGoals where goals : Array InteractiveGoal - deriving RpcEncoding + deriving RpcEncodable open Meta in def addInteractiveHypothesisBundle (hyps : Array InteractiveHypothesisBundle) (ids : Array (Name × FVarId)) (type : Expr) (value? : Option Expr := none) : MetaM (Array InteractiveHypothesisBundle) := do diff --git a/src/Lean/Widget/TaggedText.lean b/src/Lean/Widget/TaggedText.lean index ddb3cda569..b97e15348b 100644 --- a/src/Lean/Widget/TaggedText.lean +++ b/src/Lean/Widget/TaggedText.lean @@ -63,9 +63,9 @@ partial def rewriteM : TaggedText α → m (TaggedText β) | append as => return append (← as.mapM rewriteM) | tag t a => f t a -instance [RpcEncoding α β] : RpcEncoding (TaggedText α) (TaggedText β) where - rpcEncode a := a.mapM rpcEncode - rpcDecode a := a.mapM rpcDecode +instance [RpcEncodable α] : RpcEncodable (TaggedText α) where + rpcEncode a := toJson <$> a.mapM rpcEncode + rpcDecode a := do TaggedText.mapM rpcDecode (← fromJson? a) private structure TaggedState where out : TaggedText (Nat × Nat) := TaggedText.text "" diff --git a/tests/lean/derivingRpcEncoding.lean b/tests/lean/derivingRpcEncoding.lean index 4608ebbf6f..7008783919 100644 --- a/tests/lean/derivingRpcEncoding.lean +++ b/tests/lean/derivingRpcEncoding.lean @@ -2,30 +2,21 @@ import Lean.Server.Rpc.Basic open Lean Server -abbrev M := StateM (Array (Name × NonScalar)) +abbrev M := StateM RpcObjectStore -instance : MonadRpcSession M where - rpcStoreRef typeName obj := - (return ⟨(← get).size.toUSize⟩) <* modify (·.push (typeName, obj)) - rpcGetRef r := return (← get)[r.p]? - rpcReleaseRef _ := return false +def M.run (x : ExceptT String M α) : Except String α := + x.run' {} -def M.run (x : ExceptT String M α) : Except String α := x.run' #[] - -def test (α : Type) [RpcEncoding α β] [FromJson β] [ToJson β] (a : α) := M.run do - let json := toJson (← rpcEncode a) - let packet ← ofExcept (fromJson? (α := β) json) - let _ ← rpcDecode (α := α) packet +def test (α : Type) [RpcEncodable α] (a : α) := M.run do + let json ← rpcEncode a + let _a : α ← ofExcept (rpcDecode json (← get)) return json -@[reducible] -def rpcPacketFor (α : Type) {β : outParam Type} [RpcEncoding α β] := β - structure FooRef where a : Array Nat - deriving Inhabited, RpcEncoding with { withRef := true } + deriving Inhabited, Std.TypeName -#check instRpcEncodingWithRpcRefFooRefRpcRef +#check instTypeNameFooRef #eval test (WithRpcRef FooRef) default structure FooJson where @@ -35,75 +26,75 @@ structure FooJson where structure Bar where fooRef : WithRpcRef FooRef fooJson : FooJson - deriving RpcEncoding, Inhabited + deriving RpcEncodable, Inhabited -#check instRpcEncodingBar +#check instRpcEncodableBar #eval test Bar default structure BarTrans where bar : Bar - deriving RpcEncoding, Inhabited + deriving RpcEncodable, Inhabited -#check instRpcEncodingBarTrans +#check instRpcEncodableBarTrans #eval test BarTrans default structure Baz where arr : Array String -- non-constant field - deriving RpcEncoding, Inhabited + deriving RpcEncodable, Inhabited -#check instRpcEncodingBaz +#check instRpcEncodableBaz #eval test Baz default structure FooGeneric (α : Type) where a : α b? : Option α - deriving RpcEncoding, Inhabited + deriving RpcEncodable, Inhabited -#check instRpcEncodingFooGeneric +#check @instRpcEncodableFooGeneric #eval test (FooGeneric Nat) default #eval test (FooGeneric Nat) { a := 3, b? := some 42 } inductive BazInductive | baz (arr : Array Bar) - deriving RpcEncoding, Inhabited + deriving RpcEncodable, Inhabited -#check instRpcEncodingBazInductive +#check @instRpcEncodableBazInductive #eval test BazInductive ⟨#[default, default]⟩ inductive FooInductive (α : Type) where | a : α → WithRpcRef FooRef → FooInductive α | b : (n : Nat) → (a : α) → (m : Nat) → FooInductive α - deriving RpcEncoding, Inhabited + deriving RpcEncodable, Inhabited -#check instRpcEncodingFooInductive +#check @instRpcEncodableFooInductive #eval test (FooInductive BazInductive) (.a default default) #eval test (FooInductive BazInductive) (.b 42 default default) inductive FooNested (α : Type) where | a : α → Array (FooNested α) → FooNested α - deriving RpcEncoding, Inhabited + deriving RpcEncodable, Inhabited #eval test (FooNested BazInductive) (.a default #[default]) inductive FooParam (n : Nat) where | a : Nat → FooParam n - deriving RpcEncoding, Inhabited + deriving RpcEncodable, Inhabited -#check instRpcEncodingFooParam +#check @instRpcEncodableFooParam #eval test (FooParam 10) (.a 42) inductive Unused (α : Type) | a - deriving RpcEncoding, Inhabited + deriving RpcEncodable, Inhabited -#check instRpcEncodingUnused -structure NoRpcEncoding -#eval test (Unused NoRpcEncoding) default +#check @instRpcEncodableUnused +structure NoRpcEncodable +#eval test (Unused NoRpcEncodable) default structure UnusedStruct (α : Type) - deriving RpcEncoding, Inhabited + deriving RpcEncodable, Inhabited -#check instRpcEncodingUnusedStruct -#eval test (UnusedStruct NoRpcEncoding) default +#check @instRpcEncodableUnusedStruct +#eval test (UnusedStruct NoRpcEncodable) default -deriving instance Repr, RpcEncoding for Empty -#eval M.run do rpcDecode (α := Empty) (← fromJson? .null) +deriving instance Repr, RpcEncodable for Empty +#eval rpcDecode (α := Empty) .null {} diff --git a/tests/lean/derivingRpcEncoding.lean.expected.out b/tests/lean/derivingRpcEncoding.lean.expected.out index 281522e27f..c2e356e0ce 100644 --- a/tests/lean/derivingRpcEncoding.lean.expected.out +++ b/tests/lean/derivingRpcEncoding.lean.expected.out @@ -1,29 +1,27 @@ -instRpcEncodingWithRpcRefFooRefRpcRef : RpcEncoding (WithRpcRef FooRef) Lsp.RpcRef +instTypeNameFooRef : Std.TypeName FooRef ok: {"p": "0"} -instRpcEncodingBar : RpcEncoding Bar RpcEncodingPacket✝ +instRpcEncodableBar : RpcEncodable Bar ok: {"fooRef": {"p": "0"}, "fooJson": {"s": ""}} -instRpcEncodingBarTrans : RpcEncoding BarTrans RpcEncodingPacket✝ +instRpcEncodableBarTrans : RpcEncodable BarTrans ok: {"bar": {"fooRef": {"p": "0"}, "fooJson": {"s": ""}}} -instRpcEncodingBaz : RpcEncoding Baz RpcEncodingPacket✝ +instRpcEncodableBaz : RpcEncodable Baz ok: {"arr": []} -instRpcEncodingFooGeneric : (α αPacket : Type) → - [inst : RpcEncoding α αPacket] → RpcEncoding (FooGeneric α) (RpcEncodingPacket✝ αPacket) +@instRpcEncodableFooGeneric : {α : Type} → [inst : RpcEncodable α] → RpcEncodable (FooGeneric α) ok: {"a": 0} ok: {"b": 42, "a": 3} -instRpcEncodingBazInductive : RpcEncoding BazInductive RpcEncodingPacket✝ +instRpcEncodableBazInductive : RpcEncodable BazInductive ok: {"baz": {"arr": [{"fooRef": {"p": "0"}, "fooJson": {"s": ""}}, {"fooRef": {"p": "1"}, "fooJson": {"s": ""}}]}} -instRpcEncodingFooInductive : (α αPacket : Type) → - [inst : RpcEncoding α αPacket] → RpcEncoding (FooInductive α) (RpcEncodingPacket✝ αPacket) +@instRpcEncodableFooInductive : {α : Type} → [inst : RpcEncodable α] → RpcEncodable (FooInductive α) ok: {"a": [{"baz": {"arr": []}}, {"p": "0"}]} ok: {"b": {"n": 42, "m": 0, "a": {"baz": {"arr": []}}}} ok: {"a": [{"baz": {"arr": []}}, [{"a": [{"baz": {"arr": []}}, []]}]]} -instRpcEncodingFooParam : (n : Nat) → RpcEncoding (FooParam n) RpcEncodingPacket✝ +@instRpcEncodableFooParam : {n : Nat} → RpcEncodable (FooParam n) ok: {"a": 42} -instRpcEncodingUnused : (α : Type) → RpcEncoding (Unused α) RpcEncodingPacket✝ +@instRpcEncodableUnused : {α : Type} → RpcEncodable (Unused α) ok: "a" -instRpcEncodingUnusedStruct : (α : Type) → RpcEncoding (UnusedStruct α) RpcEncodingPacket✝ +@instRpcEncodableUnusedStruct : {α : Type} → RpcEncodable (UnusedStruct α) ok: {} Except.error "no inductive constructor matched"