Add support for ${lib-available:<name>} forms

CHANGES.org

@@ -1,3 +1,8 @@
+* next
+
+- Added =${lib-available:<library-name>}= which expands to =true= or
+ =false= with the same semantic as literals in =(select ...)= stanzas
+
 * 1.0+beta7 (12/04/2017)
 
 - Make the output quieter by default and add a =--verbose= argument

doc/manual.org

@@ -693,6 +693,12 @@ In addition, =(action ...)= fields support the following special variables:
 - =libexec:<public-library-name>:<file>= is the same as =lib:...=
   except when cross-compiling, in which case it will expand to the
   file from the host build context
+- =lib-available:<library-name>= expands to =true= or =false=
+  depending on wether the library is available or not. A library is
+  available iff at least one of the following condition holds:
+  + it is part the installed worlds
+  + it is available locally and is not optional
+  + it is available locally and all its library dependencies are available
 
 The =${<kind>:...}= forms are what allows you to write custom rules
 that work transparently whether things are installed or not.

src/build.ml

@@ -52,6 +52,9 @@ let merge_lib_deps a b =
 let arr f = Arr f
 let return x = Arr (fun () -> x)
 
+let record_lib_deps_simple ~dir lib_deps =
+  Record_lib_deps (dir, lib_deps)
+
 let record_lib_deps ~dir ~kind lib_deps =
   Record_lib_deps
     (dir,

src/build.mli

@@ -96,6 +96,8 @@ val record_lib_deps
 
 type lib_deps = lib_dep_kind String_map.t
 
+val record_lib_deps_simple : dir:Path.t -> lib_deps -> ('a, 'a) t
+
 (**/**)
 
 

src/gen_rules.ml

@@ -239,6 +239,8 @@ module Gen(P : Params) = struct
     let internal_libs_without_non_installable_optional_ones =
       internal_libs_without_non_installable_optional_ones t
 
+    let lib_is_available ~from name = lib_is_available t ~from name
+
     let select_rules ~dir lib_deps =
       List.map (Lib_db.resolve_selects t ~from:dir lib_deps) ~f:(fun { dst_fn; src_fn } ->
         let src = Path.relative dir src_fn in
@@ -543,18 +545,18 @@ module Gen(P : Params) = struct
 
     type resolved_forms =
       { (* Mapping from ${...} forms to their resolutions *)
-        artifacts : Path.t String_map.t
+        artifacts : Action.var_expansion String_map.t
       ; (* Failed resolutions *)
         failures  : fail list
-      ; (* All "name" for ${lib:name:...} forms *)
-        lib_deps  : String_set.t
+      ; (* All "name" for ${lib:name:...}/${lib-available:name} forms *)
+        lib_deps  : Build.lib_deps
       }
 
     let add_artifact ?lib_dep acc ~var result =
       let lib_deps =
         match lib_dep with
         | None -> acc.lib_deps
-        | Some lib -> String_set.add lib acc.lib_deps
+        | Some (lib, kind) -> String_map.add acc.lib_deps ~key:lib ~data:kind
       in
       match result with
       | Ok path ->
@@ -568,27 +570,34 @@ module Gen(P : Params) = struct
         ; lib_deps
         }
 
-    let extract_artifacts ~dir t =
+    let map_result = function
+      | Ok x -> Ok (Action.Path x)
+      | Error _ as e -> e
+
+    let extract_artifacts ~dir ~dep_kind t =
       let init =
         { artifacts = String_map.empty
         ; failures  = []
-        ; lib_deps  = String_set.empty
+        ; lib_deps  = String_map.empty
         }
       in
       U.fold_vars t ~init ~f:(fun acc var ->
         let module A = Artifacts in
         match String.lsplit2 var ~on:':' with
-        | Some ("exe"     , s) -> add_artifact acc ~var (Ok (Path.relative dir s))
-        | Some ("path"    , s) -> add_artifact acc ~var (Ok (Path.relative dir s))
-        | Some ("bin"     , s) -> add_artifact acc ~var (A.binary s)
+        | Some ("exe"     , s) -> add_artifact acc ~var (Ok (Path (Path.relative dir s)))
+        | Some ("path"    , s) -> add_artifact acc ~var (Ok (Path (Path.relative dir s)))
+        | Some ("bin"     , s) -> add_artifact acc ~var (A.binary s |> map_result)
         | Some ("lib"     , s)
         | Some ("libexec" , s) ->
           let lib_dep, res = A.file_of_lib ~dir s in
-          add_artifact acc ~var ~lib_dep res
+          add_artifact acc ~var ~lib_dep:(lib_dep, dep_kind) (map_result res)
+        | Some ("lib-available", lib) ->
+          add_artifact acc ~var ~lib_dep:(lib, Optional)
+            (Ok (Str (string_of_bool (Lib_db.lib_is_available ~from:dir lib))))
         (* CR-someday jdimino: allow this only for (jbuild_version jane_street) *)
         | Some ("findlib" , s) ->
           let lib_dep, res = A.file_of_lib ~dir s ~use_provides:true in
-          add_artifact acc ~var ~lib_dep res
+          add_artifact acc ~var ~lib_dep:(lib_dep, Required) (map_result res)
         | _ -> acc)
 
     let expand_var =
@@ -598,10 +607,10 @@ module Gen(P : Params) = struct
       in
       fun ~artifacts ~targets ~deps var_name ->
         match String_map.find var_name artifacts with
-        | Some path -> Action.Path path
+        | Some exp -> exp
         | None ->
           match var_name with
-          | "@" -> Paths targets
+          | "@" -> Action.Paths targets
           | "<" -> (match deps with
             | []        -> Str ""
             | dep1 :: _ -> Path (dep_exn var_name dep1))
@@ -614,23 +623,27 @@ module Gen(P : Params) = struct
             | _ -> Not_found
 
     let run t ~dir ~dep_kind ~targets ~deps =
-      let forms = extract_artifacts ~dir t in
+      let forms = extract_artifacts ~dir ~dep_kind t in
       let build =
         match
           U.expand ctx dir t
             ~f:(expand_var ~artifacts:forms.artifacts ~targets ~deps)
         with
         | t ->
-          Build.paths (String_map.values forms.artifacts)
+          Build.path_set
+            (String_map.fold forms.artifacts ~init:Path.Set.empty
+               ~f:(fun ~key:_ ~data:exp acc ->
+                 match exp with
+                 | Action.Path p -> Path.Set.add p acc
+                 | Paths ps -> Path.Set.union acc (Path.Set.of_list ps)
+                 | Not_found | Str _ -> acc))
           >>>
           Build.action t ~dir ~targets
         | exception e ->
           Build.fail ~targets { fail = fun () -> raise e }
       in
       let build =
-        Build.record_lib_deps ~dir ~kind:dep_kind
-          (String_set.elements forms.lib_deps
-           |> List.map ~f:(fun s -> Lib_dep.Direct s))
+        Build.record_lib_deps_simple ~dir forms.lib_deps
         >>>
         build
       in

src/lib_db.ml

@@ -67,27 +67,27 @@ let top_sort_internals t ~internal_libraries =
       (List.map cycle ~f:(fun lib -> Lib.describe (Internal lib))
        |> String.concat ~sep:"\n-> ")
 
-let lib_is_installable t ~from name =
+let lib_is_available t ~from name =
   match find_internal t ~from name with
   | Some (_, lib) -> String_map.mem lib.name t.instalable_internal_libs
   | None -> Findlib.available t.findlib name ~required_by:[Utils.jbuild_name_in ~dir:from]
 
 let choice_is_possible t ~from { Lib_dep. lits; _ } =
   List.for_all lits ~f:(function
-    | Lib_dep.Pos name ->      lib_is_installable t ~from name
-    | Lib_dep.Neg name -> not (lib_is_installable t ~from name))
+    | Lib_dep.Pos name ->      lib_is_available t ~from name
+    | Lib_dep.Neg name -> not (lib_is_available t ~from name))
 
-let dep_is_installable t ~from dep =
+let dep_is_available t ~from dep =
   match (dep : Lib_dep.t) with
-  | Direct s -> lib_is_installable t ~from s
+  | Direct s -> lib_is_available t ~from s
   | Select { choices; _ } -> List.exists choices ~f:(choice_is_possible t ~from)
 
 let compute_instalable_internal_libs t ~internal_libraries =
   List.fold_left (top_sort_internals t ~internal_libraries) ~init:t
     ~f:(fun t (dir, lib) ->
       if not lib.Library.optional ||
-         (List.for_all (Library.all_lib_deps lib) ~f:(dep_is_installable t ~from:dir) &&
-          List.for_all lib.ppx_runtime_libraries  ~f:(lib_is_installable t ~from:dir))
+         (List.for_all (Library.all_lib_deps lib) ~f:(dep_is_available t ~from:dir) &&
+          List.for_all lib.ppx_runtime_libraries  ~f:(lib_is_available t ~from:dir))
       then
         { t with
           instalable_internal_libs =
@@ -137,7 +137,7 @@ let interpret_lib_deps t ~dir lib_deps =
               List.filter_map lits ~f:(function
                 | Pos s -> Some (find_exn t ~from:dir s)
                 | Neg s ->
-                  if lib_is_installable t ~from:dir s then
+                  if lib_is_available t ~from:dir s then
                     raise Exit
                   else
                     None)

src/lib_db.mli

@@ -31,3 +31,5 @@ val resolve_selects
   -> from:Path.t
   -> Jbuild_types.Lib_dep.t list
   -> resolved_select list
+
+val lib_is_available : t -> from:Path.t -> string -> bool

test/jbuild

@@ -54,6 +54,13 @@
        ${bin:jbuilder} build -j1 @install --root . --only pas-de-bol
        )))))))
 
+(alias
+ ((name runtest)
+  (deps ((files_recursively_in workspaces/lib-available)))
+  (action
+   (chdir workspaces/lib-available
+    (run ${exe:run.exe} --
+     ${bin:jbuilder} build -j1 @runtest --root . --debug-dependency-path)))))
 
 ;; execute this to check the behavior when background jobs take time to finish:
 ;;

test/workspaces/lib-available/jbuild

@@ -0,0 +1,9 @@
+(jbuild_version 1)
+
+(alias
+ ((name runtest)
+  (action (system "${lib-available:unix}"))))
+
+(alias
+ ((name runtest)
+  (action (system "! ${lib-available:library-that-surely-doesnt-exist}"))))