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

Re-implemented Lpath.from_config_paths and of_toml_file to yield Result

Browse Source
This commit is contained in:
Stavros Polymenis 2017-10-05 23:41:09 +01:00
parent 2dc3ebbfbe
commit 05ccdc38ee
4 changed files with 32 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/core/archive.ml
View File

@ -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;

3
src/core/lpath.ml
View File

@ -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

7
src/logarion_cli.ml
View File

@ -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 =

42
src/logarion_webserver.ml
View File

@ -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