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.

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

Pass --warn-error to Odoc #3018

Closed
wants to merge 11 commits into from
14 changes: 13 additions & 1 deletion src/dune/dune_project.ml
Original file line number Diff line number Diff line change
Expand Up @@ -166,6 +166,7 @@ type t =
; dialects : Dialect.DB.t
; explicit_js_mode : bool
; format_config : Format_config.t option
; odoc_warn_error : bool
}

let equal = ( == )
Expand Down Expand Up @@ -198,6 +199,8 @@ let dialects t = t.dialects

let explicit_js_mode t = t.explicit_js_mode

let odoc_warn_error t = t.odoc_warn_error

let to_dyn
{ name
; root
Expand All @@ -217,6 +220,7 @@ let to_dyn
; dialects
; explicit_js_mode
; format_config
; odoc_warn_error
} =
let open Dyn.Encoder in
record
Expand All @@ -237,6 +241,7 @@ let to_dyn
; ("dialects", Dialect.DB.to_dyn dialects)
; ("explicit_js_mode", bool explicit_js_mode)
; ("format_config", (option Format_config.to_dyn) format_config)
; ("odoc_warn_error", bool odoc_warn_error)
]

let find_extension_args t key = Univ_map.find t.extension_args key
Expand Down Expand Up @@ -557,6 +562,7 @@ let infer ~dir packages =
; dialects = Dialect.DB.builtin
; explicit_js_mode
; format_config = None
; odoc_warn_error = false
}

let anonymous ~dir = infer ~dir Package.Name.Map.empty
Expand Down Expand Up @@ -596,7 +602,11 @@ let parse ~dir ~lang ~opam_packages ~file =
and+ explicit_js_mode =
field_o_b "explicit_js_mode"
~check:(Dune_lang.Syntax.since Stanza.syntax (1, 11))
and+ format_config = Format_config.field in
and+ format_config = Format_config.field
and+ odoc_warn_error =
field_o_b "odoc_warn_error"
~check:(Dune_lang.Syntax.since Stanza.syntax (2, 0))
in
let packages =
if List.is_empty packages then
Package.Name.Map.map opam_packages ~f:(fun (_loc, p) -> Lazy.force p)
Expand Down Expand Up @@ -702,6 +712,7 @@ let parse ~dir ~lang ~opam_packages ~file =
Dialect.DB.add dialects ~loc dialect)
~init:Dialect.DB.builtin dialects
in
let odoc_warn_error = Option.value ~default:false odoc_warn_error in
{ name
; file_key
; root
Expand All @@ -720,6 +731,7 @@ let parse ~dir ~lang ~opam_packages ~file =
; dialects
; explicit_js_mode
; format_config
; odoc_warn_error
})

let load_dune_project ~dir opam_packages =
Expand Down
2 changes: 2 additions & 0 deletions src/dune/dune_project.mli
Original file line number Diff line number Diff line change
Expand Up @@ -75,6 +75,8 @@ val explicit_js_mode : t -> bool

val format_config : t -> Format_config.t option

val odoc_warn_error : t -> bool

val equal : t -> t -> bool

val hash : t -> int
Expand Down
121 changes: 83 additions & 38 deletions src/dune/odoc.ml
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,23 @@ module SC = Super_context

let ( ++ ) = Path.Build.relative

module Odoc_config = struct
type t = { warn_error : bool }

let v sctx project =
let is_dev = Profile.is_dev (Super_context.profile sctx) in
let warn_error = Dune_project.odoc_warn_error project && is_dev in
{ warn_error }

let equal a b = Bool.equal a.warn_error b.warn_error

let hash t = Hashtbl.hash t.warn_error

let to_dyn t =
let open Dyn in
Record [ ("warn_error", Bool t.warn_error) ]
end

module Scope_key : sig
val of_string : Super_context.t -> string -> Lib_name.t * Lib.DB.t

Expand Down Expand Up @@ -146,6 +163,12 @@ let odoc sctx =
~dir:(Super_context.build_dir sctx)
"odoc" ~loc:None ~hint:"try: opam install odoc"

let odoc_base_flags ~config =
if config.Odoc_config.warn_error then
Command.Args.A "--warn-error"
else
S []

let module_deps (m : Module.t) ~obj_dir ~(dep_graphs : Dep_graph.Ml_kind.t) =
Build.dyn_paths_unit
(let+ deps =
Expand All @@ -157,8 +180,8 @@ let module_deps (m : Module.t) ~obj_dir ~(dep_graphs : Dep_graph.Ml_kind.t) =
in
List.map deps ~f:(fun m -> Path.build (Obj_dir.Module.odoc obj_dir m)))

