path: root/css/merger.ml

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