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

Renames Ymd to Note

Browse Source
This commit is contained in:
Stavros Polymenis 2017-04-16 00:28:48 +01:00
parent e138b192bc
commit 9318073f63
6 changed files with 54 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/command.ml
View File

@ -32,7 +32,7 @@ let create =
let f title =
let repo = C.((of_filename "logarion.toml").repository) in
let t = match title with "" -> "Draft" | _ -> title in
Logarion.Archive.add repo Ymd.({ (blank ()) with meta = { (Meta.blank ()) with Meta.title = t }})
Logarion.Archive.add repo Note.({ (blank ()) with meta = { (Meta.blank ()) with Meta.title = t }})
|> Lwt_main.run;
()
in

8
src/html.ml
View File

@ -20,10 +20,10 @@ let logarion_text ?(text_tpl=None) ymd =
match text_tpl with
| Some (Template.Text s) -> Unsafe.data Template.(fold_text ymd s)
| None ->
let ymd_body = Omd.to_html (Omd.of_string Ymd.(ymd.body)) in
let ymd_body = Omd.to_html (Omd.of_string ymd.Note.body) in
article [
details
(summary [Unsafe.data Ymd.(ymd.meta.Meta.abstract)])
(summary [Unsafe.data ymd.Note.meta.Meta.abstract])
[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.Meta.Author.name)
(Note.title ymd ^ " by " ^ ymd.Note.meta.Meta.author.Meta.Author.name)
Logarion.Configuration.(lgrn.title)
(logarion_text ~text_tpl ymd)
|> to_string
@ -61,7 +61,7 @@ let form ?(header_tpl=None) blog_url lgrn ymd =
let article_form =
let input_set title input = p [ label [ pcdata title; input ] ] in
let either a b = if a <> "" then a else b in
let open Ymd in
let open Note in
let open Meta in
let open Author in
let auth = ymd.meta.author in

69
src/logarion.ml
View File

@ -53,7 +53,24 @@ module File = struct
close_in ic;
(s)
let ymd f = Ymd.of_string (load f)
let note f = Note.of_string (load f)
let name_of_title t =
let is_reserved = function
| '!' | '*' | '\'' | '(' | ')' | ';' | ':' | '@' | '&' | '=' | '+' | '$'
| ',' | '/' | '?' | '#' | '[' | ']' | ' ' | '\t' | '\x00' -> true
| _ -> false in
let drop h t = t in
let dash h t = '-' :: t in
let rec filter fn = function
| [] -> []
| head :: tail ->
if is_reserved head
then fn head (filter drop tail)
else Char.lowercase_ascii head :: (filter dash tail) in
Batteries.String.of_list @@ filter drop (Batteries.String.to_list t)
let name note = name_of_title note.Note.meta.Meta.title
end
let titledir (dir : repo_t) = Titles Fpath.(repo_path dir / "title")
@ -64,9 +81,9 @@ let extension = ".ymd"
let article_path (repo : repo_t) articlepath =
Article Fpath.(repo_path repo / "title" // articlefilename_path articlepath)
let title_path (repo : repo_t) title =
Article Fpath.(repo_path repo / "title" / (Ymd.filename_of_title title ^ extension))
let uuid_path (repo : repo_t) ymd =
Article Fpath.(repo_path repo / "uuid" / Ymd.(Id.to_string ymd.meta.Meta.uuid ^ extension))
Article Fpath.(repo_path repo / "title" / (File.name_of_title title ^ extension))
let uuid_path (repo : repo_t) note =
Article Fpath.(repo_path repo / "uuid" / (Meta.Id.to_string note.Note.meta.Meta.uuid ^ extension))
let slug string = Filename.(string |> basename |> chop_extension)
@ -84,16 +101,16 @@ module Entry = struct
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.Ymd.meta with title = Ymd.title ymd } in
let note = File.note (articlefilename_path (article_path repo filename)) in
let attributes = { note.Note.meta with title = Note.title note } in
{ filename; attributes }
let to_filename repo ymd =
let uuid_path = Fpath.to_string @@ articlefilename_path @@ uuid_path repo ymd in
let write_ymd out = Lwt_io.write out (Ymd.to_string ymd) in
Lwt_io.with_file ~mode:Lwt_io.output uuid_path write_ymd
let to_filename repo note =
let uuid_path = Fpath.to_string @@ articlefilename_path @@ uuid_path repo note in
let write_note out = Lwt_io.write out (Note.to_string note) in
Lwt_io.with_file ~mode:Lwt_io.output uuid_path write_note
let to_ymd repo entry = File.ymd (articlefilename_path (article_path repo entry.filename))
let to_ymd repo entry = File.note (articlefilename_path (article_path repo entry.filename))
let slug entry =
Fpath.(entry.filename |> articlefilename_path |> base |> rem_ext |> to_string)
@ -101,11 +118,13 @@ module Entry = struct
let compare_recency a b = Date.compare (date b) (date a)
end
let rec next_semantic_filepath ?(version=0) titles ymd =
let rec next_semantic_filepath ?(version=0) titles note =
let candidate =
let open Fpath in
titledir_path titles / (Ymd.filename ymd) |> add_ext (string_of_int version) |> add_ext extension in
if Sys.file_exists Fpath.(to_string candidate) then next_semantic_filepath ~version:(version+1) titles ymd
titledir_path titles / (File.name note)
|> add_ext (string_of_int version)
|> add_ext extension in
if Sys.file_exists Fpath.(to_string candidate) then next_semantic_filepath ~version:(version+1) titles note
else candidate
module Archive = struct
@ -120,33 +139,33 @@ module Archive = struct
let to_entry y = Entry.of_filename repo (Article (Fpath.v y)) in
let fold_file a file =
if BatString.ends_with file extension
then try List.cons (to_entry file) a with Ymd.Syntax_error str -> prerr_endline str; a
then try List.cons (to_entry file) a with Note.Syntax_error str -> prerr_endline str; a
else a
in
List.fold_left fold_file [] files
let add repo ymd =
let add repo note =
let open Entry in
let open Lwt.Infix in
to_filename repo ymd >>= fun () ->
let open Ymd in
(if not (categorised [Meta.Category.Draft] ymd) && ymd.Ymd.meta.Meta.title <> "" then
to_filename repo note >>= fun () ->
let open Note in
(if not (categorised [Meta.Category.Draft] note) && note.Note.meta.Meta.title <> "" then
let entries = of_repo repo in
let titledir = titledir repo in
begin try
let uuid x = x.Meta.uuid in
let entry = List.find (fun entry -> uuid entry.attributes = uuid ymd.meta) entries in
if slug entry <> filename ymd then
let entry = List.find (fun entry -> uuid entry.attributes = uuid note.meta) entries in
if slug entry <> File.name note then
let found_filepath = Fpath.to_string @@ articlefilename_path (article_path repo entry.filename) in
Lwt_unix.rename found_filepath (Fpath.to_string @@ next_semantic_filepath titledir ymd)
Lwt_unix.rename found_filepath (Fpath.to_string @@ next_semantic_filepath titledir note)
else
Lwt.return_unit
with Not_found ->
Lwt_unix.link (Fpath.to_string @@ articlefilename_path (uuid_path repo ymd)) (Fpath.to_string @@ next_semantic_filepath titledir ymd);
Lwt_unix.link (Fpath.to_string @@ articlefilename_path (uuid_path repo note)) (Fpath.to_string @@ next_semantic_filepath titledir note);
end
else
Lwt.return_unit)
>>= fun () -> Lwt.return ymd
>>= fun () -> Lwt.return note
let topics archive =
let open List in
@ -176,7 +195,7 @@ let entry_with_slug repo (slug as s) =
try Some (of_filename repo (Article (Fpath.v @@ s ^ extension)))
with _ ->
let slugged last_match entry =
if s <> Ymd.filename_of_title (title entry) then last_match
if s <> File.name_of_title (title entry) then last_match
else
match last_match with
| Some last_entry ->

16
src/ymd.ml → src/note.ml
View File

@ -7,21 +7,6 @@ type t = {
let blank ?(uuid=(Meta.Id.generate ())) () = { meta = Meta.blank ~uuid (); body = "" }
let filename_of_title t =
let is_reserved = function
| '!' | '*' | '\'' | '(' | ')' | ';' | ':' | '@' | '&' | '=' | '+' | '$'
| ',' | '/' | '?' | '#' | '[' | ']' | ' ' | '\t' | '\x00' -> true
| _ -> false in
let drop h t = t in
let dash h t = '-' :: t in
let rec filter fn = function
| [] -> []
| head :: tail ->
if is_reserved head
then fn head (filter drop tail)
else Char.lowercase_ascii head :: (filter dash tail) in
Batteries.String.of_list @@ filter drop (Batteries.String.to_list t)
let title ymd =
let mtitle = ymd.meta.Meta.title in
if String.length mtitle > 0 then mtitle else
@ -30,7 +15,6 @@ let title ymd =
|> function H1 h -> to_text h | _ -> ""
with Not_found -> ""
let filename ymd = filename_of_title ymd.meta.Meta.title
let categorised categs ymd = Meta.CategorySet.categorised categs ymd.meta.Meta.categories
let with_kv ymd (k,v) =

5
src/template.ml
View File

@ -24,10 +24,9 @@ let comment c = c
let concat l = String.concat "" l
let fold_text ymd =
let open Ymd in
let escaped e = match e with
| "body" -> Omd.to_html @@ Omd.of_string ymd.body
| tag -> Meta.value_with_name ymd.meta tag in
| "body" -> Omd.to_html @@ Omd.of_string ymd.Note.body
| tag -> Meta.value_with_name ymd.Note.meta tag in
Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat
let fold_entry (entry : Logarion.Entry.t) =

6
src/web.ml
View File

@ -57,8 +57,8 @@ end
let ymd_of_body_pairs pairs =
let open Lens.Infix in
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 ()))
ListLabels.fold_left ~f:(fun a (k,vl) -> Note.with_kv a (k, List.hd vl) ) ~init:(Note.blank ()) pairs
|> ((Note.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)
@ -87,7 +87,7 @@ let () =
let module L = Logarion in
let lwt_archive repo = Lwt.return L.Archive.(of_repo repo) in
let lwt_blankymd () = Lwt.return (Ymd.blank ()) in
let lwt_blankymd () = Lwt.return (Note.blank ()) in
let (>>=) = Lwt.(>>=) and (>|=) = Lwt.(>|=) in
let atom_response repo req =