module String_map = Map.Make (String) type t = { id: Id.t; title: string; authors: Person.Set.t; date: Date.t; string_map: string String_map.t; stringset_map: String_set.t String_map.t; body: string; } let blank ?(id=(Id.generate ())) () = { id; title = ""; authors = Person.Set.empty; date = Date.({ created = now (); edited = ""}); string_map = String_map.empty; stringset_map = String_map.empty; body = ""; } let compare = Stdlib.compare let newest a b = Date.(compare a.date b.date) let oldest a b = Date.(compare b.date a.date) let str key m = try String_map.find (String.lowercase_ascii key) m.string_map with Not_found -> "" let set key m = try String_map.find (String.lowercase_ascii key) m.stringset_map with Not_found -> String_set.empty let str_set key m = String_set.to_string @@ set key m let with_str_set m key str = { m with stringset_map = String_map.add (String.lowercase_ascii key) (String_set.of_string str) m.stringset_map } let with_kv x (k,v) = let trim = String.trim in match String.lowercase_ascii k with | "body" -> { x with body = String.trim v } | "title"-> { x with title = trim v } | "id" -> (match v with "" -> x | s -> { x with id = s }) | "author" | "authors" -> { x with authors = Person.Set.of_string (trim v)} | "date" -> { x with date = Date.{ x.date with created = Date.of_string v }} | "date-edited"-> { x with date = Date.{ x.date with edited = Date.of_string v }} | "licences" | "topics" | "keywords" | "series" as k -> with_str_set x k v | k -> { x with string_map = String_map.add k (trim v) x.string_map } let kv_of_string line = match Str.(bounded_split (regexp ": *")) line 2 with | [ key; value ] -> Str.(replace_first (regexp "^#\\+") "" key), value | [ key ] -> Str.(replace_first (regexp "^#\\+") "" key), "" | _ -> "","" let of_header front_matter = let fields = List.map kv_of_string (Str.(split (regexp "\n")) front_matter) in List.fold_left with_kv (blank ~id:Id.nil ()) fields let front_matter_body_split s = if Str.(string_match (regexp ".*:.*")) s 0 then match Str.(bounded_split (regexp "^$")) s 2 with | front::body::[] -> (front, body) | _ -> ("", s) else ("", s) let of_string s = let front_matter, body = front_matter_body_split s in try let note = { (of_header front_matter) with body } in if note.id <> Id.nil then Ok note else Error "Missing ID header" with _ -> Error ("Failed parsing" ^ s) let to_string x = 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 = if Person.Set.is_empty value then "" else "Authors: " ^ Person.Set.to_string value ^ "\n" in let d field value = match value with "" -> "" | s -> field ^ ": " ^ Date.rfc_string s ^ "\n" in let rows = [ s "ID" x.id; d "Date" x.date.Date.created; d "Edited" x.date.Date.edited; s "Title" x.title; a x.authors; s "Licences" (str_set "licences" x); s "Topics" (str_set "topics" x); s "Keywords" (str_set "keywords" x); s "Series" (str_set "series" x); s "Abstract" (str "abstract" x); s "Alias" (str "Alias" x) ] in String.concat "" rows ^ "\n" ^ x.body let string_alias t = let is_reserved = function | '!' | '*' | '\'' | '(' | ')' | ';' | ':' | '@' | '&' | '=' | '+' | '$' | ',' | '/' | '?' | '#' | '[' | ']' | ' ' | '\t' | '\x00' -> true | _ -> false in let b = Buffer.create (String.length t) in let filter char = let open Buffer in if is_reserved char then (try (if nth b (pred (length b)) <> '-' then add_char b '-') with Invalid_argument _ -> prerr_endline "reserved") else add_char b char in String.(iter filter (lowercase_ascii t)); Buffer.contents b let alias t = match str "alias" t with "" -> string_alias t.title | x -> x let short_id t = Id.short t.id