1 files changed, 275 insertions, 0 deletions
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