From e4f50f8df6e4bc72664b0e5fc2f054694c038973 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Sun, 16 Apr 2023 14:38:23 +0200 Subject: Applied ocamlformat on the code --- css/merger.ml | 367 ++++++++++++++++++------------------------- lib/application/dune | 1 + viz.js/process/formatter.ml | 114 ++++++-------- viz.js/process/tab_Lexer.mll | 2 +- 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=<") +let shape = + Printer.inject + "[label=<
" -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 "") 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 "
") - content - )##concat + let acc' = + (acc##concat_4 + (Js.string "
") content)##concat (Js.string "
>];\n")) links; - ) else ( - acc - ) in + if level >= 0 then + print_links (acc##concat (Js.string ">];\n")) links + else acc + in parse lexbuf acc' (Js.string "") (-1) [] - | Separator -> - let text = "" in + | Separator -> + let text = "" 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 ">];\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 ">];\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) } -- cgit v1.2.3