software-archive/logarion-2016
2
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Wrap webserver with custom CmdLiner term

Browse Source
This commit is contained in:
Stavros Polymenis 2017-10-25 22:09:52 +01:00
parent b1851c4426
commit 66c2d3cd2c
1 changed files with 52 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

39
src/logarion_webserver.ml
View File

@ -44,14 +44,17 @@ let string_response s = `String s |> respond'
let html_response h = `Html h |> respond'
let optional_html_response = function Some h -> html_response h | None -> html_response "Not found"
let () =
let serve config_filename =
let module L = Logarion in
let module Config = Confix.Config.Make (Confix.ConfixToml) in
Random.self_init();
let module Config = Confix.Config.Make (Confix.ConfixToml) in
let toml_config = Config.(config "config.toml") in
let toml_config =
let open Confix.Config in
(if config_filename = "" then Path.with_file "config.toml" else Path.of_string config_filename)
|> function Ok cfg -> Config.from_path cfg | Error str -> prerr_endline str; exit 1
in
let config =
toml_config |> Config.to_record L.Archive.Configuration.of_config
|> function Ok cfg -> cfg | Error str -> prerr_endline str; exit 1
@ -132,6 +135,7 @@ let () =
print_endline @@ "Server address: " ^ Uri.to_string web_config.Configuration.url;
print_endline @@ "Press Ctrl+C to stop.";
let app =
App.empty
|> App.port (match Uri.port web_config.Configuration.url with Some p -> p | None -> 3666)
|> middleware @@
@ -149,4 +153,31 @@ let () =
| None -> None)
|> get "/feed.atom" @@ atom_response lgrn
|> get "/" @@ list_notes "p" lgrn
|> App.run_command
|> App.start
in
Lwt_main.run app
let serve_term =
let open Cmdliner in
let config = Arg.(value & opt string "" & info ["c"; "config"] ~docv:"CONFIG FILENAME" ~doc:"Configuration filename") in
Term.(const serve $ config),
Term.info
"serve"
~doc:"serve repository over web"
~man:[ `S "DESCRIPTION"; `P "Launches a webserver for current repository"]
let help_term =
let open Cmdliner in
Term.(ret (const (`Help (`Pager, None)))),
Term.info
"Logarion webserver" ~version:"0.1.0"
~doc:"Logarion repository web server"
~man:[ `S "BUGS";
`P "Submit bugs https://gitlab.com/orbifx/logarion/issues/new."; ]
let cmds = [ serve_term; help_term ]
let () =
let open Cmdliner in
match Term.eval_choice serve_term cmds with
| `Error _ -> exit 1 | _ -> exit 0