Skip to content
This repository has been archived by the owner on Jul 19, 2022. It is now read-only.

Commit

Permalink
Add code references into the generated HTML (rfc_notes.py now mostly …
Browse files Browse the repository at this point in the history 
…obsolete)
  • Loading branch information
@lcdunstan
lcdunstan committed Jun 13, 2015
1 parent 5396e97 commit d3c21ba
Show file tree
Hide file tree
Showing 3 changed files with 121 additions and 71 deletions.
8 changes: 5 additions & 3 deletions src/reqtrace.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -152,20 +152,22 @@ let extract_cmd =

let html_cmd =
let doc = "render XML documentation into HTML" in
let css_doc = "the URI reference of the CSS file to use" in
let js_doc = "the URI reference of the JS file to use" in
let man = [

] @ help_sections
in
let path_doc = "the file or directory to render to HTML" in
let path' = path ~doc:path_doc (Arg.pos 0) in
let css_doc = "the URI reference of the CSS file to use" in
let css = uri_ref ~doc:css_doc ["css"] in
let js_doc = "the URI reference of the JS file to use" in
let js = uri_ref ~doc:js_doc ["js"] in
let base_doc = "the base URI for hyperlinks to the source code" in
let base = uri_ref ~doc:base_doc ["base"] in
let ref = path_opt ~doc:"the file or directory containing requirement references extracted from code (*.req)" ["ref"] in
Term.(ret (pure ReqtraceHtmlCmd.run
$ output $ path'
$ scheme $ css $ js $ share_dir $ ref),
$ css $ js $ base $ share_dir $ ref),
info "html" ~doc ~sdocs:global_option_section ~man)

let default_cmd =
Expand Down
159 changes: 104 additions & 55 deletions src/reqtraceDocHtml.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -30,64 +30,89 @@ let of_line (line:linesub) =
(* TODO: start/end/num *)
make_tag "span" ([attr "class" "line"], [`Data line.text])

let of_ref target =
make_tag "div" ([attr "class" "ref"], [
`Data "See ";
make_tag "a" ([attr "href" ("#" ^ target)], [`Data target]);
])

let of_notes_child = function
| Note { text; todo; } -> make_tag "div" ([attr "class" "note"], [`Data text])
| Ref target -> of_ref target
| CodeRef ref -> make_tag "div" ([attr "class" "coderef"], [`Data ref]) (*TODO*)

let of_clause (clause:clause) =
let label = match clause.id with
| None -> []
| Some id -> [make_tag "span" ([attr "class" "label"], [`Data id])]
let body_of_doc doc ref_hash src_base =
let of_ref target =
make_tag "div" ([attr "class" "ref"], [
`Data "See ";
make_tag "a" ([attr "href" ("#" ^ target)], [`Data target]);
])
in

let open ReqtraceTypes.Refs in
let of_reqref { loc={Location.loc_start={Lexing.pos_fname=path; Lexing.pos_lnum=linenum}}; reftype; } =
let reftype_str = match reftype with
| Impl -> "impl"
| Test -> "test"
| Unknown -> match Stringext.find_from path "test" with
| None -> "impl"
| Some i -> "test"
in
make_tag "div" (
[attr "class" ("coderef " ^ reftype_str);],
[
`Data (reftype_str ^ ": ");
make_tag "a" (
[attr "href" (src_base ^ path)],
[`Data (Printf.sprintf "%s:%d" path linenum)]
);
])
in

let of_notes_child = function
| Note { text; todo; } -> make_tag "div" ([attr "class" "note"], [`Data text])
| Ref target -> of_ref target
| CodeRef ref -> make_tag "div" ([attr "class" "coderef"], [`Data ref]) (*TODO*)
in

