|
|
import Lean
|
|
|
import GameServer.EnvExtensions
|
|
|
|
|
|
open Lean
|
|
|
open Server
|
|
|
open Widget
|
|
|
open RequestM
|
|
|
open Meta
|
|
|
|
|
|
|
|
|
/-! ## GameGoal -/
|
|
|
|
|
|
structure GameLocalDecl where
|
|
|
userName : Name
|
|
|
type : String
|
|
|
deriving FromJson, ToJson
|
|
|
|
|
|
structure GameGoal where
|
|
|
objects : List GameLocalDecl
|
|
|
assumptions : List GameLocalDecl
|
|
|
goal : String
|
|
|
messages : Array String
|
|
|
deriving FromJson, ToJson
|
|
|
|
|
|
|
|
|
def Lean.MVarId.toGameGoal (goal : MVarId) (messages : Array String) : MetaM GameGoal := do
|
|
|
match (← getMCtx).findDecl? goal with
|
|
|
| none => throwError "unknown goal"
|
|
|
| some mvarDecl => do
|
|
|
-- toGameGoalAux below will sort local declarations from the context of goal into data and assumptions,
|
|
|
-- discarding auxilliary declarations
|
|
|
let rec toGameGoalAux : List (Option LocalDecl) → MetaM (List LocalDecl × List LocalDecl)
|
|
|
| (some decl)::t => withLCtx mvarDecl.lctx mvarDecl.localInstances do
|
|
|
let (o, a) ← toGameGoalAux t
|
|
|
if decl.isAuxDecl then
|
|
|
return (o, a)
|
|
|
if (← inferType decl.type).isProp then
|
|
|
return (o, decl::a)
|
|
|
else
|
|
|
return (decl::o, a)
|
|
|
| none:: t => toGameGoalAux t
|
|
|
| [] => return ([], [])
|
|
|
withLCtx mvarDecl.lctx mvarDecl.localInstances do
|
|
|
let (objects, assumptions) ← toGameGoalAux mvarDecl.lctx.decls.toList
|
|
|
let objects ← objects.mapM fun decl => do
|
|
|
return { userName := decl.userName, type := toString (← Meta.ppExpr decl.type) }
|
|
|
let assumptions ← assumptions.mapM fun decl => do
|
|
|
return { userName := decl.userName, type := toString (← Meta.ppExpr decl.type) }
|
|
|
return {objects := objects, assumptions := assumptions, goal := toString (← Meta.ppExpr mvarDecl.type), messages }
|
|
|
|
|
|
|
|
|
namespace GameServer
|
|
|
|
|
|
|
|
|
/-- `Game.getGoals` client<-server reply. -/
|
|
|
structure PlainGoal where
|
|
|
/-- The pretty-printed goals, empty if all accomplished. -/
|
|
|
goals : Array GameGoal
|
|
|
deriving FromJson, ToJson
|
|
|
|
|
|
-- TODO: Find a better way to pass on the file name?
|
|
|
def levelIdFromFileName [Monad m] [MonadError m] [MonadEnv m] (fileName : String) : m Nat := do
|
|
|
if fileName.startsWith "/level" then
|
|
|
if let some id := (fileName.drop "/level".length).toNat? then
|
|
|
return id
|
|
|
throwError s!"Could not find level ID in file name: {fileName}"
|
|
|
return 1
|
|
|
|
|
|
def getLevelByFileName [Monad m] [MonadError m] [MonadEnv m] (fileName : String) : m GameLevel := do
|
|
|
let levelId ← levelIdFromFileName fileName
|
|
|
-- TODO: make world and game configurable
|
|
|
let some level ← getLevel? {game := `TestGame, world := `TestWorld, level := levelId}
|
|
|
| throwError "Level not found"
|
|
|
return level
|
|
|
|
|
|
open Meta in
|
|
|
/-- Find all messages whose trigger matches the current goal -/
|
|
|
def findMessages (goal : MVarId) (doc : FileWorker.EditableDocument) : MetaM (Array String) := do
|
|
|
let level ← getLevelByFileName doc.meta.mkInputContext.fileName
|
|
|
let messages ← level.messages.filterMapM fun message => do
|
|
|
let (declMvars, binderInfo, messageGoal) ← forallMetaBoundedTelescope message.goal message.intros
|
|
|
if ← isDefEq messageGoal (← inferType $ mkMVar goal) -- TODO: also check assumptions
|
|
|
then return some message.message
|
|
|
else return none
|
|
|
return messages
|
|
|
|
|
|
/-- Get goals and messages at a given position -/
|
|
|
def getGoals (p : Lsp.PlainGoalParams) : RequestM (RequestTask (Option PlainGoal)) := do
|
|
|
let doc ← readDoc
|
|
|
let text := doc.meta.text
|
|
|
let hoverPos := text.lspPosToUtf8Pos p.position
|
|
|
-- TODO: I couldn't find a good condition to find the correct snap. So we are looking
|
|
|
-- for the first snap with goals here:
|
|
|
withWaitFindSnap doc (fun s => ¬ (s.infoTree.goalsAt? doc.meta.text hoverPos).isEmpty)
|
|
|
(notFoundX := return none) fun snap => do
|
|
|
if let rs@(_ :: _) := snap.infoTree.goalsAt? doc.meta.text hoverPos then
|
|
|
let goals ← rs.mapM fun { ctxInfo := ci, tacticInfo := ti, useAfter := useAfter, .. } => do
|
|
|
let ci := if useAfter then { ci with mctx := ti.mctxAfter } else { ci with mctx := ti.mctxBefore }
|
|
|
let goals := List.toArray <| if useAfter then ti.goalsAfter else ti.goalsBefore
|
|
|
let goals ← ci.runMetaM {} $ goals.mapM fun goal => do
|
|
|
let messages ← findMessages goal doc
|
|
|
return ← goal.toGameGoal messages
|
|
|
return goals
|
|
|
return some { goals := goals.foldl (· ++ ·) ∅ }
|
|
|
else
|
|
|
return none
|
|
|
|
|
|
builtin_initialize
|
|
|
registerBuiltinRpcProcedure
|
|
|
`Game.getGoals
|
|
|
Lsp.PlainGoalParams
|
|
|
(Option PlainGoal)
|
|
|
getGoals
|
|
|
|
|
|
end GameServer
|