diff options
Diffstat (limited to 'js')
| -rwxr-xr-x | js/application.ml | 31 | ||||
| -rw-r--r-- | js/application.mli | 63 | ||||
| -rw-r--r-- | js/content.ml | 122 | ||||
| -rw-r--r-- | js/dune | 23 |
4 files changed, 239 insertions, 0 deletions
diff --git a/js/application.ml b/js/application.ml new file mode 100755 index 0000000..fcc3fb4 --- /dev/null +++ b/js/application.ml @@ -0,0 +1,31 @@ +module Make (S : sig + type t +end) = +struct + module State = S + + module type Processor = sig + type t + + val process : t -> S.t -> S.t + end + + module ID : Processor with type t = unit = struct + type t = unit + + let process () state = state + end + + type event = E : 'a * (module Processor 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 P))) st -> P.process t st) event + in + Note.S.accum ?eq init action + + let dispatch : (module Processor with type t = 's) -> 's -> event = + fun (type s) (module P : Processor with type t = s) v -> E (v, (module P)) +end diff --git a/js/application.mli b/js/application.mli new file mode 100644 index 0000000..2e813f5 --- /dev/null +++ b/js/application.mli @@ -0,0 +1,63 @@ +(** 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 process () state = { value = state.value + 1 } + end + + (** Decrement the state. *) + module Incr = struct + type t = unit + + let process () state = { value = state.value - 1 } + end + + module App = Make(struct type t = state end) + + (* Create the event processor *) + let incr_event = App.dispatch (module Incr) () + and decr_event = App.dispatch (module Decr) () in + + let init = { value = 0 } in + + (* Run the main loop *) + let state = App.run + init + (E.select + [ incr_event + ; decr_event ] ) in … + ]} *) +module Make (S : sig + type t +end) : sig + module type Processor = sig + type t + + val process : t -> S.t -> S.t + end + + module ID : Processor with type t = unit + + type event + + val dispatch : (module Processor with type t = 's) -> 's -> event + (** [dispatch (module P) v] will create an event holding a value [v] and + associated with the processor [P] *) + + val run : ?eq:(S.t -> S.t -> bool) -> S.t -> event Note.E.t -> S.t Note.S.t + (** The function [run state ev] will create a signal continually updated each + time the event [ev] occur *) +end diff --git a/js/content.ml b/js/content.ml new file mode 100644 index 0000000..f41bc46 --- /dev/null +++ b/js/content.ml @@ -0,0 +1,122 @@ +module OptionInfix = Operators.Binding (Option) + +let add_field : + label:Jstr.t -> + id':Jstr.t -> + value':Jstr.t -> + Brr.El.t list -> + Brr.El.t list = + fun ~label ~id' ~value' elt -> + Brr.El.label ~at:Brr.At.[ for' id' ] [ Brr.El.txt label ] + :: Brr.El.input ~at:Brr.At.[ type' (Jstr.v "text"); id id'; value value' ] () + :: elt + +module State = struct + type t = { word : string; len : int; counter : int } + + let repr_html : t -> Brr.El.t list = + fun { word; len; counter } -> + [ + Brr.El.form + @@ add_field ~id':(Jstr.v "text_state") ~label:(Jstr.v "Word received") + ~value':(Jstr.v word) + @@ add_field ~id':(Jstr.v "nbcar_state") ~label:(Jstr.v "Nb of car") + ~value':(Jstr.of_int len) + @@ add_field ~id':(Jstr.v "counter_state") ~label:(Jstr.v "Request sent") + ~value':(Jstr.of_int counter) []; + ] +end + +(** Service transforming the response from the request into the state *) +module WordCount = struct + type t = Services_impl.Nb_car.response + + let process response state = + Brr.Console.log + [ + Jstr.v response.Services_impl.Nb_car.value; + Int64.to_int response.Services_impl.Nb_car.nbcar; + ]; + State. + { + counter = state.counter + 1; + word = response.Services_impl.Nb_car.value; + len = Int64.to_int response.Services_impl.Nb_car.nbcar; + } +end + +module App = Application.Make (State) + +let main () = + let open OptionInfix in + let- content_div = + Brr.Document.find_el_by_id Brr.G.document (Jstr.v "content") + in + + let form = + Brr.El.form + [ + Brr.El.label + ~at:Brr.At.[ for' (Jstr.v "text") ] + [ Brr.El.txt (Jstr.v "Text") ]; + Brr.El.input + ~at: + Brr.At. + [ + type' (Jstr.v "text"); id (Jstr.v "text"); name (Jstr.v "text"); + ] + (); + Brr.El.input + ~at:Brr.At.[ type' (Jstr.v "submit"); value (Jstr.v "Count") ] + (); + ] + in + + (* Listen the submit event on the form. This is an example of event of event : + + First we listen for the click event, and then for the request response + event. *) + let post_event : Brr.El.t -> App.event Note.event = + fun form -> + Note.E.join + @@ Note_brr.Evr.on_el Brr_io.Form.Ev.submit + (fun ev -> + (* Do not send the query, we use it with javascript *) + Brr.Ev.prevent_default ev; + + (* Extract the data from the form *) + let data = Brr_io.Form.(Data.of_form (of_el form)) in + let text_value = Brr_io.Form.Data.find data (Jstr.v "text") in + let value = + match text_value with + | Some (`String s) -> Jstr.to_string s + | _ -> "" + in + + (* Send the request *) + Js_handler.send (module Services_impl.Nb_car) () { value } + |> Note_brr.Futr.to_event + |> Note.E.map (function + | Error _ -> App.dispatch (module App.ID) () + | Ok response -> App.dispatch (module WordCount) response)) + form + in + let bottom = Brr.El.div [] in + Brr.El.append_children content_div [ form; Brr.El.hr (); bottom ]; + + let state = + App.run + { word = ""; len = 0; counter = 0 } + (Note.E.select [ post_event form ]) + in + + Note_brr.Elr.def_children bottom (Note.S.map State.repr_html state); + + let log state = ignore state in + Note.Logr.hold (Note.S.log state log) + +let () = + Brr.Console.(debug [ Jstr.v "Js started" ]); + let open Jv in + let post = obj [| ("start", repr main) |] in + set global "client" post @@ -0,0 +1,23 @@ +(executable + (name content) + (libraries + brr + note + note.brr + + operators + services_impl + js_handler + brr_string + ) + (modes js) + (preprocess (pps js_of_ocaml-ppx)) + (link_flags (:standard -no-check-prims)) + (js_of_ocaml (flags :standard --opt 3 --target-env browser --disable genprim --disable debugger)) + ) + +(rule + (targets content.js) + (deps content.bc.js) + (action (copy %{deps} %{targets}))) + |