Merge pull request 'Implement tags' (#4) from yocaml2-tags into main

Reviewed-on: robur/blog.robur.coop#4

bin/blog.ml

@@ -1,5 +1,7 @@
 open Yocaml
 
+module SM = Map.Make(String)
+
 let is_empty_list = function [] -> true | _ -> false
 
 module Date = struct
@@ -414,6 +416,69 @@ module Articles = struct
     ]
 end
 
+module Tag = struct
+  type t = {
+    name : string;
+    articles : (Path.t * Article.t) list;
+  }
+
+  let make ~name ~articles =
+    { name; articles }
+
+  let normalize_article (ident, article) =
+    let open Data in
+    record (("url", string @@ Path.to_string ident) :: Article.normalize article)
+
+  let normalize { name; articles } =
+    let open Data in
+    [
+      ("name", string name);
+      ("articles", (list_of normalize_article) articles);
+    ]
+end
+
+module Tags = struct
+  class type t = object ('self)
+    inherit Articles.t
+    method tags : Tag.t list
+  end
+
+  class tags ?title ?description articles =
+    object
+      inherit Articles.articles ?title ?description articles as super
+      method tags =
+        let tags =
+          let update article sm tag =
+            SM.update tag
+              (function
+                | None -> Some [article]
+                | Some urls -> Some (article :: urls))
+              sm
+          in
+          List.fold_left
+            (fun sm (url, article) ->
+               List.fold_left (update (url, article)) sm article#tags)
+            SM.empty
+            super#articles
+          |> SM.bindings
+        in
+        List.map (fun (tag, articles) ->
+            Tag.make ~name:tag ~articles)
+          tags
+    end
+
+  let of_articles articles =
+    new tags ?title:articles#title ?description:articles#description articles#articles
+
+  let normalize_tag tag =
+    let open Data in
+    record (Tag.normalize tag)
+
+  let normalize tags =
+    let open Data in
+    ("all_tags", (list_of normalize_tag tags#tags)) :: Articles.normalize tags
+end
+
 module Make_with_target (S : sig
   val source : Path.t
   val target : Path.t
@@ -427,6 +492,7 @@ struct
     let images = Path.(source_root / "images")
     let articles = Path.(source_root / "articles")
     let index = Path.(source_root / "pages" / "index.md")
+    let tags = Path.(source_root / "pages" / "tags.md")
     let templates = Path.(source_root / "templates")
     let template file = Path.(templates / file)
     let binary = Path.rel [ Sys.argv.(0) ]
@@ -507,6 +573,35 @@ struct
         >>> drop_first ()
       end
 
+  let process_tags ~host =
+    let file = Source.tags in
+    let file_target = Target.(as_html pages file) in
+
+    let open Task in
+    let compute_index =
+      Articles.compute_index
+        (module Yocaml_yaml)
+        ~where:(Path.has_extension "md")
+        ~compute_link:(Target.as_html @@ Path.abs [ "articles" ])
+        Source.articles
+    in
+
+    Action.write_static_file file_target
+      begin
+        Pipeline.track_files [ Source.binary; Source.articles ]
+        >>> Yocaml_yaml.Pipeline.read_file_with_metadata (module Page) file
+        >>> Yocaml_cmarkit.content_to_html ()
+        >>> first compute_index
+        >>* (fun (obj, str) -> Eff.return (Tags.of_articles (obj#with_host host), str))
+        >>> Yocaml_jingoo.Pipeline.as_template ~strict:true
+          (module Tags)
+          (Source.template "tags.html")
+        >>> Yocaml_jingoo.Pipeline.as_template ~strict:true
+          (module Tags)
+          (Source.template "layout.html")
+        >>> drop_first ()
+      end
+
   let feed_title = "The Robur's blog"
   let site_url = "https://blog.robur.coop/"
   let feed_description = "The Robur cooperative blog"
@@ -624,6 +719,7 @@ struct
     let open Eff in
     Action.restore_cache ~on:`Source Source.cache
     >>= process_css_files >>= process_js_files >>= process_images_files
+    >>= process_tags ~host
     >>= process_articles ~host >>= process_index ~host >>= rss1 >>= rss2 >>= atom
     >>= Action.store_cache ~on:`Source Source.cache
 end

css/style.css

@@ -197,6 +197,10 @@ article code {
   color: #fff;
 }
 
+.tag-box:target > h3 > span {
+  background-color: #c2410c;
+}
+
 .tag-box > h3 > span::before {
   content: "#";
 }

templates/article.html

@@ -4,7 +4,7 @@
     <h1>{{ title }}</h1>
     <ul class="tags-list">
         {%- for tag in tags -%}
-        <li>{{ tag }}</li>
+	<li><a href="{{ host }}/tags.html#tag-{{ tag }}">{{ tag }}</a></li>
         {%- endfor -%}
     </ul>
     {%- autoescape false -%}

templates/index.html

@@ -26,7 +26,7 @@
             <div class="bottom">
                 <ul class="tags-list">
                     {%- for tag in article.tags -%}
-                    <li>{{ tag }}</li>
+		    <li><a href="{{ host }}/tags.html#tag-{{ tag }}">{{ tag }}</a></li>
                     {%- endfor -%}
                 </ul>
             </div>

templates/tag.html

@@ -1,21 +0,0 @@
-<a href="/index.html">Back to index</a>
-
-<ul class="tags-list aeration">
-    {%- for tag in tags -%}
-    <li><a href="/{{ tag.link  }}">{{ tag.name }} ({{ tag.number }})</a></li>
-    {%- endfor -%}
-</ul>
-
-<div class="tag-box" id="tag-{{ tag  }}">
-    {%- set nb_tags = length (articles) -%}
-    <h3>
-        <span>{{ tag }}</span>
-        {{ nb_tags }}
-        {%- if nb_tags > 1 %} entries{%- else %} entry{%- endif -%}
-    </h3>
-    <ul>
-        {%- for article in articles -%}
-        <li><a href="/{{ article.url }}">{{ article.metadata.title  }}</a></li>
-        {%- endfor -%}
-    </ul>
-</div>

templates/tags.html

@@ -0,0 +1,20 @@
+<a href="/index.html">Back to index</a>
+
+<ul class="tags-list aeration">
+    {%- for tag in all_tags -%}
+    <li><a href="#tag-{{ tag.name }}">{{ tag.name }}</a></li>
+    {%- endfor -%}
+</ul>
+
+{%- for tag in all_tags -%}
+<div class="tag-box" id="tag-{{ tag.name }}">
+    <h3>
+        <span>{{ tag.name }}</span>
+    </h3>
+    <ul>
+        {%- for article in tag.articles -%}
+	<li><a href="{{ host }}{{ article.url }}">{{ article.title  }}</a></li>
+        {%- endfor -%}
+    </ul>
+</div>
+{%- endfor -%}