aboutsummaryrefslogtreecommitdiff
path: root/viz.js/process/formatter.ml
diff options
context:
space:
mode:
Diffstat (limited to 'viz.js/process/formatter.ml')
-rwxr-xr-xviz.js/process/formatter.ml114
1 files changed, 52 insertions, 62 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