let of_clause (clause:clause) =
let label, code_refs = match clause.id with
| None -> [], []
| Some id -> [make_tag "span" ([attr "class" "label"], [`Data id])], Hashtbl.find_all ref_hash id
in
let text = String.concat " " (List.map (fun (line:linesub) -> line.text) clause.lines) in
let notes = (List.map of_notes_child clause.notes) @ (List.map of_reqref code_refs) in
let notes_div = if notes = [] then [] else [make_tag "div" ([attr "class" "notes"], notes)] in
make_tag "div" (
opt_attr "id" clause.id
[attr "class" "clause"],
label @ notes_div @ [`Data text])
in
let notes = List.map of_notes_child clause.notes in
let notes = if notes = [] then [] else
[make_tag "div" ([attr "class" "notes"], notes)]

let of_toc_paragraph paragraph =
let text = String.concat "\n" (List.map (fun (line:linesub) -> line.text) paragraph.lines) in
make_tag "pre" ([attr "class" "toc"], [`Data text])
in
let text = String.concat " " (List.map (fun (line:linesub) -> line.text) clause.lines) in
make_tag "div" (
opt_attr "id" clause.id
[attr "class" "clause"],
label @ notes @ [`Data text])

let of_toc_paragraph paragraph =
let text = String.concat "\n" (List.map (fun (line:linesub) -> line.text) paragraph.lines) in
make_tag "pre" ([attr "class" "toc"], [`Data text])

let of_paragraph paragraph =
let lines = List.map of_line paragraph.lines in
let clauses = List.map of_clause paragraph.clauses in
(* TODO: <notes> in <paragraph> *)
make_tag "div" ([attr "class" "paragraph"], lines @ clauses)

let of_section section =
let heading = make_tag "h2" (
opt_attr "id" section.id [],
[`Data section.name]
) in
let anchor = make_tag "a" ([
attr "name" (match section.id with None -> section.name | Some id -> id)
], []) in
let paras = if section.name = "Table of Contents" then
List.map of_toc_paragraph section.paras
else
List.map of_paragraph section.paras

let of_paragraph paragraph =
let lines = List.map of_line paragraph.lines in
let clauses = List.map of_clause paragraph.clauses in
(* TODO: <notes> in <paragraph> *)
make_tag "div" ([attr "class" "paragraph"], lines @ clauses)
in
(* TODO: <notes> in <section> *)
make_tag "div" ([attr "class" "section"], heading :: anchor :: paras)

let clause_index doc =
make_tag "div" (
[attr "id" "index_of_clauses"],
[])
let of_section section =
let heading = make_tag "h2" (
opt_attr "id" section.id [],
[`Data section.name]
) in
let anchor = make_tag "a" ([
attr "name" (match section.id with None -> section.name | Some id -> id)
], []) in
let paras = if section.name = "Table of Contents" then
List.map of_toc_paragraph section.paras
else
List.map of_paragraph section.paras
in
(* TODO: <notes> in <section> *)
make_tag "div" ([attr "class" "section"], heading :: anchor :: paras)
in

let clause_index doc =
make_tag "div" (
[attr "id" "index_of_clauses"],
[])
in

let body_of_doc doc =
let p_links = make_tag "p" ([], [
`Data "Jump to:";
make_tag "a" ([attr "href" "#index_of_clauses"], [`Data "Index of Clauses"]);
Expand All @@ -97,7 +122,31 @@ let body_of_doc doc =
let index = clause_index doc in
make_tag "body" ([], p_links :: h1 :: sections @ [index])

let of_rfc ~normal_uri ~uri_of_path ~css ~js ~refs rfc =
let index_of_refs refs rfc =
let open ReqtraceTypes.Refs in
let ref_hash = Hashtbl.create 1000 in
List.iter (fun impl ->
let doc_hash = Hashtbl.create (List.length impl.docs) in
List.iter (fun (name, docid) -> Hashtbl.add doc_hash name docid) impl.docs;
let add_ref docid ref =
match docid with
| RFC n when n = rfc.number -> Hashtbl.add ref_hash ref.reqid ref
| RFC _ -> ()
| Uri _ -> ()
in
List.iter (fun ref ->
match ref.docref with
| Bound name ->
let docid = Hashtbl.find doc_hash name in
add_ref docid ref
| Unbound docid ->
add_ref docid ref
) impl.refs
) refs;
ref_hash

let of_rfc ~css ~js ~refs ~src_base rfc =
let ref_hash = index_of_refs refs rfc in
let title = Printf.sprintf "RFC %d: %s" rfc.number rfc.title in
let head =
make_tag "head" ([], [
Expand All @@ -111,6 +160,6 @@ let of_rfc ~normal_uri ~uri_of_path ~css ~js ~refs rfc =
make_tag "script" ([attr "src" js], [`Data "\n"]);
])
in
let body = body_of_doc rfc in
let body = body_of_doc rfc ref_hash src_base in
make_tag "html" ([], [head; body])

25 changes: 12 additions & 13 deletions src/reqtraceHtmlCmd.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@ let html_name_of path =
with Not_found -> path
)^ ".html"

