Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add monadic interface to solver #52

Draft
wants to merge 2 commits into
base: master
Choose a base branch
from
Draft

Add monadic interface to solver #52

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
7847127
Add monadic interface to solver
Leonidas-from-XIV Oct 16, 2023
59c32b0
Remove complicated functor creation, use simpler module inclusion
Leonidas-from-XIV Oct 17, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
256 changes: 133 additions & 123 deletions lib/dir_context.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,124 +1,134 @@
type rejection =
| UserConstraint of OpamFormula.atom
| Unavailable

let ( / ) = Filename.concat

let with_dir path fn =
let ch = Unix.opendir path in
Fun.protect ~finally:(fun () -> Unix.closedir ch)
(fun () -> fn ch)

let list_dir path =
let rec aux acc ch =
match Unix.readdir ch with
| name -> aux (name :: acc) ch
| exception End_of_file -> acc
in
with_dir path (aux [])

type t = {
env : string -> OpamVariable.variable_contents option;
packages_dir : string;
pins : (OpamPackage.Version.t * OpamFile.OPAM.t) OpamPackage.Name.Map.t;
constraints : OpamFormula.version_constraint OpamTypes.name_map; (* User-provided constraints *)
test : OpamPackage.Name.Set.t;
prefer_oldest : bool;
}

let load t pkg =
let { OpamPackage.name; version = _ } = pkg in
match OpamPackage.Name.Map.find_opt name t.pins with
| Some (_, opam) -> opam
| None ->
let opam_path = t.packages_dir / OpamPackage.Name.to_string name / OpamPackage.to_string pkg / "opam" in
OpamFile.OPAM.read (OpamFile.make (OpamFilename.raw opam_path))

let user_restrictions t name =
OpamPackage.Name.Map.find_opt name t.constraints

let dev = OpamPackage.Version.of_string "dev"

let std_env
?(ocaml_native=true)
?sys_ocaml_version
?opam_version
~arch ~os ~os_distribution ~os_family ~os_version
() =
function
| "arch" -> Some (OpamTypes.S arch)
| "os" -> Some (OpamTypes.S os)
| "os-distribution" -> Some (OpamTypes.S os_distribution)
| "os-version" -> Some (OpamTypes.S os_version)
| "os-family" -> Some (OpamTypes.S os_family)
| "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version))
| "sys-ocaml-version" -> sys_ocaml_version |> Option.map (fun v -> OpamTypes.S v)
| "ocaml:native" -> Some (OpamTypes.B ocaml_native)
| "enable-ocaml-beta-repository" -> None (* Fake variable? *)
| v ->
OpamConsole.warning "Unknown variable %S" v;
None

let env t pkg v =
if List.mem v OpamPackageVar.predefined_depends_variables then None
else match OpamVariable.Full.to_string v with
| "version" -> Some (OpamTypes.S (OpamPackage.Version.to_string (OpamPackage.version pkg)))
| x -> t.env x

let filter_deps t pkg f =
let dev = OpamPackage.Version.compare (OpamPackage.version pkg) dev = 0 in
let test = OpamPackage.Name.Set.mem (OpamPackage.name pkg) t.test in
f
|> OpamFilter.partial_filter_formula (env t pkg)
|> OpamFilter.filter_deps ~build:true ~post:true ~test ~doc:false ~dev ~default:false

let version_compare t v1 v2 =
if t.prefer_oldest then
OpamPackage.Version.compare v1 v2
else
OpamPackage.Version.compare v2 v1

