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

improved Ymd lens interface

Browse Source
This commit is contained in:
Stavros Polymenis 2017-01-15 10:27:20 +00:00
parent 81861d2b1a
commit 76825f2524
2 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/web.ml
View File

@ -56,7 +56,7 @@ 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 ()) pairs
|> ((ymd_meta |-- Meta.lens_date |-- Date.edited) ^= Some (Ptime_clock.now ()))
|> ((ymd_meta |-- Meta.lens_date |-- Date.lens_edited) ^= Some (Ptime_clock.now ()))
let ymd_of_req req =
Lwt.map ymd_of_body_pairs (App.urlencoded_pairs_of_body req)

11
src/ymd.ml
View File

@ -7,7 +7,7 @@ module Date = struct
type t = {
edited: Ptime.t option;
published: Ptime.t option;
} [@@deriving lens]
} [@@deriving lens { prefix = true }]
let rfc_string date = match date with
Some t -> Ptime.to_rfc3339 t | None -> "";;
@ -80,6 +80,11 @@ module Meta = struct
uuid: Id.t
} [@@deriving lens { prefix = true }]
let ( |@ ) l v = Lens.Infix. ( v |. l )
let ( |. ) = Lens.Infix.( |. )
let ( |- ) = Lens.Infix.( |-- )
let ( -| ) = Lens.Infix.( --| )
let blank ?(uuid=(Id.generate ())) () = {
title = "";
author = Author.({ name = ""; email = "" });
@ -145,8 +150,8 @@ let with_meta_kv meta (k,v) =
| "name" -> of_str meta (lens_author |-- Author.name ) v
| "email" -> of_str meta (lens_author |-- Author.email) v
| "abstract" -> of_str meta lens_abstract v
| "published" -> ((lens_date |-- Date.published) ^= Date.of_string v) meta
| "edited" -> ((lens_date |-- Date.edited ) ^= Date.of_string v) meta
| "published" -> ((lens_date |-- Date.lens_published) ^= Date.of_string v) meta
| "edited" -> ((lens_date |-- Date.lens_edited ) ^= Date.of_string v) meta
| "topics" -> of_str_list meta lens_topics v
| "keywords" -> of_str_list meta lens_keywords v
| "categories"->