Skip to content

Commit

Permalink
refactor(pkg): move [variables] to [Dune_pkg] (#10816)
Browse files Browse the repository at this point in the history
Signed-off-by: Rudi Grinberg <[email protected]>
  • Loading branch information
rgrinberg authored Aug 11, 2024
1 parent 857ee98 commit ebd58f2
Show file tree
Hide file tree
Showing 3 changed files with 11 additions and 12 deletions.
9 changes: 9 additions & 0 deletions src/dune_pkg/lock_dir.ml
Original file line number Diff line number Diff line change
Expand Up @@ -40,6 +40,15 @@ module Pkg_info = struct
;;

let default_version = Package_version.of_string "dev"

let variables t =
let module Variable = OpamVariable in
Package_variable_name.Map.of_list_exn
[ Package_variable_name.name, Variable.S (Package_name.to_string t.name)
; Package_variable_name.version, S (Package_version.to_string t.version)
; Package_variable_name.dev, B t.dev
]
;;
end

module Build_command = struct
Expand Down
1 change: 1 addition & 0 deletions src/dune_pkg/lock_dir.mli
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ module Pkg_info : sig
}

val default_version : Package_version.t
val variables : t -> OpamVariable.variable_contents Package_variable_name.Map.t
end

module Build_command : sig
Expand Down
13 changes: 1 addition & 12 deletions src/dune_rules/pkg_rules.ml
Original file line number Diff line number Diff line change
Expand Up @@ -10,6 +10,7 @@ include struct
module Source = Source
module Build_command = Lock_dir.Build_command
module Display = Dune_engine.Display
module Pkg_info = Lock_dir.Pkg_info
end

module Variable = struct
Expand Down Expand Up @@ -46,18 +47,6 @@ module Variable = struct
;;
end

module Pkg_info = struct
include Dune_pkg.Lock_dir.Pkg_info

let variables t =
Package_variable_name.Map.of_list_exn
[ Package_variable_name.name, Variable.S (Package.Name.to_string t.name)
; Package_variable_name.version, S (Package_version.to_string t.version)
; Package_variable_name.dev, B t.dev
]
;;
end

module Paths = struct
(* The [paths] of a package are the information about the artifacts
that we know {e without} executing any commands. *)
Expand Down

0 comments on commit ebd58f2

Please sign in to comment.