diff --git a/bin/blog.ml b/bin/blog.ml index 11d0884..5c90e73 100644 --- a/bin/blog.ml +++ b/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 diff --git a/templates/article.html b/templates/article.html index c79a7fe..d29f831 100644 --- a/templates/article.html +++ b/templates/article.html @@ -4,7 +4,7 @@