let candidates t name =
match OpamPackage.Name.Map.find_opt name t.pins with
| Some (version, opam) -> [version, Ok opam]
| None ->
let versions_dir = t.packages_dir / OpamPackage.Name.to_string name in
match list_dir versions_dir with
| versions ->
let user_constraints = user_restrictions t name in
versions
|> List.filter_map (fun dir ->
match OpamPackage.of_string_opt dir with
| Some pkg when Sys.file_exists (versions_dir / dir / "opam") -> Some (OpamPackage.version pkg)
| _ -> None
)
|> List.sort (version_compare t)
|> List.map (fun v ->
match user_constraints with
| Some test when not (OpamFormula.check_version_formula (OpamFormula.Atom test) v) ->
v, Error (UserConstraint (name, Some test))
| _ ->
let pkg = OpamPackage.create name v in
let opam = load t pkg in
let available = OpamFile.OPAM.available opam in
match OpamFilter.eval ~default:(B false) (env t pkg) available with
| B true -> v, Ok opam
| B false -> v, Error Unavailable
module Dir_context (M: S.MONAD) = struct
module M = M

type rejection =
| UserConstraint of OpamFormula.atom
| Unavailable

let ( / ) = Filename.concat

let with_dir path fn =
let ch = Unix.opendir path in
Fun.protect ~finally:(fun () -> Unix.closedir ch)
(fun () -> fn ch)

let list_dir path =
let rec aux acc ch =
match Unix.readdir ch with
| name -> aux (name :: acc) ch
| exception End_of_file -> acc
in
with_dir path (aux [])

type t = {
env : string -> OpamVariable.variable_contents option;
packages_dir : string;
pins : (OpamPackage.Version.t * OpamFile.OPAM.t) OpamPackage.Name.Map.t;
constraints : OpamFormula.version_constraint OpamTypes.name_map; (* User-provided constraints *)
test : OpamPackage.Name.Set.t;
prefer_oldest : bool;
}

let load t pkg =
let { OpamPackage.name; version = _ } = pkg in
match OpamPackage.Name.Map.find_opt name t.pins with
| Some (_, opam) -> opam
| None ->
let opam_path = t.packages_dir / OpamPackage.Name.to_string name / OpamPackage.to_string pkg / "opam" in
OpamFile.OPAM.read (OpamFile.make (OpamFilename.raw opam_path))

let user_restrictions t name =
OpamPackage.Name.Map.find_opt name t.constraints

let user_restrictions t name =
M.return @@ user_restrictions t name

let dev = OpamPackage.Version.of_string "dev"

let std_env
?(ocaml_native=true)
?sys_ocaml_version
?opam_version
~arch ~os ~os_distribution ~os_family ~os_version
() =
function
| "arch" -> Some (OpamTypes.S arch)
| "os" -> Some (OpamTypes.S os)
| "os-distribution" -> Some (OpamTypes.S os_distribution)
| "os-version" -> Some (OpamTypes.S os_version)
| "os-family" -> Some (OpamTypes.S os_family)
| "opam-version" -> Some (OpamVariable.S (Option.value ~default:OpamVersion.(to_string current) opam_version))
| "sys-ocaml-version" -> sys_ocaml_version |> Option.map (fun v -> OpamTypes.S v)
| "ocaml:native" -> Some (OpamTypes.B ocaml_native)
| "enable-ocaml-beta-repository" -> None (* Fake variable? *)
| v ->
OpamConsole.warning "Unknown variable %S" v;
None

let env t pkg v =
if List.mem v OpamPackageVar.predefined_depends_variables then None
else match OpamVariable.Full.to_string v with
| "version" -> Some (OpamTypes.S (OpamPackage.Version.to_string (OpamPackage.version pkg)))
| x -> t.env x

let filter_deps t pkg f =
let dev = OpamPackage.Version.compare (OpamPackage.version pkg) dev = 0 in
let test = OpamPackage.Name.Set.mem (OpamPackage.name pkg) t.test in
f
|> OpamFilter.partial_filter_formula (env t pkg)
|> OpamFilter.filter_deps ~build:true ~post:true ~test ~doc:false ~dev ~default:false
|> M.return

let version_compare t v1 v2 =
if t.prefer_oldest then
OpamPackage.Version.compare v1 v2
else
OpamPackage.Version.compare v2 v1

let (>>=) = M.(>>=)

let candidates t name =
match OpamPackage.Name.Map.find_opt name t.pins with
| Some (version, opam) -> M.return [version, Ok opam]
| None ->
let versions_dir = t.packages_dir / OpamPackage.Name.to_string name in
match list_dir versions_dir with
| versions ->
user_restrictions t name >>= (fun user_constraints ->
versions
|> List.filter_map (fun dir ->
match OpamPackage.of_string_opt dir with
| Some pkg when Sys.file_exists (versions_dir / dir / "opam") -> Some (OpamPackage.version pkg)
| _ -> None
)
|> List.sort (version_compare t)
|> List.map (fun v ->
match user_constraints with
| Some test when not (OpamFormula.check_version_formula (OpamFormula.Atom test) v) ->
v, Error (UserConstraint (name, Some test))
| _ ->
OpamConsole.error "Available expression not a boolean: %s" (OpamFilter.to_string available);
v, Error Unavailable
)
| exception Unix.Unix_error (Unix.ENOENT, _, _) ->
OpamConsole.log "opam-0install" "Package %S not found!" (OpamPackage.Name.to_string name);
[]

let pp_rejection f = function
| UserConstraint x -> Fmt.pf f "Rejected by user-specified constraint %s" (OpamFormula.string_of_atom x)
| Unavailable -> Fmt.string f "Availability condition not satisfied"

let create
?(prefer_oldest=false)
?(test=OpamPackage.Name.Set.empty)
?(pins=OpamPackage.Name.Map.empty)
~constraints ~env packages_dir =
{ env; packages_dir; pins; constraints; test; prefer_oldest }
let pkg = OpamPackage.create name v in
let opam = load t pkg in
let available = OpamFile.OPAM.available opam in
match OpamFilter.eval ~default:(B false) (env t pkg) available with
| B true -> v, Ok opam
| B false -> v, Error Unavailable
| _ ->
OpamConsole.error "Available expression not a boolean: %s" (OpamFilter.to_string available);
v, Error Unavailable)
|> M.return)
| exception Unix.Unix_error (Unix.ENOENT, _, _) ->
OpamConsole.log "opam-0install" "Package %S not found!" (OpamPackage.Name.to_string name);
M.return []