(*
let uri_of_path ~scheme path =
Uri.of_string begin
if scheme <> "file" && Filename.check_suffix path "/index.html"
Expand All @@ -40,7 +41,6 @@ let normal_uri ~scheme uri =
then uri
else Uri.(resolve "" uri (of_string "index.html"))
(*
let pathloc ?pkg_root scheme unit = CodocDocHtml.pathloc
~unit
~index:CodocDoc.(fun root -> match root with
Expand Down Expand Up @@ -214,19 +214,17 @@ let render_with_js share js_dir render_f = function
| `Ok js -> render_f js
| `Error _ as err -> err

let render_rfc rfc out_file scheme css js refs =
let normal_uri = normal_uri ~scheme in
let uri_of_path = uri_of_path ~scheme in
let html = ReqtraceDocHtml.of_rfc ~normal_uri ~uri_of_path ~css ~js ~refs rfc in
let render_rfc rfc out_file css js src_base refs =
let html = ReqtraceDocHtml.of_rfc ~css ~js ~refs ~src_base rfc in
write_html out_file html;
`Ok ()

let render_file in_file out_file scheme css js share refs =
let render_file in_file out_file css js src_base share refs =
let css_js_dir = Filename.dirname out_file in
let rfc = ReqtraceDocXml.read in_file in
render_with_js share css_js_dir (fun js ->
render_with_css share css_js_dir (fun css ->
render_rfc rfc out_file scheme css js refs) css) js
render_rfc rfc out_file css js src_base refs) css) js

let only_req file path =
Filename.check_suffix file ".req"
Expand Down Expand Up @@ -259,16 +257,16 @@ let load_refs = function
| Some (`Dir path) ->
load_refs_dir path

let run_with_refs output path scheme css js share refs =
let run_with_refs output path css js src_base share refs =
match path, output with
| `Missing path, _ -> Error.source_missing path
| `File in_file, None ->
render_file in_file (html_name_of in_file) scheme css js share refs
render_file in_file (html_name_of in_file) css js src_base share refs
| `File in_file, Some (`Missing out_file | `File out_file) ->
render_file in_file out_file scheme css js share refs
render_file in_file out_file css js src_base share refs
| `File in_file, Some (`Dir out_dir) ->
let html_name = html_name_of (Filename.basename in_file) in
render_file in_file (out_dir / html_name) scheme css js share refs
render_file in_file (out_dir / html_name) css js src_base share refs
| `Dir in_dir, None ->
`Error (false, "unimplemented")
| `Dir in_dir, Some (`Missing out_dir | `Dir out_dir) ->
Expand Down Expand Up @@ -312,7 +310,8 @@ let run_with_refs output path scheme css js share refs =
end
*)

let run output path scheme css js share ref_path =
let run output path css js base share ref_path =
let src_base = match base with None -> "" | Some uri -> Uri.to_string uri in
match load_refs ref_path with
| `Ok refs -> run_with_refs output path scheme css js share refs
| `Ok refs -> run_with_refs output path css js src_base share refs
| `Error _ as err -> err

0 comments on commit d3c21ba

Please sign in to comment.