let compile_module sctx ~obj_dir (m : Module.t) ~includes:(file_deps, iflags)
~dep_graphs ~pkg_or_lnu =
let compile_module sctx ~config ~obj_dir (m : Module.t)
~includes:(file_deps, iflags) ~dep_graphs ~pkg_or_lnu =
let odoc_file = Obj_dir.Module.odoc obj_dir m in
add_rule sctx
( file_deps
Expand All @@ -167,6 +190,7 @@ let compile_module sctx ~obj_dir (m : Module.t) ~includes:(file_deps, iflags)
let doc_dir = Path.build (Obj_dir.odoc_dir obj_dir) in
Command.run ~dir:doc_dir (odoc sctx)
[ A "compile"
; odoc_base_flags ~config
; A "-I"
; Path doc_dir
; iflags
Expand All @@ -177,11 +201,12 @@ let compile_module sctx ~obj_dir (m : Module.t) ~includes:(file_deps, iflags)
] );
(m, odoc_file)

let compile_mld sctx (m : Mld.t) ~includes ~doc_dir ~pkg =
let compile_mld sctx ~config (m : Mld.t) ~includes ~doc_dir ~pkg =
let odoc_file = Mld.odoc_file m ~doc_dir in
add_rule sctx
(Command.run ~dir:(Path.build doc_dir) (odoc sctx)
[ A "compile"
; odoc_base_flags ~config
; Command.Args.dyn includes
; As [ "--pkg"; Package.Name.to_string pkg ]
; A "-o"
Expand Down Expand Up @@ -211,7 +236,7 @@ let odoc_include_flags ctx pkg requires =
(List.concat_map (Path.Set.to_list paths) ~f:(fun dir ->
[ Command.Args.A "-I"; Path dir ])))

let setup_html sctx (odoc_file : odoc) ~pkg ~requires =
let setup_html sctx ~config (odoc_file : odoc) ~pkg ~requires =
let ctx = Super_context.context sctx in
let deps = Dep.deps ctx pkg requires in
let to_remove, dune_keep =
Expand All @@ -232,6 +257,7 @@ let setup_html sctx (odoc_file : odoc) ~pkg ~requires =
~dir:(Path.build (Paths.html_root ctx))
(odoc sctx)
[ A "html"
; odoc_base_flags ~config
; odoc_include_flags ctx pkg requires
; A "-o"
; Path (Path.build (Paths.html_root ctx))
Expand All @@ -241,8 +267,8 @@ let setup_html sctx (odoc_file : odoc) ~pkg ~requires =
:: dune_keep ) )

let setup_library_odoc_rules cctx (library : Library.t) ~dep_graphs =
let scope = Compilation_context.scope cctx in
let lib =
let scope = Compilation_context.scope cctx in
Library.best_name library
|> Lib.DB.find_even_when_hidden (Scope.libs scope)
|> Option.value_exn
Expand All @@ -262,10 +288,12 @@ let setup_library_odoc_rules cctx (library : Library.t) ~dep_graphs =
let includes =
(Dep.deps ctx (Lib.package lib) requires, odoc_include_flags)
in
let config = Odoc_config.v sctx (Scope.project scope) in
let modules_and_odoc_files =
Modules.fold_no_vlib modules ~init:[] ~f:(fun m acc ->
let compiled =
compile_module sctx ~includes ~dep_graphs ~obj_dir ~pkg_or_lnu m
compile_module sctx ~config ~includes ~dep_graphs ~obj_dir ~pkg_or_lnu
m
in
compiled :: acc)
in
Expand Down Expand Up @@ -423,26 +451,28 @@ let setup_lib_html_rules_def =
let module Input = struct
module Super_context = Super_context.As_memo_key

type t = Super_context.t * Lib.Local.t * Lib.t list Or_exn.t
type t = Super_context.t * Lib.Local.t * Lib.t list Or_exn.t * Odoc_config.t

let equal (sc1, l1, r1) (sc2, l2, r2) =
let equal (sc1, l1, r1, c1) (sc2, l2, r2, c2) =
Super_context.equal sc1 sc2
&& Lib.Local.equal l1 l2
&& Or_exn.equal (List.equal Lib.equal) r1 r2
&& Odoc_config.equal c1 c2

