diff --git a/Makefile b/Makefile index cb33d49..c35ac35 100644 --- a/Makefile +++ b/Makefile @@ -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} diff --git a/src/html.ml b/src/html.ml index 3be6de5..dd6ea87 100644 --- a/src/html.ml +++ b/src/html.ml @@ -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 []]; diff --git a/src/logarion.ml b/src/logarion.ml index fd53ce2..f18d02d 100644 --- a/src/logarion.ml +++ b/src/logarion.ml @@ -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 diff --git a/src/web.ml b/src/web.ml index a7a0c3b..97578c6 100644 --- a/src/web.ml +++ b/src/web.ml @@ -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