diff --git a/Makefile b/Makefile index 47c7b9ce..119a4a38 100644 --- a/Makefile +++ b/Makefile @@ -74,12 +74,12 @@ prep: _generated .PHONY: example example: all prep ## Build an sample output cd _generated; opam exec -- dune exec -- voodoo-do -p ocaml-base-compiler -b - cd _generated; opam exec -- dune exec -- voodoo-gen -o output + cd _generated; opam exec -- dune exec -- voodoo-gen -o output --check-links .PHONY: gen gen: cd _generated; rm -rf output - cd _generated; opam exec -- dune exec -- voodoo-gen -o output + cd _generated; opam exec -- dune exec -- voodoo-gen -o output --check-links .PHONY: serve serve: diff --git a/dune-project b/dune-project index ce01ac26..8bc0ff16 100644 --- a/dune-project +++ b/dune-project @@ -74,6 +74,7 @@ (>= 3.6.0)) sexplib fpath + olinkcheck (conf-jq :with-test) (ppx_deriving_yaml (and diff --git a/src/voodoo-gen/dune b/src/voodoo-gen/dune index 367f5e3e..0f4746da 100644 --- a/src/voodoo-gen/dune +++ b/src/voodoo-gen/dune @@ -4,4 +4,12 @@ (package voodoo-gen) (preprocess (pps ppx_deriving_yojson)) - (libraries voodoo_lib odoc.odoc omd bos yojson ppx_deriving_yojson cmdliner)) + (libraries + voodoo_lib + odoc.odoc + omd + bos + yojson + ppx_deriving_yojson + cmdliner + olinkcheck)) diff --git a/src/voodoo-gen/main.ml b/src/voodoo-gen/main.ml index 24f1806d..f208a3b9 100644 --- a/src/voodoo-gen/main.ml +++ b/src/voodoo-gen/main.ml @@ -22,7 +22,18 @@ type otherdocs = { } [@@deriving yojson] -type status = { failed : bool; otherdocs : otherdocs } [@@deriving yojson] +type file_with_links = { + file : Fpath.t; + broken_links : ((int * string) * string) list; +} +[@@deriving yojson] + +type status = { + failed : bool; + otherdocs : otherdocs; + broken_link_files : file_with_links list; +} +[@@deriving yojson] let docs = "ARGUMENTS" @@ -57,7 +68,7 @@ let get_ok = function Format.eprintf "get_ok: Failure! msg=%s\n%!" m; failwith "get_ok: Not OK" -let generate_pkgver output_dir name_filter version_filter = +let generate_pkgver output_dir name_filter version_filter check_links_flag = let linkedpath = Fpath.(v "linked") in match Bos.OS.Dir.fold_contents ~elements:`Dirs @@ -147,6 +158,31 @@ let generate_pkgver output_dir name_filter version_filter = Package_info.gen ~input:parent ~output:output_prefix paths; Rendering.render_other ~parent ~otherdocs ~output |> get_ok; + let broken_link_files = + if check_links_flag then + let htmls = + Voodoo_lib.Util.files_with_ext ".html.json" output_prefix + in + List.fold_left + (fun acc path -> + let links = + Bos.OS.File.read path |> get_ok + |> Olinkcheck.Html.from_string + |> Olinkcheck.Html.extract_links + in + let status = Olinkcheck.Link.status_many links in + let broken = + List.combine status links + |> List.filter (fun ((code, _), _) -> code <> 200) + in + if List.length broken <> 0 then + let entry = { file = path; broken_links = broken } in + entry :: acc + else acc) + [] htmls + else [] + in + let otherdocs = let init = { readme = []; license = []; changes = []; others = [] } @@ -162,7 +198,7 @@ let generate_pkgver output_dir name_filter version_filter = | _ -> { acc with others = path :: acc.others }) init otherdocs in - let status = { failed; otherdocs } in + let status = { failed; otherdocs; broken_link_files } in if Option.is_none universe then Yojson.Safe.to_file Fpath.(output_prefix / "status.json" |> to_string) @@ -206,10 +242,15 @@ let package_version_opt = & opt (some string) None & info ~docs ~docv:"VERSION" ~doc [ "pkg-version" ]) +let check_links_flag = + let doc = "Flag to check if the links in the documentation are broken" in + Arg.(value & flag & info [ "check-links" ] ~doc) + let default_cmd = let doc = "Documentation generator" in ( Term.( - const generate_pkgver $ output $ package_name_opt $ package_version_opt), + const generate_pkgver $ output $ package_name_opt $ package_version_opt + $ check_links_flag), Term.info "voodoo-gen" ~version ~doc ~exits:Term.default_exits ) let () = Term.(exit @@ eval default_cmd) diff --git a/src/voodoo/util.ml b/src/voodoo/util.ml index a168e5d5..73db2497 100644 --- a/src/voodoo/util.ml +++ b/src/voodoo/util.ml @@ -45,3 +45,16 @@ let mkdir_p d = () let copy src dst = Bos.OS.File.read src >>= Bos.OS.File.write dst + +let rec files_with_ext ext path = + match OS.Dir.exists path with + | Ok true -> + let children = + match OS.Dir.contents path with Ok paths -> paths | Error _ -> [] + in + List.concat @@ List.map (files_with_ext ext) children + | Ok false -> ( + match OS.File.exists path with + | Ok true -> if Fpath.has_ext ext path then [ path ] else [] + | _ -> []) + | Error _ -> [] diff --git a/src/voodoo/util.mli b/src/voodoo/util.mli index 56e798b4..7c5d0476 100644 --- a/src/voodoo/util.mli +++ b/src/voodoo/util.mli @@ -3,3 +3,4 @@ val lines_of_channel : in_channel -> string list val lines_of_process : Bos.Cmd.t -> string list val mkdir_p : Fpath.t -> unit val copy : Fpath.t -> Fpath.t -> (unit, [> Rresult.R.msg ]) result +val files_with_ext : string -> Fpath.t -> Fpath.t list diff --git a/test/can-render-org-files.t b/test/can-render-org-files.t index 79e36883..81447219 100644 --- a/test/can-render-org-files.t +++ b/test/can-render-org-files.t @@ -31,7 +31,8 @@ Generates a status.json file "others": [ "linked/p/base/v0.15.1/package.json" ] - } + }, + "broken_link_files": [] } Converted the README.org file in markdown diff --git a/test/can-render-tables.t b/test/can-render-tables.t index 5e107225..659bf09a 100644 --- a/test/can-render-tables.t +++ b/test/can-render-tables.t @@ -25,7 +25,8 @@ Generates a status.json file "others": [ "linked/p/ppx_deriving_yaml/0.2.1/package.json" ] - } + }, + "broken_link_files": [] } Generate a README.md file with the tables formatted in HTML diff --git a/voodoo-gen.opam b/voodoo-gen.opam index ac397b78..93f16946 100644 --- a/voodoo-gen.opam +++ b/voodoo-gen.opam @@ -22,6 +22,7 @@ depends: [ "ppx_deriving_yojson" {>= "3.6.0"} "sexplib" "fpath" + "olinkcheck" "conf-jq" {with-test} "ppx_deriving_yaml" {= "0.2.1" & with-test} "base" {= "v0.15.1" & with-test} @@ -43,4 +44,5 @@ build: [ dev-repo: "git+https://github.com/ocaml-doc/voodoo.git" available: [ os-distribution != "alpine" & arch != "ppc64"] # PPC64 fails to build with stack overflow see https://github.com/ocaml/ocaml/issues/11415 -# Alpine-3.16 doesn't have a pandoc package, however 3.17 does \ No newline at end of file +# Alpine-3.16 doesn't have a pandoc package, however 3.17 does +pin-depends: [["olinkcheck.~dev" "git+https://github.com/tarides/olinkcheck#ef33ab71da9767596b9b6ae6c5b4c89cf6fabe3e"]] diff --git a/voodoo-gen.opam.template b/voodoo-gen.opam.template index 80af9ef2..57bf2db2 100644 --- a/voodoo-gen.opam.template +++ b/voodoo-gen.opam.template @@ -1,3 +1,4 @@ available: [ os-distribution != "alpine" & arch != "ppc64"] # PPC64 fails to build with stack overflow see https://github.com/ocaml/ocaml/issues/11415 -# Alpine-3.16 doesn't have a pandoc package, however 3.17 does \ No newline at end of file +# Alpine-3.16 doesn't have a pandoc package, however 3.17 does +pin-depends: [["olinkcheck.~dev" "git+https://github.com/tarides/olinkcheck#ef33ab71da9767596b9b6ae6c5b4c89cf6fabe3e"]]