From f7e14e498343d2dffab062402ea6000ffbb8d704 Mon Sep 17 00:00:00 2001 From: Ryan Kavanagh Date: Sat, 6 Jun 2020 10:39:39 -0400 Subject: Basic curses interface --- bin/dune | 2 +- bin/leda.ml | 27 +++++++++++++++++++++------ 2 files changed, 22 insertions(+), 7 deletions(-) diff --git a/bin/dune b/bin/dune index c24d8bf..9861cc3 100644 --- a/bin/dune +++ b/bin/dune @@ -1,5 +1,5 @@ (executable (public_name leda) (name leda) - (libraries base gemini lwt lwt_ppx) + (libraries base cmdliner curses gemini lwt lwt_ppx mirage-crypto-rng.lwt) (preprocess (pps lwt_ppx))) diff --git a/bin/leda.ml b/bin/leda.ml index 3aa7c58..80c07af 100644 --- a/bin/leda.ml +++ b/bin/leda.ml @@ -1,15 +1,30 @@ +open Base +open Base.Result + module M = Gemini.MimeTextGemini.MimeTextGemini let test_parse s = M.gemini_to_canon_str (M.str_to_gemini s) module T = Gemini.MimeType.MimeType -module R = Gemini.GeminiTransaction.GeminiTransaction(T) +module R = Gemini.GeminiTransaction.GeminiTransaction(T)(Gemini.TlsUtils.TlsUtils) let () = Lwt_main.run begin - let req = R.make_request ~url:"gemini://gemini.circumlunar.space/\r\n" in - let%lwt response = R.transaction req in - match response with - | Ok (_, _, s) -> Lwt_io.printl s + let%lwt () = Mirage_crypto_rng_lwt.initialize () in + let request : (R.request, string) Base.Result.t = R.make_request (Sys.get_argv()).(1) in + match request with + | Ok request -> + let w = Curses.initscr () in + let () = Curses.wclear w in + (match%lwt R.session request with + | Ok (s, c) -> + let _ = Curses.mvwaddstr w 0 0 ("STATUS: " ^ (R.name_of_status s)) in + let _ = Curses.mvwaddstr w 1 0 ("STATUS LINE: " ^ (R.string_of_status s)) in + let _ = Curses.mvwaddstr w 2 0 c in + let _ = Curses.refresh () in + let _ = Curses.getch () in + let _ = Curses.endwin () in + Lwt.return () + | Error m -> Lwt_io.printl m) | Error m -> Lwt_io.printl m - end + end -- cgit v1.2.3