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

Refactores Meta submodule into a standalone module

Browse Source
This commit is contained in:
Stavros Polymenis 2017-04-16 00:07:33 +01:00
parent 25ddb8b680
commit e138b192bc
6 changed files with 25 additions and 232 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
src/atom.ml
View File

@ -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
("<entry>"
^ "<title>" ^ meta.title ^ "</title>"
^ "<id>urn:uuid:" ^ Ymd.Id.to_string meta.uuid ^ "</id>"
^ "<id>urn:uuid:" ^ Meta.Id.to_string meta.uuid ^ "</id>"
^ "<link rel=\"alternate\" href=\"" ^ url ^ "/" ^ u ^ "\" />"
^ "<updated>" ^ Ymd.Date.(meta.date |> last |> rfc_string) ^ "</updated>"
^ "<updated>" ^ Date.(meta.date |> last |> rfc_string) ^ "</updated>"
^ "<author>"
|> opt_element "name" @@ esc meta.author.name
|> opt_element "email" @@ esc meta.author.email

6
src/html.ml
View File

@ -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 =

26
src/logarion.ml
View File

@ -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

7
src/template.ml
View File

@ -38,8 +38,8 @@ let fold_entry (entry : Logarion.Entry.t) =
| "date_created"
| "date_edited"
| "date_published"
| "date_human" -> "<time>" ^ Ymd.Meta.value_with_name entry.attributes e ^ "</time>"
| tag -> Ymd.Meta.value_with_name entry.attributes tag in
| "date_human" -> "<time>" ^ Meta.value_with_name entry.attributes e ^ "</time>"
| 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 =
"<li><a href=\"/note/" ^ slug entry ^ "\">"
^ entry.attributes.Meta.title ^ " ~ " ^ Date.(pretty_date (entry |> date |> last)) ^ "</a></li>" in
^ entry.attributes.Meta.title ^ " ~ " ^ Meta.Date.(pretty_date (entry |> date |> last)) ^ "</a></li>" 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

5
src/web.ml
View File

@ -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)

208
src/ymd.ml
View File

@ -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