diff --git a/src/logarion.ml b/src/logarion.ml index 384d75a..650da68 100644 --- a/src/logarion.ml +++ b/src/logarion.ml @@ -32,7 +32,7 @@ let of_file s = let m = meta_of_yaml yaml_str in { meta = m; body = md_str } else - { blank_ymd with body = "Error parsing file" } + { (blank_ymd ()) with body = "Error parsing file" } let file_meta_pairs () = let files = Array.to_list @@ Sys.readdir "ymd/" in diff --git a/src/template.ml b/src/template.ml index c6b0741..128fac0 100644 --- a/src/template.ml +++ b/src/template.ml @@ -29,6 +29,7 @@ let fold_text ymd = | "keywords" -> String.concat ", " ymd.meta.keywords; | "series" -> String.concat ", " ymd.meta.series; | "body" -> Omd.to_html (Omd.of_string Ymd.(ymd.body)) + | "uuid" -> Id.to_string ymd.meta.uuid | _ -> prerr_endline ("unknown tag: " ^ e); "" in Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat @@ -38,6 +39,7 @@ let fold_entry (file, meta) = | "abstract" -> meta.abstract | "author_name" -> meta.author.Author.name | "author_email" -> meta.author.Author.email + | "uuid" -> Id.to_string meta.uuid | _ -> prerr_endline ("unknown tag: " ^ e); "" in Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat diff --git a/src/web.ml b/src/web.ml index 60b2b07..f17ffab 100644 --- a/src/web.ml +++ b/src/web.ml @@ -41,7 +41,7 @@ let ymdpath title = return @@ "ymd/" ^ (Ymd.filename_of_title title) ^ ".ymd" let ymd_of_body_pairs pairs = let open Ymd in let open Lens.Infix in - ListLabels.fold_left ~f:(fun a (k,vl) -> with_kv a (k, List.hd vl) ) ~init:blank_ymd pairs + ListLabels.fold_left ~f:(fun a (k,vl) -> with_kv a (k, List.hd vl) ) ~init:(blank_ymd ()) pairs |> ((ymd_meta |-- meta_date |-- Date.edited) ^= Some (Ptime_clock.now ())) let ymd_of_req req = @@ -50,12 +50,13 @@ let ymd_of_req req = let string_response s = `String s |> respond' let html_response h = `Html h |> respond' -let ymd_or_error y = match y with Some (path, meta) -> Logarion.of_file ("ymd/" ^ path) | None -> Ymd.blank_ymd +let ymd_or_error y = match y with Some (path, meta) -> Logarion.of_file ("ymd/" ^ path) | None -> Ymd.blank_ymd () let webcfg = Configuration.of_filename "web.toml" let lgrn = Logarion.Configuration.of_filename "logarion.toml" let () = + Random.self_init();; let (>>=) = Lwt.(>>=) and (>|=) = Lwt.(>|=) in let module L = Logarion in @@ -73,7 +74,7 @@ let () = |> middleware @@ Middleware.static ~local_path:"./share/static" ~uri_prefix:"/static" |> post "/post" (fun req -> ymd_of_req req >>= fun ymd -> L.to_file ymd >>= fun () -> html_response (page_of_ymd ymd)) |> get "/edit/:ttl" (fun r -> ret_param "ttl" r >>= ymdpath >|= ymd >|= form_of_ymd >>= html_response) - |> get "/new" (fun _ -> return Ymd.blank_ymd >|= form_of_ymd >>= html_response) + |> get "/new" (fun _ -> return (Ymd.blank_ymd ()) >|= form_of_ymd >>= html_response) |> get "/text/:ttl" (fun req -> ret_param "ttl" req >>= ymdpath >|= ymd >|= page_of_ymd >>= html_response) |> get "/!/:ttl" (fun req -> ret_param "ttl" req >|= L.latest_file_meta_pair >|= ymd_or_error >|= page_of_ymd >>= html_response) |> get "/" (fun _ -> return (L.file_meta_pairs ()) >|= list_of_ymds >>= html_response) diff --git a/src/ymd.ml b/src/ymd.ml index b6ed9a4..b58cd52 100644 --- a/src/ymd.ml +++ b/src/ymd.ml @@ -21,7 +21,14 @@ module Date = struct Ptime.to_date t |> fun (y, m, d) -> Printf.sprintf "%04d-%02d-%02d" y m d | None -> "" end - + +module Id = struct + type t = Uuidm.t + let to_string = Uuidm.to_string + let of_string = Uuidm.of_string + let generate = Uuidm.v4_gen (Random.get_state ()) +end + module Author = struct type t = { name: name; @@ -39,7 +46,7 @@ type meta = { keywords: string list; series: string list; abstract: string; - uuid: Uuidm.t + uuid: Id.t } [@@deriving lens] type ymd = { @@ -47,16 +54,16 @@ type ymd = { body: string; } [@@deriving lens] -let blank_meta = { +let blank_meta ?(uuid=(Id.generate ())) () = { title = ""; author = Author.({ name = ""; email = "" }); date = Date.({ edited = None; published = None }); categories = []; topics = []; keywords = []; series = []; abstract = ""; - uuid = Uuidm.v4_gen (Random.get_state ()) (); + uuid; } -let blank_ymd = { meta = blank_meta; body = "" } +let blank_ymd ?(uuid=(Id.generate ())) () = { meta = blank_meta ~uuid (); body = "" } let filename_of_title t = let is_reserved = function @@ -92,6 +99,8 @@ let with_meta_kv meta (k,v) = | "keywords" -> of_str_list meta meta_keywords v | "categories"-> of_str_list meta meta_categories v | "series" -> of_str_list meta meta_series v + | "uuid" -> + (match Id.of_string v with Some id -> (meta_uuid ^= id) meta | None -> meta) | _ -> meta let with_kv ymd (k,v) = @@ -109,7 +118,7 @@ let meta_pair_of_string line = let meta_of_yaml yaml = let fields = List.map meta_pair_of_string (BatString.nsplit yaml "\n") in let open Lens.Infix in - List.fold_left with_meta_kv blank_meta fields + List.fold_left with_meta_kv (blank_meta ()) fields let of_string s = let segments = Re_str.(split (regexp "^---$")) s in @@ -119,7 +128,7 @@ let of_string s = let m = meta_of_yaml yaml_str in { meta = m; body = md_str } else - { blank_ymd with body = "Error parsing file" } + { (blank_ymd ()) with body = "Error parsing file" } let make ?(author_name="") ?(author_email="") ?(date_published=None) ?(date_edited=None) ?(abstract="") ?(topics=[]) ?(keywords=[]) ?(categories=[]) ?(series=[])