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 } 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 let update file state = let _ = state.files##push file in let elements = state.files##.length and result_css = build_result state.files in { state with elements ; result_css } end module DelFile = struct type t = File.t let update 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 } 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.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.E( f.file , (module DelFile : App.Event with type t = DelFile.t)))) (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] 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 del_file_event, del_file_sender = Note.E.create () in let file_event, input = 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.E ( { file ; css } , (module AddFile: App.Event with type t = AddFile.t ))) 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 set global "merger" main