├── dune-project ├── src ├── operators.ml ├── dune ├── option.ml ├── keyboard.ml ├── terminal.ml ├── cmd.ml ├── time.ml ├── app.ml ├── sub.ml └── mouse.ml ├── .gitignore ├── .editorconfig ├── examples ├── dune ├── clock.ml ├── multisubs.ml ├── counter.ml └── module.ml ├── Makefile ├── teash.opam ├── UNLICENSE └── README.md /dune-project: -------------------------------------------------------------------------------- 1 | (lang dune 1.0) 2 | -------------------------------------------------------------------------------- /src/operators.ml: -------------------------------------------------------------------------------- 1 | let (>>) f g x = g (f x) 2 | let (<|) = (@@) 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | _build/ 2 | teash.*/ 3 | api/ 4 | *.install 5 | *.merlin 6 | -------------------------------------------------------------------------------- /.editorconfig: -------------------------------------------------------------------------------- 1 | [*] 2 | indent_style = tab 3 | indent_size = 2 4 | trim_trailing_whitespace = true 5 | -------------------------------------------------------------------------------- /src/dune: -------------------------------------------------------------------------------- 1 | (library 2 | (name teash) 3 | (public_name teash) 4 | (libraries 5 | lwt 6 | lwt.unix 7 | lwt_ppx 8 | notty 9 | notty.lwt 10 | ) 11 | (flags (:standard -w "-23")) 12 | (preprocess (pps lwt_ppx)) 13 | ) 14 | -------------------------------------------------------------------------------- /examples/dune: -------------------------------------------------------------------------------- 1 | (executables 2 | (names counter clock multisubs module) 3 | (libraries 4 | teash 5 | lwt 6 | lwt.unix 7 | lwt_ppx 8 | notty 9 | ) 10 | (flags (:standard -w "-23")) 11 | (preprocess (pps lwt_ppx)) 12 | ) 13 | (alias 14 | (name examples) 15 | (deps (glob_files *.exe)) 16 | ) 17 | -------------------------------------------------------------------------------- /src/option.ml: -------------------------------------------------------------------------------- 1 | (* this module is kept around until the stdlib will include something similar *) 2 | 3 | let map f = function None -> None | Some v -> Some (f v) 4 | let is_some = function None -> false | Some _ -> true 5 | let is_none = function None -> true | Some _ -> false 6 | let value = function None -> invalid_arg "Can't get value of None" | Some v -> v 7 | -------------------------------------------------------------------------------- /src/keyboard.ml: -------------------------------------------------------------------------------- 1 | let presses : (Notty.Unescape.key -> 'msg) -> 'msg Sub.t = 2 | fun tagger -> 3 | Sub.registration "keyboard:presses" (fun { push; term; } -> 4 | Notty_lwt.Term.events term 5 | |> Lwt_stream.filter_map 6 | (function 7 | | `Key key -> Some key 8 | | _ -> None 9 | ) 10 | |> Lwt_stream.map tagger 11 | |> Lwt_stream.iter (fun msg -> push (Some msg)) 12 | ) tagger 13 | -------------------------------------------------------------------------------- /src/terminal.ml: -------------------------------------------------------------------------------- 1 | type size = { width : int; height : int; } 2 | 3 | let resizes : (size -> 'msg) -> 'msg Sub.t = 4 | fun tagger -> 5 | Sub.registration "terminal:resizes" (fun { push; term; } -> 6 | Notty_lwt.Term.events term 7 | |> Lwt_stream.filter_map 8 | (function 9 | | `Resize (width,height) -> Some { width; height; } 10 | | _ -> None 11 | ) 12 | |> Lwt_stream.map tagger 13 | |> Lwt_stream.iter (fun msg -> push (Some msg)) 14 | ) tagger 15 | -------------------------------------------------------------------------------- /src/cmd.ml: -------------------------------------------------------------------------------- 1 | type 'msg t = 2 | | None 3 | | Batch of 'msg t list 4 | | Call of 'msg option Lwt.t 5 | 6 | let none = None 7 | let batch cmds = Batch cmds 8 | let call call = Call call 9 | let msg msg = call (Lwt.return_some msg) 10 | 11 | let rec flatten = function 12 | | None -> [] 13 | | Call call -> [call] 14 | | Batch cmds -> cmds |> List.map flatten |> List.concat 15 | 16 | let map : ('a -> 'b) -> 'a t -> 'b t = 17 | fun mapper cmd -> 18 | cmd 19 | |> flatten 20 | |> List.map (Lwt.map (Option.map mapper)) 21 | |> List.map (fun call -> Call call) 22 | |> batch 23 | 24 | let run : 'msg t -> ('msg option -> unit) -> unit Lwt.t = 25 | fun cmd push -> 26 | cmd 27 | |> flatten 28 | |> List.map (Lwt.map push) 29 | |> Lwt.choose 30 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: build doc install examples run clean dev-install dev-update dev-uninstall 2 | 3 | all: build doc examples 4 | 5 | build: 6 | dune build 7 | 8 | doc: 9 | dune build @doc 10 | 11 | install: 12 | dune install 13 | 14 | examples: 15 | dune build @examples 16 | 17 | example_progs := $(basename $(notdir $(wildcard ./examples/*.ml))) 18 | run: examples 19 | ifdef example 20 | dune exec ./examples/$(example).exe 21 | else 22 | @$(info usage: make run example=counter) 23 | @$(info ) 24 | @$(info available progs:) 25 | @$(foreach p,$(example_progs),$(info $(p))) 26 | endif 27 | 28 | clean: 29 | dune clean 30 | 31 | dev-install: 32 | opam install . --working-dir 33 | 34 | dev-update: 35 | opam upgrade . --working-dir 36 | 37 | dev-uninstall: 38 | opam pin remove . 39 | -------------------------------------------------------------------------------- /examples/clock.ml: -------------------------------------------------------------------------------- 1 | open Teash 2 | 3 | type msg = 4 | | Tick of Time.time 5 | | Key of Notty.Unescape.key 6 | 7 | let init () = Time.now (), Cmd.none 8 | 9 | let update time = function 10 | | Tick time' -> time', Cmd.none 11 | | Key (`Escape, _mods) -> time, App.exit 12 | | Key _ -> time, Cmd.none 13 | 14 | let view time = Notty.( 15 | let tm = Unix.localtime time in 16 | I.( 17 | strf "%02d:%02d:%02d" tm.tm_hour tm.tm_min tm.tm_sec 18 | <-> 19 | string A.empty "press ESC to quit" 20 | ) 21 | ) 22 | 23 | let subscriptions _model = 24 | Sub.batch [ 25 | Time.(every second) (fun time -> Tick time); 26 | Keyboard.presses (fun key -> Key key); 27 | ] 28 | 29 | let () = 30 | App.run { 31 | init; 32 | update; 33 | view; 34 | subscriptions; 35 | shutdown = (fun _model -> ()); 36 | } () 37 | -------------------------------------------------------------------------------- /teash.opam: -------------------------------------------------------------------------------- 1 | opam-version: "2.0" 2 | 3 | name: "teash" 4 | version: "0.1.0" 5 | synopsis: "TEA for the shell" 6 | description: """ 7 | A library for developing shell/terminal applications using an 8 | interpretation of The Elm Architecture. 9 | """ 10 | maintainer: "neochrome " 11 | authors: "neochrome " 12 | homepage: "https://github.com/neochrome/teash" 13 | bug-reports: "https://github.com/neochrome/teash/issues" 14 | dev-repo: "git+https://github.com/neochrome/teash.git" 15 | license: "Unlicense" 16 | 17 | build: [ 18 | [make "build"] 19 | ] 20 | 21 | depends: [ 22 | "ocaml" {>= "4.03" & < "4.08.0"} 23 | "dune" {build} 24 | "lwt" {>= "3.2.1"} 25 | "lwt_ppx" {build & >= "1.2.1"} 26 | "notty" {>= "0.2.1"} 27 | "odoc" {build} 28 | ] 29 | -------------------------------------------------------------------------------- /examples/multisubs.ml: -------------------------------------------------------------------------------- 1 | open Teash 2 | 3 | type msg = 4 | | Key of Notty.Unescape.key 5 | | A | B 6 | 7 | type model = { 8 | a : int; 9 | b : int; 10 | } 11 | 12 | let init () = { 13 | a = 0; 14 | b = 0; 15 | }, Cmd.none 16 | 17 | 18 | let update model = function 19 | | Key (`Escape, _mods) -> model, App.exit 20 | | A -> { model with a = model.a + 1 }, Cmd.none 21 | | B -> { model with b = model.b + 1 }, Cmd.none 22 | | _ -> model, Cmd.none 23 | 24 | let view model = Notty.([ 25 | I.string A.(fg blue) "ESC - quit"; 26 | I.strf "a: %d, b: %d" model.a model.b; 27 | ] |> I.vcat) 28 | 29 | let subscriptions _model = 30 | Sub.batch [ 31 | Keyboard.presses (fun key -> Key key); 32 | Time.(every second (fun _ -> A)); 33 | Time.(every second (fun _ -> B)); 34 | ] 35 | 36 | let () = 37 | App.run { 38 | init; 39 | update; 40 | view; 41 | subscriptions; 42 | shutdown = (fun _model -> ()); 43 | } () 44 | -------------------------------------------------------------------------------- /src/time.ml: -------------------------------------------------------------------------------- 1 | type time = float 2 | 3 | let now : unit -> time = Unix.time 4 | 5 | let every : time -> (time -> 'msg) -> 'msg Sub.t = 6 | fun interval tagger -> 7 | let key = "time:every:" ^ (string_of_float interval) in 8 | Sub.registration key (fun { push; _ } -> 9 | let rec repeat () = 10 | tagger (now ()) |> fun msg -> push (Some msg); 11 | let%lwt () = Lwt_unix.sleep interval in 12 | repeat () 13 | in repeat () 14 | ) tagger 15 | 16 | let delay : time -> 'msg -> 'msg Cmd.t = 17 | fun delay msg -> 18 | Lwt.( 19 | Lwt_unix.sleep delay 20 | >|= fun () -> Some msg 21 | ) |> Cmd.call 22 | 23 | let millisecond : time = 1.0 /. 1000.0 24 | let second : time = 1.0 25 | let minute : time = second *. 60.0 26 | let hour : time = minute *. 60.0 27 | let day : time = hour *. 24.0 28 | 29 | let in_milliseconds (t : time) = t /. 1000.0 30 | let in_seconds (t: time) = t 31 | let in_minutes (t: time) = t /. minute 32 | let in_hours (t: time) = t /. hour 33 | let in_days (t: time) = t /. day 34 | -------------------------------------------------------------------------------- /examples/counter.ml: -------------------------------------------------------------------------------- 1 | open Teash 2 | 3 | type msg = 4 | | Inc 5 | | Dec 6 | | Set of int 7 | | Reset 8 | | Key of Notty.Unescape.key 9 | 10 | let init () = 0, Cmd.none 11 | 12 | let key_to_cmd = function 13 | | (`Arrow `Up), _mods -> Cmd.msg Inc 14 | | (`Arrow `Down), _mods -> Cmd.msg Dec 15 | | (`ASCII 's'), _mods -> Cmd.msg (Set 42) 16 | | (`ASCII 'r'), _mods -> Cmd.msg Reset 17 | | (`ASCII 'q'), _mods -> App.exit 18 | | _ -> Cmd.none 19 | 20 | let update counter = function 21 | | Inc -> counter + 1, Cmd.none 22 | | Dec -> counter - 1, Cmd.none 23 | | Set n -> n, Cmd.none 24 | | Reset -> 0, Cmd.none 25 | | Key key -> counter, (key_to_cmd key) 26 | 27 | let view counter = Notty.( 28 | [ 29 | I.strf "counter: %d" counter; 30 | I.string A.empty "up - inc, down - dec, s - set to 42, r - reset, q - quit"; 31 | ] |> I.vcat 32 | ) 33 | 34 | let subscriptions _model = 35 | Keyboard.presses (fun key -> Key key) 36 | 37 | let () = 38 | App.run { 39 | init; 40 | update; 41 | view; 42 | subscriptions; 43 | shutdown = (fun _model -> ()); 44 | } () 45 | -------------------------------------------------------------------------------- /UNLICENSE: -------------------------------------------------------------------------------- 1 | This is free and unencumbered software released into the public domain. 2 | 3 | Anyone is free to copy, modify, publish, use, compile, sell, or 4 | distribute this software, either in source code form or as a compiled 5 | binary, for any purpose, commercial or non-commercial, and by any 6 | means. 7 | 8 | In jurisdictions that recognize copyright laws, the author or authors 9 | of this software dedicate any and all copyright interest in the 10 | software to the public domain. We make this dedication for the benefit 11 | of the public at large and to the detriment of our heirs and 12 | successors. We intend this dedication to be an overt act of 13 | relinquishment in perpetuity of all present and future rights to this 14 | software under copyright law. 15 | 16 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 17 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 18 | MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 19 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR 20 | OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, 21 | ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | 24 | For more information, please refer to 25 | -------------------------------------------------------------------------------- /src/app.ml: -------------------------------------------------------------------------------- 1 | type ('args, 'model, 'msg) config = { 2 | init : 'args -> 'model * 'msg Cmd.t; 3 | update : 'model -> 'msg -> 'model * 'msg Cmd.t; 4 | view : 'model -> Notty.image; 5 | subscriptions : 'model -> 'msg Sub.t; 6 | shutdown : 'model -> unit; 7 | } 8 | 9 | let run : ('args, 'model, 'msg) config -> 'args -> unit = 10 | fun { init; update; view; subscriptions; shutdown; } args -> 11 | 12 | let term = Notty_lwt.Term.create () in 13 | let (msgs : 'msg Lwt_stream.t), (push_msg : 'msg option -> unit) = Lwt_stream.create () in 14 | let sub_context = Sub.({ push = push_msg; term; }) in 15 | 16 | let init_model,init_cmds = init args in 17 | let init_subs = subscriptions init_model |> Sub.(update sub_context empty) in 18 | 19 | let rec process subs cmds model = 20 | let%lwt () = model |> view |> Notty_lwt.Term.image term in 21 | let () = Lwt.async (fun () -> Cmd.run cmds push_msg) in 22 | try%lwt 23 | let%lwt msg = Lwt_stream.last_new msgs in 24 | let new_model,new_cmds = update model msg in 25 | let new_subs = subscriptions new_model |> Sub.(update sub_context subs) in 26 | (process [@tailcall]) new_subs new_cmds new_model 27 | with Lwt_stream.Empty -> begin 28 | shutdown model; 29 | Lwt.return () 30 | end 31 | in 32 | Lwt_main.run (process init_subs init_cmds init_model) 33 | 34 | let exit = Cmd.call Lwt.return_none 35 | -------------------------------------------------------------------------------- /src/sub.ml: -------------------------------------------------------------------------------- 1 | open Operators 2 | 3 | type 'msg context = { 4 | push : 'msg option -> unit; 5 | term : Notty_lwt.Term.t; 6 | } 7 | type 'msg init = 'msg context -> unit Lwt.t 8 | 9 | type 'msg t = 10 | | None 11 | | Batch of 'msg t list 12 | | Registration of string * 'msg init 13 | 14 | let none = None 15 | let batch subs = Batch subs 16 | let registration key (init : 'msg init) tagger = 17 | let ref = Obj.magic tagger |> string_of_int in 18 | Registration (key ^ ref, init) 19 | 20 | module M = Misc.StringMap 21 | 22 | let empty : unit Lwt.t M.t = M.empty 23 | 24 | let rec flatten = function 25 | | None -> [] 26 | | Registration (key,init) -> [key,init] 27 | | Batch batch -> batch |> List.map flatten |> List.concat 28 | 29 | let update (context : 'msg context) (active : unit Lwt.t M.t) (subs : 'msg t) = 30 | let collect = List.fold_left (fun regs (key,init) -> M.add key init regs) M.empty in 31 | let activate init = let sub = init context in Lwt.on_cancel sub (fun () -> ()); sub in 32 | let deactivate = Lwt.cancel in 33 | let inactive = subs |> flatten |> collect in 34 | M.merge (fun _key i a -> 35 | match i, a with 36 | | Some i, None -> Some (activate i) 37 | | None, Some a -> deactivate a; None 38 | | _ -> a 39 | ) inactive active 40 | 41 | let map : ('a -> 'b) -> 'a t -> 'b t = 42 | fun mapper sub -> 43 | sub 44 | |> flatten 45 | |> List.map (fun (key,init) -> key, (fun ctx -> 46 | init { ctx with push = Option.map mapper >> ctx.push } 47 | )) |> List.map (fun (key,init) -> Registration (key,init)) 48 | |> batch 49 | -------------------------------------------------------------------------------- /examples/module.ml: -------------------------------------------------------------------------------- 1 | open Teash 2 | 3 | module Module = struct 4 | type msg = Tick | Tock | Key of Notty.Unescape.key 5 | type model = { state : string; n : int } 6 | let initial = { state = ""; n = 0; } 7 | let subscriptions _model = Keyboard.presses (fun k -> Key k) 8 | let trigger model = model, Cmd.msg Tick 9 | let update model = function 10 | | Tick -> { model with state = "tick"; n = model.n + 1; }, Time.(delay second Tock) 11 | | Tock -> { model with state = "tock"; n = model.n + 1; }, Time.(delay second Tick) 12 | | Key (`ASCII 'r', _mods) -> initial, Cmd.none 13 | | Key (`Escape, _mods) -> model, App.exit 14 | | _ -> model, Cmd.none 15 | let view model = Notty.(I.strf "counter: %d, %s" model.n model.state) 16 | end 17 | 18 | type msg = 19 | | Key of Notty.Unescape.key 20 | | ModuleMsg of Module.msg 21 | 22 | let module_msg m = ModuleMsg m 23 | 24 | type model = { 25 | dispatched : int; 26 | state : Module.model; 27 | } 28 | 29 | let init () = { 30 | dispatched = 0; 31 | state = Module.initial; 32 | }, Cmd.none 33 | 34 | let update model = function 35 | | Key (`Escape, _mods) -> model, App.exit 36 | | Key (`ASCII 't', _mods) -> 37 | let state,cmd = Module.trigger model.state in 38 | { model with state }, Cmd.map module_msg cmd 39 | | ModuleMsg msg -> 40 | let dispatched = model.dispatched + 1 in 41 | let state,cmd = Module.update model.state msg in 42 | { model with dispatched; state }, Cmd.map module_msg cmd 43 | | _ -> model, Cmd.none 44 | 45 | let view model = Notty.([ 46 | I.string A.(fg blue) "t - trigger loop, r - reset counter, ESC - quit"; 47 | I.strf "dispatched: %d" model.dispatched; 48 | I.string A.empty "module state:"; 49 | Module.view model.state; 50 | ] |> I.vcat) 51 | 52 | let subscriptions model = 53 | Sub.batch [ 54 | Keyboard.presses (fun key -> Key key); 55 | Module.subscriptions model.state |> Sub.map module_msg; 56 | ] 57 | 58 | let () = 59 | App.run { 60 | init; 61 | update; 62 | view; 63 | subscriptions; 64 | shutdown = (fun _model -> ()); 65 | } () 66 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # TEASH 2 | [TEA][] for the shell, in OCaml. 3 | 4 | ## Description 5 | Teash is an interpretation of [TEA][] for the shell, 6 | using [Lwt][] and [Notty][] to gain async and terminal 7 | rendering capabilities. Use it to build interactive 8 | terminal programs that are mostly event driven and 9 | organized according to a `Model -> Update -> View` pattern. 10 | Then compile them to either bytecode or native binaries. 11 | 12 | Most of the inspiration for this library comes from the 13 | excellent [bucklescript-tea][] project. 14 | 15 | ## Installation 16 | `opam install teash` 17 | 18 | ## Getting started 19 | Make sure to add a reference to the `teash` library to your build. 20 | 21 | A simple *Hello world* program might look like this: 22 | ```ocaml 23 | (* bring Teash into scope *) 24 | open Teash 25 | 26 | (* a type to define possible messages/events in the program *) 27 | type msg = 28 | | Key of Notty.Unescape.key (* this will hold key presses *) 29 | 30 | (* initialize the model *) 31 | let init () = () 32 | 33 | (* the central message/event handler *) 34 | let update model = function 35 | | Key (`Escape, _mods) -> model, App.exit (* listen for ESC and exit *) 36 | | Key _ -> model, Cmd.none 37 | 38 | (* the view is just a function that returns a Notty.image given the model *) 39 | let view _model = 40 | Notty.(I.string A.(fg red) "Hello World!") 41 | 42 | (* hookup subscription to events *) 43 | let subscriptions _model = 44 | Keyboard.presses (fun key -> Key key) (* subscribe to key presses and map to our msg type *) 45 | 46 | (* "main" *) 47 | let () = 48 | App.run { 49 | init; 50 | update; 51 | view; 52 | subscriptions; 53 | shutdown = (fun _model -> ()); 54 | } () 55 | 56 | ``` 57 | 58 | For further details have a look at the [examples](/examples). 59 | 60 | 61 | [TEA]: https://guide.elm-lang.org/architecture/ "The Elm Architecture" 62 | [Lwt]: https://github.com/ocsigen/lwt 63 | [Notty]: https://github.com/pqwy/notty 64 | [bucklescript-tea]: https://github.com/OvermindDL1/bucklescript-tea 65 | 66 | [api]: https://neochrome.github.io/teash/ 67 | -------------------------------------------------------------------------------- /src/mouse.ml: -------------------------------------------------------------------------------- 1 | type position = { x : int; y : int; } 2 | 3 | let downs : (Notty.Unescape.button -> position -> Notty.Unescape.mods -> 'msg) -> 'msg Sub.t = 4 | fun tagger -> 5 | Sub.registration "mouse:downs" (fun { push; term; } -> 6 | Notty_lwt.Term.events term 7 | |> Lwt_stream.filter_map 8 | (function 9 | | `Mouse (`Press `Scroll _, _, _) -> None 10 | | `Mouse (`Press button, (x,y), mods) -> Some (button, {x;y},mods) 11 | | _ -> None 12 | ) 13 | |> Lwt_stream.map (fun (button,pos,mods) -> tagger button pos mods) 14 | |> Lwt_stream.iter (fun msg -> push (Some msg)) 15 | ) tagger 16 | 17 | let ups : (position -> Notty.Unescape.mods -> 'msg) -> 'msg Sub.t = 18 | fun tagger -> 19 | Sub.registration "mouse:ups" (fun { push; term; } -> 20 | Notty_lwt.Term.events term 21 | |> Lwt_stream.filter_map 22 | (function 23 | | `Mouse (`Release, (x,y), mods) -> Some ({x;y},mods) 24 | | _ -> None 25 | ) 26 | |> Lwt_stream.map (fun (pos,mods) -> tagger pos mods) 27 | |> Lwt_stream.iter (fun msg -> push (Some msg)) 28 | ) tagger 29 | 30 | let drags : (position -> Notty.Unescape.mods -> 'msg) -> 'msg Sub.t = 31 | fun tagger -> 32 | Sub.registration "mouse:drags" (fun { push; term; } -> 33 | Notty_lwt.Term.events term 34 | |> Lwt_stream.filter_map 35 | (function 36 | | `Mouse (`Drag, (x,y), mods) -> Some ({x;y},mods) 37 | | _ -> None 38 | ) 39 | |> Lwt_stream.map (fun (pos,mods) -> tagger pos mods) 40 | |> Lwt_stream.iter (fun msg -> push (Some msg)) 41 | ) tagger 42 | 43 | let scrolls : ([`Up | `Down] -> position -> Notty.Unescape.mods -> 'msg) -> 'msg Sub.t = 44 | fun tagger -> 45 | Sub.registration "mouse:scrolls" (fun { push; term; } -> 46 | Notty_lwt.Term.events term 47 | |> Lwt_stream.filter_map 48 | (function 49 | | `Mouse (`Press (`Scroll dir),(x,y),mods) -> Some (dir,{x;y;},mods) 50 | | _ -> None 51 | ) 52 | |> Lwt_stream.map (fun (dir,pos,mods) -> tagger dir pos mods) 53 | |> Lwt_stream.iter (fun msg -> push (Some msg)) 54 | ) tagger 55 | 56 | (* for low-level use *) 57 | let events : (Notty.Unescape.mouse -> 'msg) -> 'msg Sub.t = 58 | fun tagger -> 59 | Sub.registration "mouse:events" (fun { push; term; } -> 60 | Notty_lwt.Term.events term 61 | |> Lwt_stream.filter_map 62 | (function 63 | | `Mouse event -> Some event 64 | | _ -> None 65 | ) 66 | |> Lwt_stream.map tagger 67 | |> Lwt_stream.iter (fun msg -> push (Some msg)) 68 | ) tagger 69 | --------------------------------------------------------------------------------