From 1a53943340d068a1dbcef2f006e44905bab47bff Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@dailly.me>
Date: Mon, 7 Feb 2022 16:21:09 +0100
Subject: Update

---
 css/merger.ml | 59 +++++++++++++++++++++++++++++++++++++++--------------------
 1 file changed, 39 insertions(+), 20 deletions(-)

diff --git a/css/merger.ml b/css/merger.ml
index a7c33eb..514793d 100755
--- a/css/merger.ml
+++ b/css/merger.ml
@@ -25,10 +25,6 @@ let init =
   ; 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 ->
@@ -46,22 +42,40 @@ let build_result
       Css_lib.Merge.extract_css
       merge_result
 
+module type Handler = sig
+
+  type t
+
+  val apply: t -> state -> state
+
+end
+
+type event = E : 'a * (module Handler with type t = 'a) -> event
+
+module AddFile = struct
+  type t = file
+
+  let apply 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 apply 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 do_action
   : (event, state) Application.t
-  = 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 }
+  = fun (E (t, (module Handler))) state ->
+    Handler.apply t state
 
 type file_event = event S.t
 
@@ -124,7 +138,9 @@ let file_list
 
     Ev.listen
       Ev.click
-      (fun _ -> sender (DelFile f.file))
+      (fun _ -> sender (
+           E( f.file
+            , (module DelFile : Handler with type t = DelFile.t))))
       (El.as_target button);
 
     match f.css with
@@ -236,7 +252,10 @@ let main id =
         do_action
         init
         (E.select
-           [ E.map (fun f -> AddFile f) add_file_event
+           [ E.map (fun f ->
+                 E ( f
+                   , (module AddFile: Handler with type t = AddFile.t )))
+                 add_file_event
            ; del_file_event
            ])
     in
-- 
cgit v1.2.3