diff --git a/src/html.ml b/src/html.ml index e7992ea..c7a35e5 100644 --- a/src/html.ml +++ b/src/html.ml @@ -1,5 +1,7 @@ open Tyxml.Html +let to_string tyxml = Format.asprintf "%a" (Tyxml.Html.pp ()) tyxml + let logarion_head ?(style="/style.css") t = head (title (pcdata t)) [ link ~rel:[`Stylesheet] ~href:"/style.css" (); @@ -20,20 +22,25 @@ let of_ymd ymd = Unsafe.data ymd_body; footer [p []]; ]) - |> Format.asprintf "%a" (Tyxml.Html.pp ()) + |> to_string -let of_file_meta_pairs file_metas = - let link_item (y,m) = li [a ~a:[a_href (uri_of_string ("/text/" ^ Filename.chop_extension y))] [Unsafe.data Ymd.(m.title)]] in +let article_link (file, meta) = + li [a ~a:[a_href (uri_of_string ("/text/" ^ Filename.chop_extension file))] + [Unsafe.data Ymd.(meta.title)] + ] + +let of_file_meta_pairs ?listing_tpl:(tpl=None) file_meta_pairs = html (logarion_head "Homepage") (body [ header [ h1 [pcdata "Homepage"] ]; div [ h2 [pcdata "Articles"]; - ul (List.map link_item file_metas); - pcdata Template.(of_string "test {{test}}" |> fold); + match tpl with + | Some s -> Unsafe.data Template.(of_string s |> fold_index file_meta_pairs) + | None -> ul (List.map article_link file_meta_pairs); ]; ]) - |> Format.asprintf "%a" (Tyxml.Html.pp ()) + |> to_string let form ymd = let input_set title name value = @@ -42,8 +49,7 @@ let form ymd = input ~a:[a_name name; a_value value] () ]] in - let open Ymd in - html (logarion_head "Compose") + Ymd.(html (logarion_head "Compose") (body [ header [ h1 [pcdata "Article composition"] ]; div [ @@ -71,5 +77,5 @@ let form ymd = ] ] ]; - ]) - |> Format.asprintf "%a" (Tyxml.Html.pp ()) + ])) + |> to_string diff --git a/src/template.ml b/src/template.ml index c0698c0..8879f95 100644 --- a/src/template.ml +++ b/src/template.ml @@ -1,11 +1,4 @@ - -let string s = prerr_endline ("string:"^s); s -let section ~inverted name contents = "section" -let escaped e = prerr_endline ("escaped:"^e); e -let unescaped u = u -let partial p = p -let comment c = c -let concat l = String.concat "," l +open Ymd let of_string = Mustache.of_string @@ -14,4 +7,43 @@ let of_file f = Lwt_io.(open_file ~mode:(Input) f >|= read_lines) >|= (fun stream -> Lwt_stream.fold (^) stream "") -let fold = Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat +let string s = s +let section ~inverted name contents = "section" +let unescaped u = u +let partial p = p +let comment c = c +let concat l = String.concat "" l + +let fold_text ymd = + let escaped e = match e with + | "title" -> meta.title + | "abstract" -> meta.abstract + | "authors" -> meta.authors + | "text" -> + | _ -> prerr_endline ("unknown tag: " ^ e); "" in + Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat + +let fold_entry (file, meta) = + let escaped e = match e with + | "title" -> meta.title + | "abstract" -> meta.abstract + | "authors" -> meta.authors + | _ -> prerr_endline ("unknown tag: " ^ e); "" in + Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat + +let fold_index ymd_meta_pairs = + let string s = s in + let section ~inverted name contents = "section" in + let escaped e = match e with + | "recent_texts_listing" -> + (ListLabels.fold_left + ~init:("" + | _ -> prerr_endline ("unknown tag: " ^ e); "" in + let unescaped u = u in + let partial p = p in + let comment c = c in + let concat l = String.concat "" l in + Mustache.fold ~string ~section ~escaped ~unescaped ~partial ~comment ~concat diff --git a/src/web.ml b/src/web.ml index 5186c5c..835e06b 100644 --- a/src/web.ml +++ b/src/web.ml @@ -22,6 +22,7 @@ let () = let module L = Logarion in let ymd f = L.of_file f in let ret_param name req = return (param req name) in + let listing_tpl = Some (Logarion.load_file "index.mustache") in App.empty |> 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) @@ -29,5 +30,5 @@ let () = |> 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) - |> get "/" (fun _ -> return (L.file_meta_pairs ()) >|= Html.of_file_meta_pairs >>= html_response) + |> get "/" (fun _ -> return (L.file_meta_pairs ()) >|= Html.of_file_meta_pairs ~listing_tpl >>= html_response) |> App.run_command