Applied ocamlformat on the code

4 files changed, 209 insertions, 275 deletions

diff --git a/css/merger.ml b/css/merger.ml
index ea6efe2..24c10a3 100755
--- a/css/merger.ml
+++ b/css/merger.ml
@@ -1,48 +1,42 @@
 open StdLabels
 open Js_of_ocaml
-
 open Brr
 open Note
 open Brr_note
-
 module Printer = Css_lib.Print
 
 let min = Printer.minify_printer
 
-type file =
-  { file : File.t
+type file = {
+    file : File.t
   ; css : Css.Types.Stylesheet.t option
-  }
+}
 
-type state =
-  { files : file Js.js_array Js.t
+type state = {
+    files : file Js.js_array Js.t
   ; result_css : Css.Types.Stylesheet.t option
   ; elements : int
-  }
-
-module App = Application.Make(struct type t = state end)
-
-let init =
-  { files = new%js Js.array_empty
-  ; result_css = None
-  ; elements = 0 }
-
-let build_result
-  : file Js.js_array Js.t -> Css.Types.Stylesheet.t option
-  = fun documents ->
-    let merge_result = documents##reduce_init
-        (Js.wrap_callback @@
-         (fun acc v _idx _arr ->
-
-            match acc, v.css with
-            | None, None -> None
-            | None, Some css -> Some (Css_lib.Merge.(add_css empty css))
-            | Some res, Some css -> Some (Css_lib.Merge.(add_css res css ))
-            | v, None -> v ))
-        None in
-    Option.map
-      Css_lib.Merge.extract_css
-      merge_result
+}
+
+module App = Application.Make (struct
+  type t = state
+end)
+
+let init = { files = new%js Js.array_empty; result_css = None; elements = 0 }
+
+let build_result : file Js.js_array Js.t -> Css.Types.Stylesheet.t option =
+ fun documents ->
+  let merge_result =
+    documents##reduce_init
+      ( Js.wrap_callback @@ fun acc v _idx _arr ->
+        match (acc, v.css) with
+        | None, None -> None
+        | None, Some css -> Some Css_lib.Merge.(add_css empty css)
+        | Some res, Some css -> Some Css_lib.Merge.(add_css res css)
+        | v, None -> v )
+      None
+  in
+  Option.map Css_lib.Merge.extract_css merge_result
 
 module AddFile = struct
   type t = file
@@ -51,214 +45,163 @@ module AddFile = struct
     let _ = state.files##push file in
     let elements = state.files##.length
     and result_css = build_result state.files in
-    { state with elements ; result_css }
+    { state with elements; result_css }
 end
 
 module DelFile = struct
-
   type t = File.t
 
   let process file state =
-    let files = state.files##filter
-        (Js.wrap_callback @@ (fun elt _ _ -> Js.bool (elt.file != file))) in
-    let elements = files##.length
-    and result_css = build_result files in
-    { files ; elements ; result_css }
+    let files =
+      state.files##filter
+        (Js.wrap_callback @@ fun elt _ _ -> Js.bool (elt.file != file))
+    in
+    let elements = files##.length and result_css = build_result files in
+    { files; elements; result_css }
 end
 
 let header =
