diff options
| -rwxr-xr-x | css/merger.ml | 36 | ||||
| -rwxr-xr-x | lib/application/application.ml | 58 | ||||
| -rwxr-xr-x | script.it/script.ml | 23 | ||||
| -rwxr-xr-x | script.it/state/state.ml | 18 |
4 files changed, 71 insertions, 64 deletions
diff --git a/css/merger.ml b/css/merger.ml index 514793d..d82df98 100755 --- a/css/merger.ml +++ b/css/merger.ml @@ -20,6 +20,8 @@ type state = ; elements : int } +module App = Application.Make(struct type t = state end) + let init = { files = new%js Js.array_empty ; result_css = None @@ -42,20 +44,10 @@ 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 update file state = let _ = state.files##push file in let elements = state.files##.length and result_css = build_result state.files in @@ -64,7 +56,7 @@ end module DelFile = struct type t = File.t - let apply file state = + let update file state = let files = state.files##filter (Js.wrap_callback @@ (fun elt _ _ -> Js.bool (elt.file != file))) in let elements = files##.length @@ -72,13 +64,6 @@ module DelFile = struct { files ; elements ; result_css } end -let do_action - : (event, state) Application.t - = fun (E (t, (module Handler))) state -> - Handler.apply t state - -type file_event = event S.t - (** Read the content from the file *) let file_loader : file E.send -> File.t -> unit @@ -119,7 +104,7 @@ let header = block let file_list - : event E.send -> file -> El.t + : App.event E.send -> file -> El.t = fun sender f -> let icon = El.i [] @@ -139,8 +124,8 @@ let file_list Ev.listen Ev.click (fun _ -> sender ( - E( f.file - , (module DelFile : Handler with type t = DelFile.t)))) + App.E( f.file + , (module DelFile : App.Event with type t = DelFile.t)))) (El.as_target button); match f.css with @@ -248,13 +233,12 @@ let main id = let state = - Application.run - do_action + App.run init (E.select [ E.map (fun f -> - E ( f - , (module AddFile: Handler with type t = AddFile.t ))) + App.E ( f + , (module AddFile: App.Event with type t = AddFile.t ))) add_file_event ; del_file_event ]) diff --git a/lib/application/application.ml b/lib/application/application.ml index 15452fb..63e12ba 100755 --- a/lib/application/application.ml +++ b/lib/application/application.ml @@ -1,9 +1,49 @@ -(** The type for the applcation *) -type ('a, 'b) t = 'a -> 'b -> 'b - -(** Simple helper for the main event loop *) -let run - : ?eq:('b -> 'b -> bool) -> ('a, 'b) t -> 'b -> 'a Note.E.t -> 'b Note.S.t - = fun ?eq f init event -> - let action = Note.E.map f event in - Note.S.accum ?eq init action +(** The Make module build the main application loop.contents + + The function [run] update the state on each event, and return a new state. + Each event must follow the [event] type, which is composed from the type + [t], and a module with a fonction [update]. + + This example create an application with the state containing a simple + counter. An even which increment this counter is created and can be used to + update the state. + + + [ + type state = { value : int } + + (** Increment the state *) + module Incr = struct + type t = unit + + let update () state = { value = state.value + 1 } + end + + module App = Make(struct type t = state end) + + (* Create the event itself *) + let incr_event = App.E ((), (module Incr:App.Event with type t = Incr.t)) + + ] + +*) +module Make(S:sig type t end) = struct + module type Event = sig + + type t + + val update: t -> S.t -> S.t + + end + + type event = E : 'a * (module Event with type t = 'a) -> event + + (** Simple helper for the main event loop *) + let run + : ?eq:(S.t -> S.t -> bool) -> S.t -> event Note.E.t -> S.t Note.S.t + = fun ?eq init event -> + let action = Note.E.map (fun (E (t, (module Event))) st -> Event.update t st) event in + Note.S.accum ?eq init action +end + + diff --git a/script.it/script.ml b/script.it/script.ml index 29bf2c9..6c2b5d3 100755 --- a/script.it/script.ml +++ b/script.it/script.ml @@ -87,7 +87,7 @@ type 'a param_events = ; angle : float S.t ; export : unit E.t ; delete : unit E.t - ; rendering : State.events E.t + ; rendering : State.event E.t } type slider = @@ -174,7 +174,7 @@ let set_sidebar State.E ( render_type - , (module M: State.Handler with type t = Layer.Paths.printer )) + , (module M: State.Event with type t = Layer.Paths.printer )) ) rendering' in @@ -377,7 +377,7 @@ let page_main id = let module Delete = Script_event.Delete in State.E ( Delete.{ worker } - , (module Delete: State.Handler with type t = Delete.t ))) + , (module Delete: State.Event with type t = Delete.t ))) parameters.delete and export_event = @@ -385,21 +385,21 @@ let page_main id = let module Export = Script_event.Export in State.E ( () - , (module Export: State.Handler with type t = Export.t ))) + , (module Export: State.Event with type t = Export.t ))) parameters.export and angle_event = S.changes parameters.angle |> E.map (fun value -> let module Property = Script_event.Property in State.E ( Property.{ value ; worker ; prop = `Angle } - , (module Property: State.Handler with type t = Property.t ))) + , (module Property: State.Event with type t = Property.t ))) and width_event = S.changes parameters.width |> E.map (fun value -> let module Property = Script_event.Property in State.E ( Property.{ value ; worker ; prop = `Width } - , (module Property: State.Handler with type t = Property.t ))) + , (module Property: State.Event with type t = Property.t ))) and worker_event = Note.E.filter_map (function | `Other t -> @@ -410,7 +410,7 @@ let page_main id = Some ( State.E ( outline - , (module Complete_path: State.Handler with type t = Complete_path.t )))) + , (module Complete_path: State.Event with type t = Complete_path.t )))) worker_event in @@ -439,13 +439,13 @@ let page_main id = let module MouseDown = Script_event.Mouse_down in State.E ( MouseDown.{ position = c ; timer } - , (module MouseDown: State.Handler with type t = MouseDown.t )) + , (module MouseDown: State.Event with type t = MouseDown.t )) | `Out c -> let module Click = Script_event.Click in State.E ( Click.{ point = c ; worker; timer } - , (module Click: State.Handler with type t = Click.t )) + , (module Click: State.Event with type t = Click.t )) ) canva_events in let tick_event = @@ -456,14 +456,13 @@ let page_main id = Option.map (fun p -> State.E ( (f, p) - , (module Tick: State.Handler with type t = Tick.t ))) + , (module Tick: State.Event with type t = Tick.t ))) pos ) in (* The first evaluation is the state. Which is the result of all the successives events to the initial state *) let state = - Application.run - State.do_action + State.run State.init (E.select [ worker_event diff --git a/script.it/state/state.ml b/script.it/state/state.ml index e8cd87e..f3be91d 100755 --- a/script.it/state/state.ml +++ b/script.it/state/state.ml @@ -19,17 +19,7 @@ type state = ; mouse_down_position : Gg.v2 } -module type Handler = sig - - type t - - val update: t -> state -> state - -end - -type t = E : 'a * (module Handler with type t = 'a) -> t - -type events = t +include Application.Make(struct type t = state end) let post : Brr_webworkers.Worker.t -> Worker_messages.to_worker -> unit @@ -73,12 +63,6 @@ let select_segment _ (_, selected, p0, p1) state dist = ; width } -let do_action - : (events, state) Application.t - = fun (E (t, (module Handler))) state -> - Handler.update t state - - let init = { paths = [] ; current = Path.Path_Builder.empty |