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

further fixes to links

Browse Source
This commit is contained in:
Stavros Polymenis 2016-10-03 22:06:30 +01:00
parent f243f48a21
commit e6f9f298ba
2 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/html.ml
View File

@ -20,7 +20,7 @@ let of_ymd ymd =
|> Format.asprintf "%a" (Tyxml.Html.pp ())
let of_file_meta_pairs file_metas =
let link_item (y,m) = li [a ~a:[a_href ("/" ^ Filename.chop_extension y)] [Unsafe.data Ymd.(m.title)]] in
let link_item (y,m) = li [a ~a:[a_href ("/text/" ^ Filename.chop_extension y)] [Unsafe.data Ymd.(m.title)]] in
html (logarion_head "Homepage")
(body [
header [ h1 [pcdata "Homepage"] ];
@ -44,7 +44,7 @@ let form ymd =
header [ h1 [pcdata "Article composition"] ];
div [
form
~a:[a_method `Post; a_action (uri_of_string "/()/new")]
~a:[a_method `Post; a_action (uri_of_string "/post")]
[
fieldset
~legend:(legend [pcdata "Article"])

6
src/web.ml
View File

@ -23,9 +23,9 @@ let () =
let ymd f = L.of_file f in
let ret_param name req = return (param req name) in
App.empty
|> post "/text/post" (fun req -> ymd_of_req req >>= fun ymd -> L.to_file ymd >>= fun () -> html_response (Html.of_ymd ymd))
|> get "/text/:ttl/edit" (fun r -> ret_param "ttl" r >>= ymdpath >|= ymd >|= Html.form >>= html_response)
|> get "/text/new" (fun _ -> return Ymd.blank_ymd >|= Html.form >>= html_response)
|> post "/post" (fun req -> ymd_of_req req >>= fun ymd -> L.to_file ymd >>= fun () -> html_response (Html.of_ymd ymd))
|> get "/edit/:ttl" (fun r -> ret_param "ttl" r >>= ymdpath >|= ymd >|= Html.form >>= html_response)
|> get "/new" (fun _ -> return Ymd.blank_ymd >|= Html.form >>= html_response)
|> get "/text/:ttl" (fun req -> ret_param "ttl" req >>= ymdpath >|= ymd >|= Html.of_ymd >>= html_response)
|> get "/!/:ttl" (fun req -> ret_param "ttl" req >|= L.latest_file_meta_pair >|= ymd_or_error >|= Html.of_ymd >>= html_response)
|> get "/style.css" (fun _ -> return "ymd/style.css" >|= L.load_file >>= string_response)