diff options
| -rw-r--r-- | bin/dune | 2 | ||||
| -rw-r--r-- | bin/leda.ml | 32 |
2 files changed, 20 insertions, 14 deletions
@@ -1,5 +1,5 @@ (executable (public_name leda) (name leda) - (libraries base cmdliner curses gemini lwt lwt_ppx mirage-crypto-rng.lwt) + (libraries base cmdliner notty notty.lwt gemini lwt lwt_ppx mirage-crypto-rng.lwt) (preprocess (pps lwt_ppx))) diff --git a/bin/leda.ml b/bin/leda.ml index abe1839..4b86330 100644 --- a/bin/leda.ml +++ b/bin/leda.ml @@ -1,6 +1,11 @@ open Base open Base.Result +open Notty +open Notty.Infix +open Notty_lwt + + module M = Gemini.MimeTextGemini.MimeTextGemini let test_parse s = M.gemini_to_canon_str (M.str_to_gemini s) @@ -12,24 +17,25 @@ let () = Lwt_main.run begin let%lwt () = Mirage_crypto_rng_lwt.initialize () in let request : (R.request, string) Base.Result.t = R.make_request (Sys.get_argv()).(1) in + let rec loop t = + match%lwt Lwt_stream.next (Term.events t) with + | `Key _ -> Lwt.return () + | _ -> loop t in match request with | Ok request -> - let w = Curses.initscr () in - let () = Curses.wclear w in + let t = Term.create () in (match%lwt R.session request with | Ok r -> - let _ = Curses.mvwaddstr w 0 0 ("STATUS: " ^ (R.name_of_response r)) in - let _ = Curses.mvwaddstr w 1 0 ("STATUS LINE: " ^ (R.header_of_response r)) in - let _ = match r with - | SUCCESS (_, c) | SUCCESS_EOCSS (_, c) -> Curses.mvwaddstr w 2 0 c - | _ -> false in - let _ = Curses.refresh () in - let _ = Curses.getch () in - let _ = Curses.endwin () in - Lwt.return () + let h = (I.string A.empty ("STATUS: " ^ (R.name_of_response r))) + <-> (I.string A.empty ("STATUS LINE: " ^ (R.header_of_response r))) in + let c = match r with + | SUCCESS (_, c) | SUCCESS_EOCSS (_, c) -> I.string A.empty c + | _ -> I.empty in + let%lwt () = Term.image t (h <-> c) in + let%lwt () = Term.refresh t in + loop t | Error m -> - let _ = Curses.refresh () in - let _ = Curses.endwin () in + let%lwt () = Term.release t in Lwt_io.printl m) | Error m -> Lwt_io.printl m end |