diff options
author | Sébastien Dailly <sebastien@dailly.me> | 2023-04-16 14:38:23 +0200 |
---|---|---|
committer | Sébastien Dailly <sebastien@dailly.me> | 2023-04-16 14:38:23 +0200 |
commit | e4f50f8df6e4bc72664b0e5fc2f054694c038973 (patch) | |
tree | c206ee230c29241958f63a12b857b2764bdf9a59 /css | |
parent | 84747bdb2ca8dd209208b6ee897c1ee718e196ae (diff) |
Applied ocamlformat on the code
Diffstat (limited to 'css')
-rwxr-xr-x | css/merger.ml | 367 |
1 files changed, 155 insertions, 212 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 |