From 05ccdc38eed410cb8fc32d5cc2e384fb784fe183 Mon Sep 17 00:00:00 2001 From: Stavros Polymenis Date: Thu, 5 Oct 2017 23:41:09 +0100 Subject: [PATCH] Re-implemented Lpath.from_config_paths and of_toml_file to yield Result --- src/core/archive.ml | 8 ++++---- src/core/lpath.ml | 3 ++- src/logarion_cli.ml | 7 +++++-- src/logarion_webserver.ml | 42 +++++++++++++++++++-------------------- 4 files changed, 32 insertions(+), 28 deletions(-) diff --git a/src/core/archive.ml b/src/core/archive.ml index 2797813..34ab149 100644 --- a/src/core/archive.ml +++ b/src/core/archive.ml @@ -18,15 +18,15 @@ module Configuration = struct id; } - let of_toml_file path = - let result = Toml.Parser.from_filename (Lpath.string_of_config path) in + let of_toml_file filename = + let result = Toml.Parser.from_filename (Lpath.string_of_config filename) in match result with - | `Error (str, loc) -> default () + | `Error (str, loc) -> Error str | `Ok toml -> let str = Config.str toml "general" in let default = default () in let default_repo = default.repository |> Lpath.string_of_repo in - { + Ok { repository = (try Lpath.repo_of_string (str "repository" default_repo) with Invalid_argument s -> failwith ("Invalid repository value: " ^ s)); title = str "title" default.title; owner = str "owner" default.owner; diff --git a/src/core/lpath.ml b/src/core/lpath.ml index c46cde5..bb89ea8 100644 --- a/src/core/lpath.ml +++ b/src/core/lpath.ml @@ -20,7 +20,8 @@ let config_paths = let from_config_paths config_file = let basepath = v config_file in let existing dir = path_exists (dir // basepath) in - Config (List.find existing config_paths // basepath) + try Ok (Config (List.find existing config_paths // basepath)) + with Not_found -> Error (config_file ^ " not found in: " ^ String.concat ", " (List.map to_string config_paths)) let fpath_of_repo = function Repo p -> p let string_of_repo r = fpath_of_repo r |> to_string diff --git a/src/logarion_cli.ml b/src/logarion_cli.ml index 2252e5e..3f98a7c 100644 --- a/src/logarion_cli.ml +++ b/src/logarion_cli.ml @@ -4,8 +4,11 @@ module C = Archive.Configuration module Lpath = Logarion.Lpath let conf () = - try C.of_toml_file (Lpath.from_config_paths "logarion.toml") - with Not_found -> prerr_endline ("No logarion.toml; using default values"); C.default () + let result = match Lpath.from_config_paths "logarion.toml" with + | Ok filepath -> C.of_toml_file filepath + | Error str -> Error str + in + match result with Ok cfg -> cfg | Error str -> prerr_endline str; exit 1 let init = let f force = diff --git a/src/logarion_webserver.ml b/src/logarion_webserver.ml index 1f94ab2..8406d41 100644 --- a/src/logarion_webserver.ml +++ b/src/logarion_webserver.ml @@ -21,11 +21,11 @@ module Configuration = struct let of_toml_file fn = let result = Toml.Parser.from_filename (Lpath.string_of_config fn) in match result with - | `Error (str, loc) -> default + | `Error (str, loc) -> Error str | `Ok toml -> let default_url = Uri.to_string default.url in let open Logarion.Config in - { + Ok { url = str toml "general" "url" default_url |> Uri.of_string; static = path toml "general" "static_dir" default.static; styles = paths toml "general" "stylesheets" default.styles; @@ -45,7 +45,6 @@ let note_of_body_pairs pairs = let open Meta in let open Date in { note with meta = { note.meta with date = { note.meta.date with edited = Some (Ptime_clock.now ()) }}} -(* |> ((Note.Lens.meta |-- Meta.Lens.date |-- Meta.Date.Lens.edited) ^= )*) let note_of_req req = Lwt.map note_of_body_pairs (App.urlencoded_pairs_of_body req) @@ -59,32 +58,33 @@ let () = Random.self_init(); let config = - let open L.Archive.Configuration in - try of_toml_file (Lpath.from_config_paths "logarion.toml") - with Not_found -> - prerr_endline "Warning: logarion.toml not found in $PWD, $HOME/.config/logarion or /etc/logarion. Using default values"; - default () + let result = match Lpath.from_config_paths "logarion.toml" with + | Ok filepath -> L.Archive.Configuration.of_toml_file filepath + | Error s -> Error s + in + match result with Ok cfg -> cfg | Error str -> prerr_endline str; exit 1 in - let wcfg = - try Configuration.of_toml_file (Lpath.from_config_paths "web.toml") - with Not_found -> - prerr_endline "Warning: web.toml not found in $PWD, $HOME/.config/logarion or /etc/logarion. Using default values"; - Configuration.default + let web_config = + let result = match Lpath.from_config_paths "web.toml" with + | Ok filepath -> Configuration.of_toml_file filepath + | Error s -> Error s + in + match result with Ok cfg -> cfg | Error str -> prerr_endline str; exit 1 in - Logarion.Config.Validation.terminate_when_invalid (Configuration.validity wcfg); + Logarion.Config.Validation.terminate_when_invalid (Configuration.validity web_config); Logarion.Config.Validation.terminate_when_invalid (L.Archive.Configuration.validity config); let module L = Logarion.Archive.Make(File) in let store = File.store config.repository in let lgrn = L.{ config; store; } in - let header_tpl = Template.header wcfg.Configuration.template in - let list_tpl = Template.list wcfg.Configuration.template in - let item_tpl = Template.item wcfg.Configuration.template in - let note_tpl = Template.note wcfg.Configuration.template in + let header_tpl = Template.header web_config.Configuration.template in + let list_tpl = Template.list web_config.Configuration.template in + let item_tpl = Template.item web_config.Configuration.template in + let note_tpl = Template.note web_config.Configuration.template in - let blog_url = Uri.to_string wcfg.Configuration.url in + let blog_url = Uri.to_string web_config.Configuration.url in let module Html = Converters.Html in let page_of_msg = Html.of_message ~header_tpl blog_url config in let page_of_note = Html.of_note ~header_tpl ~note_tpl blog_url config in @@ -142,10 +142,10 @@ let () = in App.empty - |> App.port (match Uri.port wcfg.Configuration.url with Some p -> p | None -> 3666) + |> App.port (match Uri.port web_config.Configuration.url with Some p -> p | None -> 3666) |> middleware @@ Middleware.static - ~local_path:(Fpath.to_string wcfg.Configuration.static) + ~local_path:(Fpath.to_string web_config.Configuration.static) ~uri_prefix:"/static" |> get "/:ttl" @@ view_note "ttl" lgrn (L.note_with_alias lgrn) |> post "/post.note" @@ post_note lgrn