diff options
Diffstat (limited to 'viz.js/process')
-rwxr-xr-x | viz.js/process/formatter.ml | 114 | ||||
-rwxr-xr-x | viz.js/process/tab_Lexer.mll | 2 |
2 files changed, 53 insertions, 63 deletions
diff --git a/viz.js/process/formatter.ml b/viz.js/process/formatter.ml index e6a8a0e..057ec25 100755 --- a/viz.js/process/formatter.ml +++ b/viz.js/process/formatter.ml @@ -1,100 +1,90 @@ 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 +let print_arrow = 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 +let rec print_links (acc : Js.js_string Js.t) = 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 + | (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 -let shape = (Printer.inject "[label=<<TABLE BORDER=\"0\" CELLBORDER=\"1\" CELLSPACING=\"0\">") +let shape = + Printer.inject + "[label=<<TABLE BORDER=\"0\" CELLBORDER=\"1\" CELLSPACING=\"0\">" -let rec parse lexbuf acc current_name level links = begin +let rec parse lexbuf acc current_name level links = try - begin match Tab_Lexer.parse_line lexbuf with - | Root content -> - let acc' = Printer.print2 acc - content - shape - in + 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) -> + | 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 + 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 + let links' = + match target with | None -> links - | Some (target, comment, arrow) -> (current_name, level', target, comment, arrow)::links - end in + | Some (target, comment, arrow) -> + (current_name, level', target, comment, arrow) :: links + in parse lexbuf acc' current_name level' links' - | Redirection (target, comment, arrow) -> - let links' = (current_name, level, target, comment, arrow)::links in + | Redirection (target, comment, arrow) -> + let links' = (current_name, level, target, comment, arrow) :: links in parse lexbuf acc current_name level links' - | NewLine -> + | NewLine -> let acc' = - if (level >= 0) then ( - print_links (acc##concat (Js.string "</TABLE>>];\n")) links; - ) else ( - acc - ) in + 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 + | 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 + with + | Tab_Lexer.Eof -> + if level >= 0 then + let text = Js.string "</TABLE>>];\n" in + print_links (acc##concat text) links + else acc - let text = (Js.string "digraph G {rankdir=LR;node [shape=plaintext];") in +let convert source = + 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 + 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 diff --git a/viz.js/process/tab_Lexer.mll b/viz.js/process/tab_Lexer.mll index 67793e4..5149917 100755 --- a/viz.js/process/tab_Lexer.mll +++ b/viz.js/process/tab_Lexer.mll @@ -59,7 +59,7 @@ rule parse_line = shortest (regular* as comment) newline { Entry (Js.string _2, Some (Js.string _target, Js.string comment, (get_arrow _arrow)))} - | (space+ as _1) + | (spaces as _1) (regular+ as _2) newline { Entry (Js.string _2, None) } |