let pp_rejection f = function
| UserConstraint x -> Fmt.pf f "Rejected by user-specified constraint %s" (OpamFormula.string_of_atom x)
| Unavailable -> Fmt.string f "Availability condition not satisfied"

let create
?(prefer_oldest=false)
?(test=OpamPackage.Name.Set.empty)
?(pins=OpamPackage.Name.Map.empty)
~constraints ~env packages_dir =
{ env; packages_dir; pins; constraints; test; prefer_oldest }
end
76 changes: 39 additions & 37 deletions lib/dir_context.mli
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,42 +3,44 @@
It also does not get any opam variables from the environment - instead, the caller
must provide them explicitly. *)

include S.CONTEXT
module Dir_context (M : S.MONAD) : sig
include S.CONTEXT

val std_env :
?ocaml_native:bool ->
?sys_ocaml_version:string ->
?opam_version:string ->
arch:string ->
os:string ->
os_distribution:string ->
os_family:string ->
os_version:string ->
unit ->
(string -> OpamVariable.variable_contents option)
(** [std_env ~arch ~os ~os_distribution ~os_family ~os_version] is an
environment function that returns the given values for the standard opam
variables, and [None] for anything else.
If [opam_version] is not provided, use the version of the linked opam
library. *)
val std_env :
?ocaml_native:bool ->
?sys_ocaml_version:string ->
?opam_version:string ->
arch:string ->
os:string ->
os_distribution:string ->
os_family:string ->
os_version:string ->
unit ->
(string -> OpamVariable.variable_contents option)
(** [std_env ~arch ~os ~os_distribution ~os_family ~os_version] is an
environment function that returns the given values for the standard opam
variables, and [None] for anything else.
If [opam_version] is not provided, use the version of the linked opam
library. *)

val create :
?prefer_oldest:bool ->
?test:OpamPackage.Name.Set.t ->
?pins:(OpamTypes.version * OpamFile.OPAM.t) OpamTypes.name_map ->
constraints:OpamFormula.version_constraint OpamTypes.name_map ->
env:(string -> OpamVariable.variable_contents option) ->
string ->
t
(** [create ~constraints ~env packages_dir] is a solver that gets candidates
from [packages_dir], filtering them using [constraints]. [packages_dir] contains
one sub-directory for each package name, each with subdirectories for each version, in
the same format used by opam-repository.
@param test Packages for which we should include "with-test" dependencies.
@param pins Packages in this map have only the given candidate version and opam file.
@param env Maps opam variable names to values ({!std_env} may be useful here).
"version" and the [OpamPackageVar.predefined_depends_variables] are handled automatically.
@param prefer_oldest if [true] the solver is set to return the least
up-to-date version of each package, if a solution exists. This is [false] by
default.
@before 0.4 the [prefer_oldest] parameter did not exist. *)
val create :
?prefer_oldest:bool ->
?test:OpamPackage.Name.Set.t ->
?pins:(OpamTypes.version * OpamFile.OPAM.t) OpamTypes.name_map ->
constraints:OpamFormula.version_constraint OpamTypes.name_map ->
env:(string -> OpamVariable.variable_contents option) ->
string ->
t
(** [create ~constraints ~env packages_dir] is a solver that gets candidates
from [packages_dir], filtering them using [constraints]. [packages_dir] contains
one sub-directory for each package name, each with subdirectories for each version, in
the same format used by opam-repository.
@param test Packages for which we should include "with-test" dependencies.
@param pins Packages in this map have only the given candidate version and opam file.
@param env Maps opam variable names to values ({!std_env} may be useful here).
"version" and the [OpamPackageVar.predefined_depends_variables] are handled automatically.
@param prefer_oldest if [true] the solver is set to return the least
up-to-date version of each package, if a solution exists. This is [false] by
default.
@before 0.4 the [prefer_oldest] parameter did not exist. *)
end
Loading