1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
open Js_of_ocaml
module T = Tools
let leftright = false
module Printer = struct
type t = Js.js_string Js.t
let inject = Js.string
let print2 t t1 t2 = t##concat_2 t1 t2
let print4 t t1 t2 t3 t4 = t##concat_4 t1 t2 t3 t4
let print5 t t1 t2 t3 t4 t5 = (t##concat t1)##concat_4 t2 t3 t4 t5
let print10 t t1 t2 t3 t4 t5 t6 t7 t8 t9 t10 =
((t##concat_4 t1 t2 t3 t4)##concat_3 t5 t6 t7)##concat_3 t8 t9 t10
end
let print_arrow = begin function
| Tab_Lexer.Backward -> Printer.inject "back"
| Tab_Lexer.Both -> Printer.inject "both"
| Tab_Lexer.None -> Printer.inject "none"
| Tab_Lexer.Forward -> Printer.inject "forward"
end
let rec print_links (acc:Js.js_string Js.t) = begin function
| [] -> acc
| (current_name, level, target, comment, arrow)::tl ->
let acc' = Printer.print10 acc
(current_name)
(Printer.inject ":")
(Printer.inject @@ string_of_int level)
(Printer.inject " -> ")
target
(Printer.inject "[label=\"")
comment
(Printer.inject "\" dir=\"")
(print_arrow arrow)
(Printer.inject "\" ]\n") in
print_links acc' tl
end
let shape = (Printer.inject "[label=<<TABLE BORDER=\"0\" CELLBORDER=\"1\" CELLSPACING=\"0\">")
let rec parse lexbuf acc current_name level links = begin
try
begin match Tab_Lexer.parse_line lexbuf with
| Root content ->
let acc' = Printer.print2 acc
content
shape
in
parse lexbuf acc' content 0 links
| Entry (content, target) ->
let level' = level + 1 in
let acc' = (acc##concat_4
(Js.string "<TR><TD port=\"")
(Js.string @@ string_of_int level')
(Js.string "\">")
content
)##concat
(Js.string "</TD></TR>")
in
let links' = begin match target with
| None -> links
| Some (target, comment, arrow) -> (current_name, level', target, comment, arrow)::links
end in
parse lexbuf acc' current_name level' links'
| Redirection (target, comment, arrow) ->
let links' = (current_name, level, target, comment, arrow)::links in
parse lexbuf acc current_name level links'
| NewLine ->
let acc' =
if (level >= 0) then (
print_links (acc##concat (Js.string "</TABLE>>];\n")) links;
) else (
acc
) in
parse lexbuf acc' (Js.string "") (-1) []
| Separator ->
let text = "<TR><TD></TD></TR>" in
parse lexbuf (acc##concat (Js.string text)) current_name level links
end
with Tab_Lexer.Eof ->
if (level >= 0) then (
let text = Js.string "</TABLE>>];\n" in
print_links (acc##concat text) links;
) else
acc
end
let convert source = begin
let text = (Js.string "digraph G {rankdir=LR;node [shape=plaintext];") in
(* Content *)
let lexbuf = Lexing.from_string (Js.to_string (source##concat (Js.string "\r\n"))) in
(parse lexbuf text (Js.string "") 0 [])##concat (Js.string "}")
end
|
