storage of ymd; change of date type

Makefile

@@ -3,7 +3,7 @@ all: web
 
 web: logarion.cmx html.cmx src/web.ml
 	ocamlfind ocamlopt -o logarion-web -linkpkg \
-	-package opium.unix,omd,str,tyxml,lens \
+	-package opium.unix,omd,str,tyxml,lens,ptime,ptime.clock.os \
 	logarion.cmx html.cmx src/web.ml
 
 html.cmx: src/html.ml logarion.cmx
@@ -13,5 +13,5 @@ html.cmx: src/html.ml logarion.cmx
 
 logarion.cmx: src/logarion.ml
 	ocamlfind ocamlopt -c -o logarion.cmx -linkpkg \
-	-package omd,lens,lens.ppx_deriving \
+	-package omd,lens,lens.ppx_deriving,ptime \
 	src/logarion.ml

src/logarion.ml

@@ -6,14 +6,14 @@ type author = {
   } [@@deriving lens]
 
 type date = {
-    edited: float;
-    published: float;
+    edited: Ptime.t option;
+    published: Ptime.t option;
   } [@@deriving lens]
 
 type meta = {
     title: string;
     author: author;
-    dates: date;
+    date: date;
     categories: string list;
     topics: string list;
     keywords: string list;
@@ -30,7 +30,7 @@ open Str
 
 let blank_meta = {
     title = ""; author = { name = ""; email = "" };
-    dates = { edited = 0.0; published = 0.0 };
+    date = { edited = None; published = None };
     categories = []; topics = []; keywords = []; series = [];
     abstract = ""
   }
@@ -41,7 +41,7 @@ let blank_ymd =
 let load_file f =
   let ic = open_in f in
   let n = in_channel_length ic in
-  let s = String.create n in
+  let s = Bytes.create n in
   really_input ic s 0 n;
   close_in ic;
   (s)
@@ -55,9 +55,12 @@ let meta_field line =
 let meta_of_yaml yaml =
   let lines = split (regexp "\n") yaml in
   let fields = List.map meta_field lines in
+  let open Lens.Infix in
   let field_map meta (k,v) = match k with
     | "title" -> { meta with title = v }
     | "abstract" -> { meta with abstract = v }
+    | "published" -> ((meta_date |-- date_published) ^=
+                        (match Ptime.of_rfc3339 v with Ok (t,_,_) -> Some t | Error _ -> None )) meta
     | _ -> meta
   in
   List.fold_left field_map blank_meta fields
@@ -69,6 +72,27 @@ let of_file s =
   let m = meta_of_yaml yaml_str in
   { meta = m; body = md_str }
 
+let to_string ymd =
+  let buf = Buffer.create (String.length ymd.body + 256) in
+  let buf_acc = Buffer.add_string buf in
+  let str_of_ptime time = match time with
+    | Some t -> Ptime.to_rfc3339 t | None -> "" in
+  List.map buf_acc [
+             "---\n";
+             "title: ";   ymd.meta.title;
+             "\nauthors:";
+             "\n- name: ";  ymd.meta.author.name;
+             "\n  email: "; ymd.meta.author.email;
+             "\ndate:";
+             "\n  edited: ";    str_of_ptime ymd.meta.date.edited;
+             "\n  published: "; str_of_ptime ymd.meta.date.published;
+             "\ncategories: ";  String.concat ", " ymd.meta.categories;
+             "\ntopics: "; String.concat ", " ymd.meta.topics;
+             "\n---\n"; ymd.body;
+           ];
+  Buffer.contents buf
+
+
 let titles () =
   let ymds = Array.to_list @@ Sys.readdir "ymd/" in
   let t y = (of_file ("ymd/" ^ y)).meta.title in

src/web.ml

@@ -28,19 +28,24 @@ let ymd_of_body_pairs pairs =
   let open Logarion in
   let open Lens.Infix in
   let field_of_pair ymd (key, value) = match key with
-    | "title"  -> ((ymd_meta |-- meta_title  |-- title ^= List.hd value) ymd
+    | "title"  -> ((ymd_meta |-- meta_title) ^= List.hd value) ymd
     | "author" -> ((ymd_meta |-- meta_author |-- author_name) ^= List.hd value) ymd
     | "text"   -> { ymd with body = List.hd value }
     | _ -> ymd
   in
   ListLabels.fold_left ~f:field_of_pair ~init:blank_ymd pairs
+  |> ((ymd_meta |-- meta_date |-- date_edited) ^= Some (Ptime_clock.now ()))
 
 let process_form =
   post "/()/new"
        begin fun req ->
        let pairs = Lwt_main.run @@ App.urlencoded_pairs_of_body req in
        let open Logarion in
-       `Html (Html.html_of (ymd_of_body_pairs pairs)) |> respond'
+       let ymd = ymd_of_body_pairs pairs in
+       let oc = open_out "ymd/saved.ymd" in
+       Printf.fprintf oc "%s" (to_string ymd);
+       close_out oc;
+       `Html (Html.html_of ymd) |> respond'
        end
 
 let print_toc =