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

split of ymd functions in dedicated module

Browse Source
This commit is contained in:
Stavros Polymenis 2016-09-21 21:43:41 +01:00
parent 1078a2dd2f
commit 660c8637ad
4 changed files with 18 additions and 108 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
Makefile
View File

@ -1,20 +1,25 @@
all: web
web: logarion.cmx html.cmx src/web.ml
web: logarion.cmx html.cmx ymd.cmx src/web.ml
ocamlfind ocamlopt -o logarion-web -linkpkg \
-package opium.unix,omd,str,batteries,tyxml,lens,ptime,ptime.clock.os,re.str \
logarion.cmx html.cmx src/web.ml
ymd.cmx logarion.cmx html.cmx src/web.ml
html.cmx: src/html.ml logarion.cmx
ocamlfind ocamlopt -c -o html.cmx -linkpkg \
-package omd,tyxml \
logarion.cmx src/html.ml
logarion.cmx: src/logarion.ml
logarion.cmx: src/logarion.ml ymd.cmx
ocamlfind ocamlopt -c -o logarion.cmx -linkpkg \
-package batteries,re \
ymd.cmx src/logarion.ml
ymd.cmx: src/ymd.ml
ocamlfind ocamlopt -c -o ymd.cmx -linkpkg \
-package batteries,omd,lens,lens.ppx_deriving,ptime,re \
src/logarion.ml
src/ymd.ml
clean:
rm -f src/*.{cmx,cmi,o} *.{cmx,cmi,o}

12
src/html.ml
View File

@ -4,18 +4,18 @@ let logarion_head ?(style="/style.css") t =
head (title (pcdata t)) [link ~rel:[`Stylesheet] ~href:"/style.css" ()]
let of_ymd ymd =
let ymd_title = Logarion.(ymd.meta.title) in
let ymd_date = match Logarion.(ymd.meta.date.published) with
let ymd_title = Ymd.(ymd.meta.title) in
let ymd_date = match Ymd.(ymd.meta.date.published) with
| Some t -> Some t
| None -> Logarion.(ymd.meta.date.edited) in
let ymd_body = Omd.to_html (Omd.of_string Logarion.(ymd.body)) in
| None -> Ymd.(ymd.meta.date.edited) in
let ymd_body = Omd.to_html (Omd.of_string Ymd.(ymd.body)) in
html (logarion_head ymd_title)
(body [
header [
h1 [Unsafe.data ymd_title];
details
(summary [Unsafe.data Logarion.(ymd.meta.abstract)])
[time ~a:[a_datetime (Logarion.(to_rfc ymd_date))] []];
(summary [Unsafe.data Ymd.(ymd.meta.abstract)])
[time ~a:[a_datetime (Ymd.(to_rfc ymd_date))] []];
];
Unsafe.data ymd_body;
footer [p []];

97
src/logarion.ml
View File

@ -1,40 +1,4 @@
open Lens
type author = {
name: string;
email: string;
} [@@deriving lens]
type date = {
edited: Ptime.t option;
published: Ptime.t option;
} [@@deriving lens]
type meta = {
title: string;
author: author;
date: date;
categories: string list;
topics: string list;
keywords: string list;
series: string list;
abstract: string;
} [@@deriving lens]
type ymd = {
meta: meta;
body: string;
} [@@deriving lens]
let blank_meta = {
title = ""; author = { name = ""; email = "" };
date = { edited = None; published = None };
categories = []; topics = []; keywords = []; series = [];
abstract = ""
}
let blank_ymd =
{ meta = blank_meta; body = "" }
open Ymd
let load_file f =
let ic = open_in f in
@ -44,65 +8,6 @@ let load_file f =
close_in ic;
(s)
let to_rfc v = match v with Some t -> Ptime.to_rfc3339 t | None -> "";;
let of_rfc v = match Ptime.of_rfc3339 v with Ok (t,_,_) -> Some t | Error _ -> None;;
let trim_str v = v |> String.trim
let list_of_csv = Re_str.(split (regexp " *, *"))
let of_str y k v = Lens.Infix.(k ^= trim_str v) y
let of_str_list y k v = Lens.Infix.(k ^= list_of_csv (trim_str v)) y
let filename_of_title t =
let sub c = match c with ' ' -> '_' | '/' -> '-' | c -> c in
String.map sub t ^ ".ymd"
let filename ymd = filename_of_title ymd.meta.title
let meta_field line =
let e = Re_str.(bounded_split (regexp ": *")) line 2 in
if List.length e = 2
then (Re_str.(replace_first (regexp "^[ -] ") "" (List.nth e 0)), List.nth e 1)
else (Re_str.(replace_first (regexp "^[ -] ") "" line), "")
let meta_of_yaml yaml =
let fields = List.map meta_field (BatString.nsplit yaml "\n") in
let open Lens.Infix in
let field_map meta (k,v) = 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
| "abstract" -> of_str meta meta_abstract v
| "published" -> ((meta_date |-- date_published) ^= of_rfc v) meta
| "edited" -> ((meta_date |-- date_edited ) ^= of_rfc v) meta
| "topics" -> of_str_list meta meta_topics v
| "keywords" -> of_str_list meta meta_keywords v
| "categories"-> of_str_list meta meta_categories v
| "series" -> of_str_list meta meta_series v
| _ -> meta
in
List.fold_left field_map blank_meta fields
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.iter 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;
"\ntopics: "; String.concat ", " ymd.meta.topics;
"\ncategories: "; String.concat ", " ymd.meta.categories;
"\nkeywords: "; String.concat ", " ymd.meta.keywords;
"\nabstract: "; ymd.meta.abstract;
"\n---\n"; ymd.body;
];
Buffer.contents buf
let of_file s =
let segments = Re_str.(split (regexp "^---$")) (load_file s) in
if List.length segments = 2 then

4
src/web.ml
View File

@ -21,11 +21,11 @@ let print_ymd =
let print_form =
get "/()/new"
begin fun req ->
`Html (Html.form (Logarion.blank_ymd)) |> respond'
`Html (Html.form (Ymd.blank_ymd)) |> respond'
end
let ymd_of_body_pairs pairs =
let open Logarion in
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