let hash (sc, l, r) =
let hash (sc, l, r, c) =
Hashtbl.hash
( Super_context.hash sc
, Lib.Local.hash l
, Or_exn.hash (List.hash Lib.hash) r )
, Or_exn.hash (List.hash Lib.hash) r
, Odoc_config.hash c )

let to_dyn _ = Dyn.Opaque
end in
let f (sctx, lib, requires) =
let f (sctx, lib, requires, config) =
let ctx = Super_context.context sctx in
let odocs = odocs sctx (Lib lib) in
let pkg = Lib.package (Lib.Local.to_lib lib) in
List.iter odocs ~f:(setup_html sctx ~pkg ~requires);
List.iter odocs ~f:(setup_html sctx ~config ~pkg ~requires);
let html_files = List.map ~f:(fun o -> Path.build o.html_file) odocs in
let static_html = List.map ~f:Path.build (static_html ctx) in
Rules.Produce.Alias.add_deps
Expand All @@ -455,47 +485,50 @@ let setup_lib_html_rules_def =
~output:(module Unit)
~visibility:Hidden Sync f

let setup_lib_html_rules sctx lib ~requires =
Memo.With_implicit_output.exec setup_lib_html_rules_def (sctx, lib, requires)
let setup_lib_html_rules sctx ~config lib ~requires =
Memo.With_implicit_output.exec setup_lib_html_rules_def
(sctx, lib, requires, config)

let setup_pkg_html_rules_def =
let module Input = struct
module Super_context = Super_context.As_memo_key

type t = Super_context.t * Package.Name.t * Lib.Local.t list
type t = Super_context.t * Package.Name.t * Lib.Local.t list * Odoc_config.t

let equal (s1, p1, l1) (s2, p2, l2) =
let equal (s1, p1, l1, c1) (s2, p2, l2, c2) =
Package.Name.equal p1 p2
&& List.equal Lib.Local.equal l1 l2
&& Super_context.equal s1 s2
&& Super_context.equal s1 s2 && Odoc_config.equal c1 c2

let hash (sctx, p, ls) =
let hash (sctx, p, ls, c) =
Hashtbl.hash
( Super_context.hash sctx
, Package.Name.hash p
, List.hash Lib.Local.hash ls )
, List.hash Lib.Local.hash ls
, Odoc_config.hash c )

let to_dyn (_, package, libs) =
let to_dyn (_, package, libs, config) =
let open Dyn in
Tuple
[ Package.Name.to_dyn package
; List (List.map ~f:Lib.Local.to_dyn libs)
; Odoc_config.to_dyn config
]
end in
Memo.With_implicit_output.create "setup-package-html-rules"
~output:(module Unit)
~implicit_output:Rules.implicit_output ~doc:"setup odoc package html rules"
~input:(module Input)
~visibility:Hidden Sync
(fun (sctx, pkg, (libs : Lib.Local.t list)) ->
(fun (sctx, pkg, (libs : Lib.Local.t list), config) ->
let requires =
let libs = (libs :> Lib.t list) in
Lib.closure libs ~linking:false
in
let ctx = Super_context.context sctx in
List.iter libs ~f:(setup_lib_html_rules sctx ~requires);
List.iter libs ~f:(setup_lib_html_rules sctx ~config ~requires);
let pkg_odocs = odocs sctx (Pkg pkg) in
List.iter pkg_odocs ~f:(setup_html sctx ~pkg:(Some pkg) ~requires);
List.iter pkg_odocs ~f:(setup_html sctx ~config ~pkg:(Some pkg) ~requires);
let odocs =
List.concat
(pkg_odocs :: List.map libs ~f:(fun lib -> odocs sctx (Lib lib)))
Expand All @@ -506,8 +539,9 @@ let setup_pkg_html_rules_def =
(Dep.html_alias ctx (Pkg pkg))
(Path.Set.of_list (List.rev_append static_html html_files)))

let setup_pkg_html_rules sctx ~pkg ~libs =
Memo.With_implicit_output.exec setup_pkg_html_rules_def (sctx, pkg, libs)
let setup_pkg_html_rules sctx ~config ~pkg ~libs =
Memo.With_implicit_output.exec setup_pkg_html_rules_def
(sctx, pkg, libs, config)

let setup_package_aliases sctx (pkg : Package.t) =
let ctx = Super_context.context sctx in
Expand Down Expand Up @@ -568,22 +602,25 @@ let setup_package_odoc_rules_def =
let module Input = struct
module Super_context = Super_context.As_memo_key

type t = Super_context.t * Package.Name.t
type t = Super_context.t * Package.Name.t * Odoc_config.t

let hash (sctx, p) =
Hashtbl.hash (Super_context.hash sctx, Package.Name.hash p)
let hash (sctx, p, c) =
Hashtbl.hash
(Super_context.hash sctx, Package.Name.hash p, Odoc_config.hash c)

let equal (s1, x1) (s2, x2) =
let equal (s1, x1, c1) (s2, x2, c2) =
Super_context.equal s1 s2 && Package.Name.equal x1 x2
&& Odoc_config.equal c1 c2

let to_dyn (_, name) = Dyn.Tuple [ Package.Name.to_dyn name ]
let to_dyn (_, name, config) =
Dyn.Tuple [ Package.Name.to_dyn name; Odoc_config.to_dyn config ]
end in
Memo.With_implicit_output.create "setup-package-odoc-rules"
~output:(module Unit)
~implicit_output:Rules.implicit_output ~doc:"setup odoc package rules"
~input:(module Input)
~visibility:Hidden Sync
(fun (sctx, pkg) ->
(fun (sctx, pkg, config) ->
let mlds = Packages.mlds sctx pkg in
let mlds = check_mlds_no_dupes ~pkg ~mlds in
let ctx = Super_context.context sctx in
Expand All @@ -600,14 +637,14 @@ let setup_package_odoc_rules_def =
in
let odocs =
List.map (String.Map.values mlds) ~f:(fun mld ->
compile_mld sctx (Mld.create mld) ~pkg
compile_mld sctx ~config (Mld.create mld) ~pkg
~doc_dir:(Paths.odocs ctx (Pkg pkg))
~includes:(Build.return []))
in
Dep.setup_deps ctx (Pkg pkg) (Path.set_of_build_paths_list odocs))

let setup_package_odoc_rules sctx ~pkg =
Memo.With_implicit_output.exec setup_package_odoc_rules_def (sctx, pkg)
let setup_package_odoc_rules sctx ~config ~pkg =
Memo.With_implicit_output.exec setup_package_odoc_rules_def (sctx, pkg, config)

let init sctx =
let stanzas = SC.stanzas sctx in
Expand All @@ -634,17 +671,23 @@ let init sctx =
Lib lib |> Dep.html_alias ctx |> Alias.stamp_file |> Path.build)
|> Path.Set.of_list )