+  let button = El.span [ El.txt' "Retirer" ] in
+
+  El.set_inline_style (Jstr.v "float") (Jstr.v "right") button;
+
+  let block = El.div [ El.span [ El.txt' "Fichier" ]; button ] in
+  El.set_inline_style El.Style.display (Jstr.v "block") block;
+  block
+
+let file_list : App.event E.send -> file -> El.t =
+ fun sender f ->
+  let icon =
+    El.i [] ~at:At.[ class' (Jstr.v "fas"); class' (Jstr.v "fa-check") ]
+  in
+
   let button =
-    El.span
-      [ El.txt' "Retirer" ] in
-
-  El.set_inline_style
-    (Jstr.v "float")
-    (Jstr.v "right")
-    button;
-
-  let block =
-    El.div
-      [ El.span [El.txt' "Fichier"]
-      ; button ]
+    El.i [] ~at:At.[ class' (Jstr.v "fas"); class' (Jstr.v "fa-times-circle") ]
   in
-  El.set_inline_style
-    (El.Style.display)
-    (Jstr.v "block")
-    block;
-  block
 
-let file_list
-  : App.event E.send -> file -> El.t
-  = fun sender f ->
-    let icon =
-      El.i []
-        ~at:At.[ class' (Jstr.v "fas")
-               ; class' (Jstr.v "fa-check") ] in
-
-    let button =
-      El.i []
-        ~at:At.[ class' (Jstr.v "fas")
-               ; class' (Jstr.v "fa-times-circle") ] in
-
-    El.set_inline_style
-      (Jstr.v "float")
-      (Jstr.v "right")
-      button;
-
-    Ev.listen
-      Ev.click
-      (fun _ -> sender (
-          App.dispatch (module DelFile) f.file))
-      (El.as_target button);
-
-    match f.css with
-    (* A css exists, add the icon element *)
-    | Some _ ->
-      El.div
-        [ El.txt (File.name f.file)
-        ; icon
-        ; button ]
-
-    | None ->
-      El.div
-        [ El.txt (File.name f.file)
-        ; button ]
-
-
-let buttons:
-  state -> El.t -> El.t list
-  = fun state input ->
-    let b = El.button [ El.txt' "Ajouter un fichier…" ]
-        ~at:[ At.class' (Jstr.v "button")] in
-
-    let d = El.button [ El.txt' "Télécharger" ]
-        ~at:[ At.class' (Jstr.v "button")] in
-
-    Ev.listen Ev.click (fun _e -> El.click input) (El.as_target b);
-    Ev.listen Ev.click (fun _ ->
-
-        match state.result_css with
-        | None -> ()
-        | Some result ->
-          let formatter = Format.str_formatter in
-          Css_lib.Print.(css minify_printer formatter result);
-          let content = Format.flush_str_formatter () in
-          Elements.Transfert.send
-            ~mime_type:(Jstr.v "text/css")
-            ~filename:(Jstr.v "result.css")
-            (Jstr.v content)
-      )
-      (El.as_target d);
-
-    let has_css = state.files##some
-        (Js.wrap_callback (fun elem _idx _arr -> Js.bool (elem.css != None))) in
-
-    match Js.to_bool has_css with
-    | true ->  [b; d]
-    | false -> [b]
+  El.set_inline_style (Jstr.v "float") (Jstr.v "right") button;
 
-let display_content css =
+  ignore
+  @@ Ev.listen Ev.click
+       (fun _ -> sender (App.dispatch (module DelFile) f.file))
+       (El.as_target button);
 
+  match f.css with
+  (* A css exists, add the icon element *)
+  | Some _ -> El.div [ El.txt (File.name f.file); icon; button ]
+  | None -> El.div [ El.txt (File.name f.file); button ]
+
+let buttons : state -> El.t -> El.t list =
+ fun state input ->
+  let b =
+    El.button
+      [ El.txt' "Ajouter un fichier…" ]
+      ~at:[ At.class' (Jstr.v "button") ]
+  in
+
+  let d =
+    El.button [ El.txt' "Télécharger" ] ~at:[ At.class' (Jstr.v "button") ]
+  in
+
+  ignore @@ Ev.listen Ev.click (fun _e -> El.click input) (El.as_target b);
+  ignore
+  @@ Ev.listen Ev.click
+       (fun _ ->
+         ignore
+         @@
+         match state.result_css with
+         | None -> ()
+         | Some result ->
+             let formatter = Format.str_formatter in
+             Css_lib.Print.(css minify_printer formatter result);
+             let content = Format.flush_str_formatter () in
+             Elements.Transfert.send ~mime_type:(Jstr.v "text/css")
+               ~filename:(Jstr.v "result.css") (Jstr.v content))
+       (El.as_target d);
+
+  let has_css =
+    state.files##some
+      (Js.wrap_callback (fun elem _idx _arr -> Js.bool (elem.css != None)))
+  in
+
+  match Js.to_bool has_css with
+  | true -> [ b; d ]
+  | false -> [ b ]
+
+let display_content css =
   match css with
   | None -> []
   | Some result ->
-    let formatter = Format.str_formatter in
-    Css_lib.Print.(css pretty_printer formatter result);
-    let content = Format.flush_str_formatter () in
+      let formatter = Format.str_formatter in
+      Css_lib.Print.(css pretty_printer formatter result);
+      let content = Format.flush_str_formatter () in
 
-    let area =
-      El.textarea
-        [  El.txt' content ]   in
+      let area = El.textarea [ El.txt' content ] in
 
-    El.set_inline_style
-      (Jstr.v "width")
-      (Jstr.v "100%")
-      area;
+      El.set_inline_style (Jstr.v "width") (Jstr.v "100%") area;
 
-    El.set_inline_style
-      (Jstr.v "height")
-      (Jstr.v "200px")
-      area;
+      El.set_inline_style (Jstr.v "height") (Jstr.v "200px") area;
 
-    El.set_inline_style
-      (Jstr.v "max-height")
-      (Jstr.v "50vh")
-      area;
+      El.set_inline_style (Jstr.v "max-height") (Jstr.v "50vh") area;
 
-    El.set_inline_style
-      (Jstr.v "resize")
-      (Jstr.v "none")
-      area;
+      El.set_inline_style (Jstr.v "resize") (Jstr.v "none") area;
 
-    [ El.h2 [ El.txt' "Prévisualisation"]
-    ; area ]
+      [ El.h2 [ El.txt' "Prévisualisation" ]; area ]
 
 let main id =
-
-  match (Jv.is_none id) with
-  | true -> Console.(error [str "No element with id '%s' found"; id])
+  match Jv.is_none id with
+  | true -> Console.(error [ str "No element with id '%s' found"; id ])
   | false ->
-    let elements = El.div [] in
-
-    let del_file_event, del_file_sender = Note.E.create () in
-
-    let input, file_event = Elements.Input.file_loader
-        (Jstr.v "css") in
-
-    let add_file_event =
-      Note.E.map
-        (fun Elements.Input.{file ; content} ->
-           let str_content = Jstr.to_string content in
-           let css = try
-               Some (Css.Parser.parse_stylesheet str_content)
-             with
-             |  _ -> None
-           in
-           App.dispatch (module AddFile) { file ; css})
-        file_event in
-
-    let state =
-      App.run
-        init
-        (E.select
-           [ add_file_event
-           ; del_file_event
-           ])
-    in
-
-    (* For each file, add a delete button *)
-    let _ = Elr.def_children
-        elements
-        (S.map (fun state ->
-             let elements =
-               Jv.to_list
-                 (fun x -> file_list del_file_sender (Jv.Id.of_jv x))
-                 (Jv.Id.to_jv state.files) in
-             match elements with
-             | [] -> display_content state.result_css
-             | _ ->
-               List.append
-                 (header::elements)
-                 (display_content state.result_css))
-            state) in
-
-    let header = El.span [] in
-
-    (* The input is hidden, it will be activated by a button *)
-    El.set_inline_style El.Style.display (Jstr.v "none") input;
-
-    Elr.def_children
-      header
-      (S.map (fun state ->
-           input::(buttons state input))
-          state);
-
-    El.set_children (Jv.Id.of_jv id) [El.p [header]; elements]
+      let elements = El.div [] in
+
+      let del_file_event, del_file_sender = Note.E.create () in
+
+      let input, file_event = Elements.Input.file_loader (Jstr.v "css") in
+
+      let add_file_event =
+        Note.E.map
+          (fun Elements.Input.{ file; content } ->
+            let str_content = Jstr.to_string content in
+            let css =
+              try Some (Css.Parser.parse_stylesheet str_content) with
+              | _ -> None
+            in
+            App.dispatch (module AddFile) { file; css })
+          file_event
+      in
+
+      let state = App.run init (E.select [ add_file_event; del_file_event ]) in
+
+      (* For each file, add a delete button *)
+      let _ =
+        Elr.def_children elements
+          (S.map
+             (fun state ->
+               let elements =
+                 Jv.to_list
+                   (fun x -> file_list del_file_sender (Jv.Id.of_jv x))
+                   (Jv.Id.to_jv state.files)
+               in
+               match elements with
+               | [] -> display_content state.result_css
+               | _ ->
+                   List.append (header :: elements)
+                     (display_content state.result_css))
+             state)
+      in
+
+      let header = El.span [] in
+
+      (* The input is hidden, it will be activated by a button *)
+      El.set_inline_style El.Style.display (Jstr.v "none") input;
+
+      Elr.def_children header
+        (S.map (fun state -> input :: buttons state input) state);
+
+      El.set_children (Jv.Id.of_jv id) [ El.p [ header ]; elements ]
 
 let () =
-
   let open Jv in
-  let main = obj
-      [| "attach", (repr main) |] in
+  let main = obj [| ("attach", repr main) |] in
 
   set global "merger" main
diff --git a/lib/application/dune b/lib/application/dune
index 63f2baa..f403b24 100755
--- a/lib/application/dune
+++ b/lib/application/dune
@@ -2,6 +2,7 @@
  (name application)
  (libraries 
    brr
+   note
    brr.note
    )
  )
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) }