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

consolidated mapping of key-values to fields

Browse Source
This commit is contained in:
Stavros Polymenis 2016-09-21 23:49:20 +01:00
parent 4ece1d6eb0
commit 1f6378ccd5
3 changed files with 12 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/html.ml
View File

@ -59,7 +59,7 @@ let form ymd =
p [
label [
span [pcdata"Text"];
textarea ~a:[a_name "text"] (pcdata "");
textarea ~a:[a_name "body"] (pcdata "");
];
];
p [ button ~a:[a_button_type `Submit] [pcdata "Submit"] ];

18
src/web.ml
View File

@ -27,23 +27,7 @@ let print_form =
let ymd_of_body_pairs pairs =
let open Ymd in
let open Lens.Infix in
let normal v = v |> List.hd |> trim_str in
let of_str y k v = (k ^= normal v) y in
let of_str_list y k v = (k ^= list_of_csv (normal v)) y in
let field_of_pair ymd (key, value) = match key with
| "title" -> of_str ymd (ymd_meta |-- meta_title) value
| "author_name" -> of_str ymd (ymd_meta |-- meta_author |-- author_name) value
| "author_email" -> of_str ymd (ymd_meta |-- meta_author |-- author_email) value
| "publish_date" -> ((ymd_meta |-- meta_date |-- date_published) ^= date_of (normal value)) ymd
| "topics" -> of_str_list ymd (ymd_meta |-- meta_topics) value
| "categories" -> of_str_list ymd (ymd_meta |-- meta_categories) value
| "keywords" -> of_str_list ymd (ymd_meta |-- meta_keywords) value
| "series" -> of_str_list ymd (ymd_meta |-- meta_series) value
| "abstract" -> of_str ymd (ymd_meta |-- meta_abstract) value
| "text" -> of_str ymd (ymd_body) value
| _ -> ymd
in
ListLabels.fold_left ~f:field_of_pair ~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 process_form =

12
src/ymd.ml
View File

@ -61,7 +61,9 @@ let meta_field line =
then (Re_str.(replace_first (regexp "^[ -] ") "" (List.nth e 0)), List.nth e 1)
else (Re_str.(replace_first (regexp "^[ -] ") "" line), "")
let field_map meta (k,v) = match k with
let with_meta_kv meta (k,v) =
let open Lens.Infix in
match k with
| "title" -> of_str meta (meta_title) v
| "name" -> of_str meta (meta_author |-- author_name ) v
| "email" -> of_str meta (meta_author |-- author_email) v
@ -74,10 +76,16 @@ let field_map meta (k,v) = match k with
| "series" -> of_str_list meta meta_series v
| _ -> meta
let with_kv ymd (k,v) =
let open Lens.Infix in
match k with
| "body" -> of_str ymd (ymd_body) v
| _ -> { ymd with meta = with_meta_kv ymd.meta (k,v) }
let meta_of_yaml yaml =
let fields = List.map meta_field (BatString.nsplit yaml "\n") in
let open Lens.Infix in
List.fold_left field_map blank_meta fields
List.fold_left with_meta_kv blank_meta fields
let of_string s =
let segments = Re_str.(split (regexp "^---$")) s in