Merge branch 'article-tags' into 'master'

Links for article tags

See merge request OCamlPro/www!79

src/blog.ml

@@ -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 =

src/server.ml

@@ -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