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

fix for Sys_error exception and refactoring

Browse Source
This commit is contained in:
Stavros Polymenis 2017-01-12 23:19:09 +00:00
parent 54a63ea296
commit 2e0e9d1047
4 changed files with 10 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/html.ml
View File

@ -54,7 +54,7 @@ let of_entries ?(header_tpl=None) ?(listing_tpl=None) ?(entry_tpl=None) blog_url
(match listing_tpl with
| Some (Template.Listing s) -> Unsafe.data Template.(fold_index ~entry_tpl lgrn s)
| None ->
let entries = Logarion.(Archive.of_repo lgrn.Configuration.repository |> latest_listed_entries) in
let entries = Logarion.Archive.(of_repo lgrn.Logarion.Configuration.repository |> latest_listed) in
(div [ h2 [pcdata "Articles"]; ul (List.map article_link entries); ]))
|> to_string

4
src/logarion.ml
View File

@ -127,9 +127,9 @@ module Archive = struct
in
let unique_topics ts x = unique_entry ts Entry.(x.meta.topics) in
List.fold_left unique_topics [] archive
end
let latest_listed_entries es = es |> Archive.listed |> Archive.latest
let latest_listed entries = entries |> listed |> latest
end
let latest_entry config fragment =
let repo = Configuration.(config.repository) in

2
src/template.ml
View File

@ -80,7 +80,7 @@ let fold_index ?(entry_tpl=None) lgrn =
let entry = match entry_tpl with Some (Listing_entry e) -> fold_entry e | None -> simple in
let escaped e = match e with
| "recent_texts_listing" ->
let entries = Logarion.(Archive.of_repo lgrn.Configuration.repository |> latest_listed_entries) in
let entries = Logarion.Archive.(of_repo lgrn.Logarion.Configuration.repository |> latest_listed) in
(ListLabels.fold_left ~init:("<ul>") ~f:(fun a e -> a ^ (entry e)) entries)
^ "</ul>"
| "topics" ->

4
src/web.ml
View File

@ -76,9 +76,11 @@ let () =
and (>|=) = Lwt.(>|=) in
let module L = Logarion in
let ymd f =
try
L.Entry.of_file f
|> (fun entry -> if Ymd.(CategorySet.categorised [Category.Published]) entry.L.Entry.meta.Ymd.categories
then entry else unpublished_entry)
with Sys_error _ -> unpublished_entry
in
let ymdpath title = Lwt.return @@ Logarion.title_path lgrn.L.Configuration.repository title in
let ret_param name req = Lwt.return (param req name) in
@ -100,6 +102,6 @@ let () =
|> get "/new" (fun _ -> Lwt.return (Ymd.blank_ymd ()) >|= form_of_ymd >>= html_response)
|> get "/text/:ttl" (fun req -> ret_param "ttl" req >>= ymdpath >|= ymd >|= L.Entry.to_ymd >|= page_of_ymd >>= html_response)
|> get "/!/:ttl" (fun req -> ret_param "ttl" req >|= L.latest_entry lgrn >|= entry_option >|= L.Entry.to_ymd >|= page_of_ymd >>= html_response)
|> get "/feed.atom" (fun _ -> Lwt.return L.Archive.(of_repo ~bodies:true repo) >|= L.latest_listed_entries >|= List.map L.Entry.to_ymd >|= Atom.feed webcfg.Configuration.url lgrn >>= html_response)
|> get "/feed.atom" (fun _ -> Lwt.return L.Archive.(of_repo ~bodies:true repo) >|= L.Archive.latest_listed >|= List.map L.Entry.to_ymd >|= Atom.feed webcfg.Configuration.url lgrn >>= html_response)
|> get "/" (fun _ -> Lwt.return list_of_ymds >>= html_response)
|> App.run_command