summaryrefslogtreecommitdiff
path: root/css
diff options
context:
space:
mode:
Diffstat (limited to 'css')
-rwxr-xr-xcss/merger.ml59
1 files 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