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  | 
