diff --git a/client/src/components/Level.tsx b/client/src/components/Level.tsx index ebdd271..7f43d34 100644 --- a/client/src/components/Level.tsx +++ b/client/src/components/Level.tsx @@ -40,14 +40,14 @@ function Level({ rpcConnection, nbLevels, level, setCurLevel, setLevelTitle, set const processResponse = (res:any) => { setLeanData(res); - setErrors(res.errors); - if (res.message !== "" && res.errors?.length === 0) { - setMessage(res.message) - setMessageOpen(true) - } - if (res.goals?.length === 0 && res.errors?.length === 0) { - setCompleted(true) - } + // setErrors(res.errors); + // if (res.message !== "" && res.errors?.length === 0) { + // setMessage(res.message) + // setMessageOpen(true) + // } + // if (res.goals?.length === 0 && res.errors?.length === 0) { + // setCompleted(true) + // } } // The next function will be called when the level changes diff --git a/server/leanserver/GameServer/EnvExtensions.lean b/server/leanserver/GameServer/EnvExtensions.lean index 7bddb97..cbef586 100644 --- a/server/leanserver/GameServer/EnvExtensions.lean +++ b/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}" - diff --git a/server/leanserver/GameServer/Game.lean b/server/leanserver/GameServer/Game.lean index 7b4497a..bb6d832 100644 --- a/server/leanserver/GameServer/Game.lean +++ b/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 := "", - 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 diff --git a/server/leanserver/GameServer/Watchdog.lean b/server/leanserver/GameServer/Watchdog.lean index 0474bac..7c20e59 100644 --- a/server/leanserver/GameServer/Watchdog.lean +++ b/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