From e138b192bc89c34875ba21495e4ebdaada82a24f Mon Sep 17 00:00:00 2001 From: Stavros Polymenis Date: Sun, 16 Apr 2017 00:07:33 +0100 Subject: [PATCH] Refactores Meta submodule into a standalone module --- src/atom.ml | 5 +- src/html.ml | 6 +- src/logarion.ml | 26 +++--- src/template.ml | 7 +- src/web.ml | 5 +- src/ymd.ml | 208 +----------------------------------------------- 6 files changed, 25 insertions(+), 232 deletions(-) diff --git a/src/atom.ml b/src/atom.ml index 69edfac..5c226e6 100644 --- a/src/atom.ml +++ b/src/atom.ml @@ -17,16 +17,15 @@ let opt_element tag_name content body = let entry repo url logarion note = let open Logarion in let ymd = Entry.to_ymd repo note in - let open Ymd in let open Meta in let open Author in let u = "note/" ^ Entry.slug note in let meta = ymd.meta in ("" ^ "" ^ meta.title ^ "" - ^ "urn:uuid:" ^ Ymd.Id.to_string meta.uuid ^ "" + ^ "urn:uuid:" ^ Meta.Id.to_string meta.uuid ^ "" ^ "" - ^ "" ^ Ymd.Date.(meta.date |> last |> rfc_string) ^ "" + ^ "" ^ Date.(meta.date |> last |> rfc_string) ^ "" ^ "" |> opt_element "name" @@ esc meta.author.name |> opt_element "email" @@ esc meta.author.email diff --git a/src/html.ml b/src/html.ml index 9e685e6..06b7517 100644 --- a/src/html.ml +++ b/src/html.ml @@ -24,7 +24,7 @@ let logarion_text ?(text_tpl=None) ymd = article [ details (summary [Unsafe.data Ymd.(ymd.meta.Meta.abstract)]) - [time ~a:[a_datetime Ymd.(Date.(pretty_date @@ last ymd.meta.Meta.date))] []]; + [time ~a:[a_datetime Meta.(Date.(pretty_date @@ last ymd.meta.Meta.date))] []]; Unsafe.data ymd_body; ] @@ -32,7 +32,7 @@ let of_ymd ?(header_tpl=None) ?(text_tpl=None) blog_url lgrn ymd = logarion_page ~header_tpl blog_url - (Ymd.title ymd ^ " by " ^ Ymd.(ymd.meta.Meta.author.Author.name)) + (Ymd.title ymd ^ " by " ^ ymd.Ymd.meta.Meta.author.Meta.Author.name) Logarion.Configuration.(lgrn.title) (logarion_text ~text_tpl ymd) |> to_string @@ -41,7 +41,7 @@ let article_link entry = let open Logarion.Entry in let u = "/note/" ^ slug entry in li [a ~a:[a_href (uri_of_string u)] - [Unsafe.data (title entry ^ (Ymd.Date.pretty_date (entry |> date |> Ymd.Date.last))) ] + [Unsafe.data (title entry ^ (Meta.Date.pretty_date (entry |> date |> Meta.Date.last))) ] ] let of_entries ?(header_tpl=None) ?(listing_tpl=None) ?(entry_tpl=None) blog_url lgrn = diff --git a/src/logarion.ml b/src/logarion.ml index cfab73e..8571893 100644 --- a/src/logarion.ml +++ b/src/logarion.ml @@ -1,4 +1,4 @@ -module Id = Ymd.Id +module Id = Meta.Id type repo_t = Repodir of Fpath.t type uuid_t = UUIDdir of Fpath.t @@ -71,21 +71,21 @@ let uuid_path (repo : repo_t) ymd = let slug string = Filename.(string |> basename |> chop_extension) module Entry = struct - type t = { filename : article_t; attributes : Ymd.Meta.t } [@@deriving lens { submodule = true }] + type t = { filename : article_t; attributes : Meta.t } [@@deriving lens { submodule = true }] - open Ymd.Meta + open Meta let title e = e.attributes.title let date e = e.attributes.date - let date_edited e = (date e).Ymd.Date.edited - let date_published e = (date e).Ymd.Date.published - let author_name e = e.attributes.author.Ymd.Author.name - let author_email e = e.attributes.author.Ymd.Author.email - let published e = Ymd.CategorySet.published e.attributes.categories - let listed e = Ymd.CategorySet.listed e.attributes.categories + let date_edited e = (date e).Date.edited + let date_published e = (date e).Date.published + let author_name e = e.attributes.author.Author.name + let author_email e = e.attributes.author.Author.email + let published e = CategorySet.published e.attributes.categories + let listed e = CategorySet.listed e.attributes.categories let of_filename repo (filename : article_t) = let ymd = File.ymd (articlefilename_path (article_path repo filename)) in - let attributes = { ymd.meta with title = Ymd.title ymd } in + let attributes = { ymd.Ymd.meta with title = Ymd.title ymd } in { filename; attributes } let to_filename repo ymd = @@ -98,7 +98,7 @@ module Entry = struct let slug entry = Fpath.(entry.filename |> articlefilename_path |> base |> rem_ext |> to_string) - let compare_recency a b = Ymd.Date.compare (date b) (date a) + let compare_recency a b = Date.compare (date b) (date a) end let rec next_semantic_filepath ?(version=0) titles ymd = @@ -130,7 +130,7 @@ module Archive = struct let open Lwt.Infix in to_filename repo ymd >>= fun () -> let open Ymd in - (if not (categorised [Category.Draft] ymd) && ymd.meta.Meta.title <> "" then + (if not (categorised [Meta.Category.Draft] ymd) && ymd.Ymd.meta.Meta.title <> "" then let entries = of_repo repo in let titledir = titledir repo in begin try @@ -154,7 +154,7 @@ module Archive = struct | h :: t -> unique_entry (if not (exists (fun x -> x = h) ts) then cons h ts else ts) t | [] -> ts in - let unique_topics ts x = unique_entry ts x.Entry.attributes.Ymd.Meta.topics in + let unique_topics ts x = unique_entry ts x.Entry.attributes.Meta.topics in fold_left unique_topics [] archive let latest_listed entries = entries |> listed |> latest diff --git a/src/template.ml b/src/template.ml index 3b392c6..1db4bcf 100644 --- a/src/template.ml +++ b/src/template.ml @@ -38,8 +38,8 @@ let fold_entry (entry : Logarion.Entry.t) = | "date_created" | "date_edited" | "date_published" - | "date_human" -> "" - | tag -> Ymd.Meta.value_with_name entry.attributes tag in + | "date_human" -> "" + | tag -> Meta.value_with_name entry.attributes tag in Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat let fold_header blog_url title = @@ -50,11 +50,10 @@ let fold_header blog_url title = Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat let fold_index ?(entry_tpl=None) lgrn = - let open Ymd in let open Logarion.Entry in let simple entry = "
  • " - ^ entry.attributes.Meta.title ^ " ~ " ^ Date.(pretty_date (entry |> date |> last)) ^ "
    • " in + ^ entry.attributes.Meta.title ^ " ~ " ^ Meta.Date.(pretty_date (entry |> date |> last)) ^ "" in let fold_entry tpl entry = fold_entry entry tpl in let entry = match entry_tpl with Some (Listing_entry e) -> fold_entry e | None -> simple in let escaped e = match e with diff --git a/src/web.ml b/src/web.ml index 627a5c4..e6221c9 100644 --- a/src/web.ml +++ b/src/web.ml @@ -57,9 +57,8 @@ end let ymd_of_body_pairs pairs = let open Lens.Infix in - let open Ymd in - ListLabels.fold_left ~f:(fun a (k,vl) -> with_kv a (k, List.hd vl) ) ~init:(blank ()) pairs - |> ((Lens.meta |-- Meta.Lens.date |-- Date.Lens.edited) ^= Some (Ptime_clock.now ())) + ListLabels.fold_left ~f:(fun a (k,vl) -> Ymd.with_kv a (k, List.hd vl) ) ~init:(Ymd.blank ()) pairs + |> ((Ymd.Lens.meta |-- Meta.Lens.date |-- Meta.Date.Lens.edited) ^= Some (Ptime_clock.now ())) let ymd_of_req req = Lwt.map ymd_of_body_pairs (App.urlencoded_pairs_of_body req) diff --git a/src/ymd.ml b/src/ymd.ml index 92d364c..895e982 100644 --- a/src/ymd.ml +++ b/src/ymd.ml @@ -1,189 +1,11 @@ open Lens - -type name = string -type email = string - -module Date = struct - type t = { - created: Ptime.t option; - edited: Ptime.t option; - published: Ptime.t option; - } [@@deriving lens { submodule = true }] - - let rfc_string date = match date with Some t -> Ptime.to_rfc3339 t | None -> "" - - let of_string (rfc : string) = match Ptime.of_rfc3339 rfc with - Ok (t,_,_) -> Some t | Error _ -> None - - let last (date : t) = - let ds = [ date.created; date.edited; date.published ] in - let open List in - let ds' = - fold_left (fun a d -> match d with Some d -> d :: a | None -> a) [] ds - |> sort Ptime.compare - in - let len = List.length ds' in - if len > 0 then Some (nth ds' (pred len)) - else None - - let compare a b = compare (last a) (last b) - - let pretty_date = function - | Some t -> 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; - email: email; - } [@@deriving lens { submodule = true } ] - let of_string ~email name = { name; email } -end - -module Category = struct - type t = Draft | Unlisted | Published | Custom of string - - let compare = Pervasives.compare - - let of_string = function - | "draft" -> Draft - | "unlisted" -> Unlisted - | "published" -> Published - | c -> Custom c - - let to_string = function - | Draft -> "draft" - | Unlisted -> "unlisted" - | Published -> "published" - | Custom c -> c -end - -module CategorySet = struct - include Set.Make(Category) - let to_csv set = - let f elt a = - let s = Category.to_string elt in - if a <> "" then a ^ ", " ^ s else s - in - fold f set "" - let categorised categs cs = of_list categs |> (fun s -> subset s cs) - let published = categorised [Category.Published] - let listed cs = not @@ categorised [Category.Unlisted] cs -end - -module Meta = struct - type t = { - title: string; - author: Author.t; - date: Date.t; - categories: CategorySet.t; - topics: string list; - keywords: string list; - series: string list; - abstract: string; - uuid: Id.t - } [@@deriving lens { submodule = true }] - - let blank ?(uuid=(Id.generate ())) () = { - title = ""; - author = Author.({ name = ""; email = "" }); - date = Date.({ created = None; edited = None; published = None }); - categories = CategorySet.empty; topics = []; keywords = []; series = []; - abstract = ""; - uuid; - } - - let value_with_name (meta as m) = - function - | "title" -> m.title - | "abstract" -> m.abstract - | "author_name" -> m.author.Author.name - | "author_email" -> m.author.Author.email - | "date" -> Date.(rfc_string @@ last m.date) - | "date_created" -> Date.(rfc_string m.date.created) - | "date_edited" -> Date.(rfc_string m.date.edited) - | "date_published"-> Date.(rfc_string m.date.published) - | "date_human" -> Date.(pretty_date @@ last m.date) - | "topics" -> String.concat ", " m.topics; - | "categories" -> CategorySet.to_csv m.categories; - | "keywords" -> String.concat ", " m.keywords; - | "series" -> String.concat ", " m.series; - | "uuid" -> Id.to_string m.uuid - | e -> raise @@ Invalid_argument e - - let with_kv meta (k,v) = - let list_of_csv = Re_str.(split (regexp " *, *")) in - let open Infix in - let of_str y k v = (k ^= String.trim v) y in - let of_str_list y k v = (k ^= list_of_csv (String.trim v)) y in - let open Lens in - match k with - | "title" -> of_str meta title v - | "author" -> of_str meta (author |-- Author.Lens.name ) v - | "name" -> of_str meta (author |-- Author.Lens.name ) v - | "email" -> of_str meta (author |-- Author.Lens.email) v - | "abstract" -> of_str meta abstract v - | "date" -> ((date |-- Date.Lens.created) ^= Date.of_string v) meta - | "published" -> ((date |-- Date.Lens.published) ^= Date.of_string v) meta - | "edited" -> ((date |-- Date.Lens.edited ) ^= Date.of_string v) meta - | "topics" -> of_str_list meta topics v - | "keywords" -> of_str_list meta keywords v - | "categories"-> - let list = String.trim v |> list_of_csv in - let list = List.map Category.of_string list in - (categories ^= CategorySet.of_list list) meta - | "series" -> of_str_list meta series v - | "uuid" -> - (match Id.of_string v with Some id -> (uuid ^= id) meta | None -> meta) - | _ -> meta - - let to_string (meta as m) = - let has_len v = String.length v > 0 in - let s field value = if has_len value then field ^ ": " ^ value ^ "\n" else "" in - let a value = - Author.(if has_len value.name || has_len value.email - then "authors: " ^ value.name ^ " <" ^ value.email ^ ">\n" else "") - in - let d field value = match value with - | Some d -> field ^ ": " ^ Date.rfc_string value ^ "\n" | None -> "" - in - let ss field values = - if List.length values > 0 - then field ^ ": " ^ String.concat ", " values ^ "\n" - else "" - in - let rows = - [ s "title" m.title; - a m.author; - d "date" m.date.Date.created; - d "edited" m.date.Date.edited; - d "published" m.date.Date.published; - ss "topics" m.topics; - s "categories" (CategorySet.to_csv m.categories); - ss "keywords" m.keywords; - ss "series" m.series; - s "abstract" m.abstract; - s "uuid" (Uuidm.to_string m.uuid); - ] - in - String.concat "" rows - -end type t = { meta: Meta.t; body: string; } [@@deriving lens { submodule = true }] -let blank ?(uuid=(Id.generate ())) () = { meta = Meta.blank ~uuid (); body = "" } +let blank ?(uuid=(Meta.Id.generate ())) () = { meta = Meta.blank ~uuid (); body = "" } let filename_of_title t = let is_reserved = function @@ -209,7 +31,7 @@ let title ymd = with Not_found -> "" let filename ymd = filename_of_title ymd.meta.Meta.title -let categorised categs ymd = CategorySet.categorised categs ymd.meta.Meta.categories +let categorised categs ymd = Meta.CategorySet.categorised categs ymd.meta.Meta.categories let with_kv ymd (k,v) = match k with @@ -238,30 +60,4 @@ let of_string s = try { meta = meta_of_string front_matter; body } with _ -> prerr_endline ("Failed paring" ^ s); blank () -let make ?(author_name="") ?(author_email="") ?(date_created=None) ?(date_published=None) ?(date_edited=None) - ?(abstract="") ?(topics=[]) ?(keywords=[]) ?(categories=CategorySet.empty) ?(series=[]) - title body = - let open Meta in - { - meta = { - title; - topics; - keywords; - categories; - series; - abstract; - uuid = Uuidm.v4_gen (Random.get_state ()) (); - author = { - Author.name = author_name; - Author.email = author_email; - }; - date = { - Date.created= date_created; - Date.edited = date_edited; - Date.published = date_published; - } - }; - body - } - let to_string ymd = Meta.to_string ymd.meta ^ "\n" ^ ymd.body