feat: store detected Lean/Lake install in BuildContext
includes new `getLeanIncludeDir` for `BuildM` (leanprover/lake#18)
This commit is contained in:
parent
0196cbe6a3
commit
c32cd22504
2 changed files with 62 additions and 17 deletions
|
|
@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
|
|||
Authors: Mac Malone
|
||||
-/
|
||||
import Lake.Task
|
||||
import Lake.InstallPath
|
||||
|
||||
open System
|
||||
namespace Lake
|
||||
|
|
@ -19,6 +20,8 @@ constant BuildMethodsRefPointed : PointedType.{0}
|
|||
def BuildMethodsRef : Type := BuildMethodsRefPointed.type
|
||||
|
||||
structure BuildContext where
|
||||
leanInstall : LeanInstall
|
||||
lakeInstall : LakeInstall
|
||||
methodsRef : BuildMethodsRef
|
||||
|
||||
abbrev BuildM := ReaderT BuildContext IO
|
||||
|
|
@ -64,7 +67,7 @@ end BuildContext
|
|||
namespace BuildM
|
||||
|
||||
def getMethods : BuildM BuildMethods :=
|
||||
read >>= (·.methods)
|
||||
BuildContext.methods <$> read
|
||||
|
||||
def logInfo (msg : String) : BuildM PUnit := do
|
||||
(← getMethods).logInfo msg
|
||||
|
|
@ -72,6 +75,21 @@ def logInfo (msg : String) : BuildM PUnit := do
|
|||
def logError (msg : String) : BuildM PUnit := do
|
||||
(← getMethods).logError msg
|
||||
|
||||
def getLeanInstall : BuildM LeanInstall :=
|
||||
BuildContext.leanInstall <$> read
|
||||
|
||||
def getLeanIncludeDir : BuildM FilePath :=
|
||||
LeanInstall.includeDir <$> getLeanInstall
|
||||
|
||||
def getLeanc : BuildM FilePath :=
|
||||
LeanInstall.leanc <$> getLeanInstall
|
||||
|
||||
def getLean : BuildM FilePath :=
|
||||
LeanInstall.lean <$> getLeanInstall
|
||||
|
||||
def getLakeInstall : BuildM LakeInstall :=
|
||||
BuildContext.lakeInstall <$> read
|
||||
|
||||
def convErrors (self : BuildM α) : BuildM α := do
|
||||
try self catch e =>
|
||||
/-
|
||||
|
|
@ -89,6 +107,8 @@ def runIn (ctx : BuildContext) (self : BuildM α) : IO α :=
|
|||
|
||||
end BuildM
|
||||
|
||||
export BuildM (getLeanInstall getLeanIncludeDir getLean getLeanc getLakeInstall)
|
||||
|
||||
def failOnBuildCycle [ToString k] : Except (List k) α → BuildM α
|
||||
| Except.ok a => a
|
||||
| Except.error cycle => do
|
||||
|
|
|
|||
|
|
@ -129,17 +129,37 @@ def output (msg : String) : CliM UInt32 := do
|
|||
def execIO (x : IO α) : CliM UInt32 := do
|
||||
try Functor.mapConst 0 x catch e => error (toString e)
|
||||
|
||||
/--
|
||||
Get the install configuration of Lean and Lake.
|
||||
Error if either could not be detected.
|
||||
-/
|
||||
def getInstall : CliM (LeanInstall × LakeInstall) := do
|
||||
if let some leanInstall ← getLeanInstall? then
|
||||
if let some lakeInstall ← getLakeInstall? then
|
||||
return (leanInstall, lakeInstall)
|
||||
else
|
||||
throw <| IO.userError <|
|
||||
"could not detect the configuration of the Lake installation"
|
||||
else
|
||||
throw <| IO.userError <| "could not detect a Lean installation"
|
||||
|
||||
/--
|
||||
Perform the given build action and then return code 0.
|
||||
If it throws an error, invoke `error` with the the error's message.
|
||||
-/
|
||||
def execBuild (x : BuildM α) : CliM UInt32 := do
|
||||
execIO <| x.runIn {
|
||||
methodsRef := BuildMethodsRef.mk {
|
||||
logInfo := fun msg => IO.println msg
|
||||
logError := fun msg => IO.eprintln msg
|
||||
}
|
||||
}
|
||||
try
|
||||
let (leanInstall, lakeInstall) ← getInstall
|
||||
execIO do
|
||||
x.runIn {
|
||||
leanInstall, lakeInstall
|
||||
methodsRef := BuildMethodsRef.mk {
|
||||
logInfo := fun msg => IO.println msg
|
||||
logError := fun msg => IO.eprintln msg
|
||||
}
|
||||
}
|
||||
catch e =>
|
||||
error (toString e)
|
||||
|
||||
/-- Run the given script from the given package with the given arguments. -/
|
||||
def script (pkg : Package) (name : String) (args : List String) : CliM UInt32 := do
|
||||
|
|
@ -176,17 +196,22 @@ def verifyInstall : CliM UInt32 := do
|
|||
verifyLeanVersion
|
||||
|
||||
def printPaths (pkg : Package) (imports : List String := []) : CliM UInt32 :=
|
||||
execIO do
|
||||
let deps ← pkg.buildImportsAndDeps imports |>.runIn {
|
||||
methodsRef := BuildMethodsRef.mk {
|
||||
logInfo := fun msg => IO.eprintln msg
|
||||
logError := fun msg => IO.eprintln msg
|
||||
try
|
||||
let (leanInstall, lakeInstall) ← getInstall
|
||||
execIO do
|
||||
let deps ← pkg.buildImportsAndDeps imports |>.runIn {
|
||||
leanInstall, lakeInstall
|
||||
methodsRef := BuildMethodsRef.mk {
|
||||
logInfo := fun msg => IO.eprintln msg
|
||||
logError := fun msg => IO.eprintln msg
|
||||
}
|
||||
}
|
||||
}
|
||||
IO.println <| Json.compress <| Json.mkObj [
|
||||
("LEAN_PATH", SearchPath.toString <| pkg.oleanDir :: deps.map (·.oleanDir)),
|
||||
("LEAN_SRC_PATH", SearchPath.toString <| pkg.srcDir :: deps.map (·.srcDir))
|
||||
]
|
||||
IO.println <| Json.compress <| Json.mkObj [
|
||||
("LEAN_PATH", SearchPath.toString <| pkg.oleanDir :: deps.map (·.oleanDir)),
|
||||
("LEAN_SRC_PATH", SearchPath.toString <| pkg.srcDir :: deps.map (·.srcDir))
|
||||
]
|
||||
catch e =>
|
||||
error (toString e)
|
||||
|
||||
def command : (cmd : String) → CliM UInt32
|
||||
| "new" => do noArgsRem <| execIO <| new (← takeArg)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue