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

fixed id-less paths

Browse Source
This commit is contained in:
Stavros Polymenis 2017-01-13 00:26:59 +00:00
parent 2e0e9d1047
commit 312f0653f1
2 changed files with 18 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
src/logarion.ml
View File

@ -143,3 +143,20 @@ let latest_entry config fragment =
then last_match else Some entry
| None -> Some entry in
ListLabels.fold_left ~f:latest ~init:(None) (Archive.of_repo repo)
let entry_with_slug config slug =
let repo = Archive.of_repo @@ Configuration.(config.repository) in
let split_slug = BatString.split_on_char '.' slug in
if List.length split_slug > 2 then Some (Entry.of_file slug)
else
let slug = List.hd split_slug in
let slugged last_match entry =
let open Entry in
if slug <> Ymd.filename_of_title entry.meta.title then last_match
else
match last_match with
| Some last_entry ->
if last_entry.meta.date.Date.published >= entry.meta.date.Date.published
then last_match else Some entry
| None -> Some entry in
ListLabels.fold_left ~f:slugged ~init:(None) repo

2
src/web.ml
View File

@ -100,7 +100,7 @@ let () =
|> post "/post" (fun req -> ymd_of_req req >>= fun ymd -> L.Archive.add lgrn ymd >>= fun () -> html_response (page_of_ymd ymd))
|> get "/edit/:ttl" (fun r -> ret_param "ttl" r >>= ymdpath >|= ymd >|= L.Entry.to_ymd >|= form_of_ymd >>= html_response)
|> 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 "/text/:ttl" (fun req -> ret_param "ttl" req >|= L.entry_with_slug lgrn >|= entry_option >|= 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.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)