Commit 5505b094 authored by Dario Pinto's avatar Dario Pinto
Browse files

Merge branch 'article-tags' into 'master'

Links for article tags

See merge request OCamlPro/www!79
parents 674aeb6e bfb64003
......@@ -112,6 +112,28 @@ let normalize_url target =
| c -> c |> Char.lowercase_ascii )
(Ubase.from_utf8 target)
(** [normalize_tag tag] takes a tag and rids it of unwanted characters, such as
utf8, speces, dashes and underscores *)
let normalize_tag tag =
let string_map_partial f s =
let b = Buffer.create (String.length s) in
let maybeadd c =
match f c with
| None -> ()
| Some c' -> Buffer.add_char b c'
in
String.iter maybeadd s;
Buffer.contents b
in
string_map_partial
(function
| '-'
| ' '
| '_' ->
None
| c -> Some (Char.lowercase_ascii c) )
(Ubase.from_utf8 tag)
(** [allowed_categories] is a list of allowed categories for any article posted
on the blog *)
let allowed_categories =
......@@ -249,6 +271,12 @@ let categories_count =
let l = Hashtbl.fold (fun k v acc -> (k, v) :: acc) tbl [] in
List.sort (fun (k1, v1) (k2, v2) -> compare (v2, k2) (v1, k1)) l
let pp_list_to_blog_links t normalize =
Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
(fun fmt e ->
Format.fprintf fmt {|<a href="/blog/%s/%s">%s</a>|} t (normalize e) e )
let links_to_home_pages =
Format.sprintf
{|
......@@ -303,17 +331,11 @@ let pp_article_excerpt fmt article =
<br />
%s <a href="/blog/%s">(Read more)</a>|}
article.url article.title
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
(fun fmt author ->
Format.fprintf fmt {|<a href="/blog/authors/%s">%s</a>|}
(normalize_url author) author ) )
(pp_list_to_blog_links "authors" normalize_url)
article.authors year month day
(normalize_url article.category)
article.category
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
Format.pp_print_string )
(pp_list_to_blog_links "tag" normalize_tag)
article.tags (preview article.content) article.url
let pp_blog_posts fmt articles_data_list =
......@@ -332,7 +354,7 @@ let specific_article_header title authors (year, month, day) category tags =
<div class="row">
<div class="col-lg-3">
<img class="icon" src="/blog/assets/img/icon_person.svg"/>
Author: %a
Authors: %a
</div>
<div class="col-lg-2">
<img class="icon" src="/blog/assets/img/icon_calendar.svg"/>
......@@ -354,15 +376,9 @@ let specific_article_header title authors (year, month, day) category tags =
<hr class="featurette-divider"/>
<br />|}
title
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
(fun fmt author ->
Format.fprintf fmt {|<a href="/blog/authors/%s">%s</a>|}
(normalize_url author) author ) )
(pp_list_to_blog_links "authors" normalize_url)
authors year month day (normalize_url category) category
(Format.pp_print_list
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
Format.pp_print_string )
(pp_list_to_blog_links "tag" normalize_tag)
tags
(** [given_category category] Displays the list of articles corresponding to the
......@@ -398,6 +414,25 @@ let given_author ocp_author =
links_to_home_pages pp_blog_posts articles_of_author
, author )
(** [given_tag tag] Displays the list of articles tagged with given [tag] *)
let given_tag tag =
let articles_by_date = List.sort compare_articles articles_data in
let articles_with_tag =
List.filter
(fun article ->
List.exists
(fun tag0 -> String.equal (normalize_tag tag0) tag)
article.tags )
articles_by_date
in
let tag =
List.find
(fun t -> String.equal (normalize_tag t) tag)
(List.hd articles_with_tag).tags
in
Format.asprintf {|<h1 id="page-title">Articles tagged with %s</h1>%s%a@.|} tag
links_to_home_pages pp_blog_posts articles_with_tag
(** [category_home] This is the home page for all available categories on the
Blog, along with number of articles of given category *)
let category_home =
......
......@@ -169,6 +169,12 @@ let () =
Dream.html_escape (String.concat ", " (tags @ Meta.keywords_l))
in
Dream.html (render_unsafe ~title ~content ~authors ~keywords ()) )
; Dream.get "/blog/tag/:tag" (fun request ->
let content=
Blog.given_tag (Dream.param "tag" request)
in
let title = title content in
Dream.html (render_unsafe ~title ~content ()) )
; Dream.get "/blog" (fun _request ->
let content = Blog.home_page in
let title = title content in
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment