From 86ec559f913c389e8dc055b494630f21a45e039b Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Thu, 4 Feb 2021 21:14:01 +0100 Subject: css_merge application --- css/merger.ml | 275 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 275 insertions(+) create mode 100755 css/merger.ml (limited to 'css/merger.ml') diff --git a/css/merger.ml b/css/merger.ml new file mode 100755 index 0000000..7f525ff --- /dev/null +++ b/css/merger.ml @@ -0,0 +1,275 @@ +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 + ; css : Css.Types.Stylesheet.t option + } + +type state = + { files : file Js.js_array Js.t + ; result_css : Css.Types.Stylesheet.t option + ; elements : int + } + +let init = + { files = new%js Js.array_empty + ; result_css = None + ; elements = 0 } + +type event = + | AddFile of file + | DelFile of File.t + +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 + +let do_action + : event -> state -> state + = fun event state -> + match event with + | AddFile file -> + let _ = state.files##push file in + let elements = state.files##.length + and result_css = build_result state.files in + { state with elements ; result_css } + | DelFile file -> + + 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 } + +type file_event = event S.t + +(** Read the content from the file *) +let file_loader + : file E.send -> File.t -> unit + = fun event file -> + let blob = File.as_blob file in + Fut.await + (Blob.text blob) + (Result.iter + (fun content -> + + let str_content = Jstr.to_string content in + let css = try + Some (Css.Parser.parse_stylesheet str_content) + with + | _ -> None + in + event {file; css} )) + +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 + : 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 (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 -> on_change:(Brr.File.t list -> unit) -> El.t list + = fun state ~on_change -> + let _ = state in + (* The input file can't be styled we hide it and use a click forwarding + button instead. *) + let i = El.input () + ~at:[ At.type' (Jstr.v "file") + ; (At.v (Jstr.v "accept")) (Jstr.v ".css") + ] in + El.set_inline_style El.Style.display (Jstr.v "none") i; + + 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 i) (El.as_target b); + Ev.listen Ev.change (fun _e -> on_change (El.Input.files i)) (El.as_target i); + + 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 -> [i; b; d] + | false -> [i; 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 area = + El.textarea + [ El.txt' content ] in + + 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 "max-height") + (Jstr.v "50vh") + area; + + El.set_inline_style + (Jstr.v "resize") + (Jstr.v "none") + 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]) + | false -> + let elements = El.div [] in + + let add_file_event, add_file_sender = Note.E.create () in + let del_file_event, del_file_sender = Note.E.create () in + + let state = + E.select + [ E.map (fun f -> AddFile f) add_file_event + ; del_file_event + ] + |> E.map do_action + |> Note.S.accum init in + + 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 on_change files = file_loader add_file_sender (List.hd files) in + let header = El.span [] in + + Elr.def_children + header + (S.map (fun state -> + buttons ~on_change state) + + 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 + + set global "merger" main -- cgit v1.2.3