let gen_rules sctx ~dir:_ rest =
let config_of_dir sctx dir =
let scope = Super_context.find_scope_by_dir sctx dir in
let project = Scope.project scope in
Odoc_config.v sctx project

let gen_rules sctx ~dir rest =
match rest with
| [ "_html" ] ->
setup_css_rule sctx;
setup_toplevel_index_rule sctx
| "_mlds" :: pkg :: _
| "_odoc" :: "pkg" :: pkg :: _ ->
let config = config_of_dir sctx dir in
let pkg = Package.Name.of_string pkg in
let packages = Super_context.packages sctx in
Package.Name.Map.find packages pkg
|> Option.iter ~f:(fun _ -> setup_package_odoc_rules sctx ~pkg)
|> Option.iter ~f:(fun _ -> setup_package_odoc_rules sctx ~config ~pkg)
| "_odoc" :: "lib" :: lib :: _ ->
let lib, lib_db = Scope_key.of_string sctx lib in
(* diml: why isn't [None] some kind of error here? *)
Expand All @@ -658,8 +701,10 @@ let gen_rules sctx ~dir:_ rest =
(* TODO we can be a better with the error handling in the case where
lib_unique_name_or_pkg is neither a valid pkg or lnu *)
let lib, lib_db = Scope_key.of_string sctx lib_unique_name_or_pkg in
let config = config_of_dir sctx dir in
let setup_pkg_html_rules pkg =
setup_pkg_html_rules sctx ~pkg ~libs:(load_all_odoc_rules_pkg sctx ~pkg)
setup_pkg_html_rules sctx ~config ~pkg
~libs:(load_all_odoc_rules_pkg sctx ~pkg)
in
(* diml: why isn't [None] some kind of error here? *)
let lib =
Expand All @@ -670,7 +715,7 @@ let gen_rules sctx ~dir:_ rest =
Option.iter lib ~f:(fun lib ->
match Lib.package (Lib.Local.to_lib lib) with
| None ->
setup_lib_html_rules sctx lib
setup_lib_html_rules sctx ~config lib
~requires:(Lib.closure ~linking:false [ Lib.Local.to_lib lib ])
| Some pkg -> setup_pkg_html_rules pkg);
Option.iter
Expand Down
Loading