refactored YMD uuid and fixed generation issues

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

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
 

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)

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=[])