load level

server/leanserver/GameServer/EnvExtensions.lean

@@ -16,7 +16,7 @@ open Lean
 structure GoalMessageEntry where
   ctx_size : Nat
   normalized_goal : Expr
-  intro_nb : Nat 
+  intro_nb : Nat
   message : String
   deriving Repr
 
@@ -37,7 +37,7 @@ initialize tacticDocExt : SimplePersistentEnvExtension TacticDocEntry (Array Tac
 
 open Elab Command in
 /-- Print a registered tactic doc for debugging purposes. -/
-elab "#print_tactic_doc" : command => do 
+elab "#print_tactic_doc" : command => do
   for entry in tacticDocExt.getState (← getEnv) do
     dbg_trace "{entry.name} : {entry.content}"
 
@@ -56,7 +56,7 @@ initialize tacticSetExt : SimplePersistentEnvExtension TacticSetEntry (Array Tac
 
 open Elab Command in
 /-- Print all registered tactic sets for debugging purposes. -/
-elab "#print_tactic_set" : command => do 
+elab "#print_tactic_set" : command => do
   for entry in tacticSetExt.getState (← getEnv) do
     dbg_trace "{entry.name} : {entry.tactics.map TacticDocEntry.name}"
 
@@ -79,7 +79,7 @@ initialize lemmaDocExt : SimplePersistentEnvExtension LemmaDocEntry (Array Lemma
 
 open Elab Command in
 /-- Print a lemma doc for debugging purposes. -/
-elab "#print_lemma_doc" : command => do 
+elab "#print_lemma_doc" : command => do
   for entry in lemmaDocExt.getState (← getEnv) do
     dbg_trace "{entry.userName} ({entry.name}) in {entry.category}: {entry.content}"
 
@@ -99,7 +99,7 @@ initialize lemmaSetExt : SimplePersistentEnvExtension LemmaSetEntry (Array Lemma
 
 open Elab Command in
 /-- Print all registered lemma sets for debugging purposes. -/
-elab "#print_lemma_set" : command => do 
+elab "#print_lemma_set" : command => do
   for entry in lemmaSetExt.getState (← getEnv) do
     dbg_trace "{entry.name} : {entry.lemmas.map LemmaDocEntry.name}"
 
@@ -123,7 +123,7 @@ initialize curLevelExt : EnvExtension Nat ← registerEnvExtension (pure 0)
 
 variable {m: Type → Type} [Monad m] [MonadEnv m]
 
-def setCurLevelIdx (lvl : Nat) :  m Unit := 
+def setCurLevelIdx (lvl : Nat) :  m Unit :=
   modifyEnv (curLevelExt.setState · lvl)
 
 def getCurLevelIdx :  m Nat := do
@@ -148,4 +148,3 @@ def getCurLevel [MonadError m] :  m GameLevel := do
   match (← levelsExt.find? idx) with
   | some level => return level
   | none => throwError "Couldn't find level {idx}"
-

server/leanserver/GameServer/Game.lean

@@ -1,50 +1,58 @@
 import Lean
 import GameServer.EnvExtensions
 
-namespace Game
+
 open Lean
+
+structure GameServerState :=
+(env : Lean.Environment)
+
+abbrev GameServerM := StateT GameServerState Server.Watchdog.ServerM
+
+instance : MonadEnv GameServerM := {
+  getEnv := do return (← get).env
+  modifyEnv := fun f => do
+    let s ← get
+    set {s with env := f s.env}
+}
+
+namespace Game
 open Server
 open Watchdog
 open Lsp
 open JsonRpc
+open IO
 
-/-- Dummy `Core.Context` value to be fed to `Lean.Core.CoreM.toIO` -/
-def coreCtx : Core.Context := {
-  currNamespace := Name.anonymous,
-  openDecls := [],
-  fileName := "<Game>",
-  fileMap := { source := "", positions := #[0], lines := #[1] } }
+structure LevelInfo where
+  index : Nat
+  title : String
+  tactics: Array TacticDocEntry
+  lemmas: Array LemmaDocEntry
+deriving ToJson
 
-partial def handleServerEvent (ev : ServerEvent) : ServerM Bool := do
+partial def handleServerEvent (ev : ServerEvent) : GameServerM Bool := do
   match ev with
   | ServerEvent.clientMsg msg =>
     match msg with
     | Message.request id "info" _ =>
-
-      let gameDir := "testgame"
-
-      -- Determine search paths of the game project by running `lake env printenv LEAN_PATH`.
-      let out ← IO.Process.output
-        { cwd := gameDir, cmd := "lake", args := #["env","printenv","LEAN_PATH"] }
-      if out.exitCode != 0 then
-        IO.eprintln out.stderr
-        return true
-
-      -- Make the paths relative to the current directory
-      let paths : List System.FilePath := System.SearchPath.parse out.stdout.trim
-      let currentDir ← IO.currentDir
-      let paths := paths.map fun p => currentDir / (gameDir : System.FilePath) / p
-
-      -- Set the search path
-      Lean.searchPathRef.set paths
-
-      let hOut := (← read).hOut
-      let gameName := `TestGame
-      let env ← importModules [{ module := `Init : Import }, { module := gameName : Import }] {} 0
-      discard <| Core.CoreM.toIO (ctx := coreCtx) (s := { env := env }) do
-        let levels := levelsExt.getState env
-        let game := {← gameExt.get with nb_levels := levels.size }
-        hOut.writeLspResponse ⟨id, game⟩
+      let s ← get
+      let c ← read
+      let levels := levelsExt.getState s.env
+      let game := {← gameExt.get with nb_levels := levels.size }
+      c.hOut.writeLspResponse ⟨id, game⟩
+      return true
+    | Message.request id "loadLevel" _ =>
+      let idx := 1
+      let s ← get
+      let c ← read
+      let levels := levelsExt.getState s.env
+      let some lvl := levels.find? idx | throwServerError s!"Cannot find level {idx}"
+      let levelInfo : LevelInfo :=
+          { index := lvl.index,
+            title := lvl.title,
+            tactics := lvl.tactics,
+            lemmas := lvl.lemmas }
+      c.hOut.writeLspResponse ⟨id, ToJson.toJson levelInfo⟩
       return true
     | _ => return false
   | _ => return false

server/leanserver/GameServer/Watchdog.lean

@@ -11,7 +11,7 @@ open Lsp
 open JsonRpc
 open System.Uri
 
-  partial def mainLoop (clientTask : Task ServerEvent) : ServerM Unit := do
+  partial def mainLoop (clientTask : Task ServerEvent) : GameServerM Unit := do
     let st ← read
     let workers ← st.fileWorkersRef.get
     let mut workerTasks := #[]
@@ -90,7 +90,7 @@ open System.Uri
         | WorkerEvent.terminated =>
           throwServerError "Internal server error: got termination event for worker that should have been removed"
 
-def initAndRunWatchdogAux : ServerM Unit := do
+def initAndRunWatchdogAux : GameServerM Unit := do
   let st ← read
   try
     discard $ st.hIn.readLspNotificationAs "initialized" InitializedParams
@@ -106,6 +106,27 @@ def initAndRunWatchdogAux : ServerM Unit := do
     catch _ => pure (Message.notification "exit" none)
     | throwServerError "Got `shutdown` request, expected an `exit` notification"
 
+def createEnv : IO Environment := do
+  let gameDir := "testgame"
+
+  -- Determine search paths of the game project by running `lake env printenv LEAN_PATH`.
+  let out ← IO.Process.output
+    { cwd := gameDir, cmd := "lake", args := #["env","printenv","LEAN_PATH"] }
+  if out.exitCode != 0 then
+    throwServerError s!"Error while running Lake: {out.stderr}"
+
+  -- Make the paths relative to the current directory
+  let paths : List System.FilePath := System.SearchPath.parse out.stdout.trim
+  let currentDir ← IO.currentDir
+  let paths := paths.map fun p => currentDir / (gameDir : System.FilePath) / p
+
+  -- Set the search path
+  Lean.searchPathRef.set paths
+
+  let gameName := `TestGame
+  let env ← importModules [{ module := `Init : Import }, { module := gameName : Import }] {} 0
+  return env
+
 def initAndRunWatchdog (args : List String) (i o e : FS.Stream) : IO Unit := do
   -- TODO: Do the following commands slow us down?
   let workerPath ← findWorkerPath
@@ -127,7 +148,8 @@ def initAndRunWatchdog (args : List String) (i o e : FS.Stream) : IO Unit := do
       : InitializeResult
     }
   }
-  ReaderT.run initAndRunWatchdogAux {
+  let state := {env := ← createEnv}
+  let context : ServerContext := {
     hIn            := i
     hOut           := o
     hLog           := e
@@ -138,8 +160,8 @@ def initAndRunWatchdog (args : List String) (i o e : FS.Stream) : IO Unit := do
     workerPath
     srcSearchPath
     references
-    : ServerContext
   }
+  discard $ ReaderT.run (StateT.run initAndRunWatchdogAux state) context
 
 def watchdogMain (args : List String) : IO UInt32 := do
   let i ← IO.getStdin