diff --git a/data/articles/guarded-methods.yml b/data/articles/guarded-methods.yml new file mode 100644 index 0000000..6778f2f --- /dev/null +++ b/data/articles/guarded-methods.yml @@ -0,0 +1,13 @@ +title: Guarded methods using equality witnesses +synopsis: Guarded methods allow constraints to be attached to the receiver + (self) only for certain methods, so that these methods can only + be called if the receiver satisfies these constraints (these guards). + OCaml does not syntactically allow this type of method to be defined + directly. In this note, we'll look at how to encode them using a + type equality witness. +date: 2022-05-29 +authors: [xvw] +link: + url: https://xvw.lol/pages/oop-refl.html + lang: fra +tags: [ocaml, oop, refl, gadt] diff --git a/data/articles/import-modules.yml b/data/articles/import-modules.yml new file mode 100644 index 0000000..5bcbf8b --- /dev/null +++ b/data/articles/import-modules.yml @@ -0,0 +1,10 @@ +title: OCaml, modules and import schemes +synopsis: In this article, we're going to look at how generalised openings + can be used to reproduce a common practice in other languages, + which I call, somewhat pompously, import strategies, +date: 2023-10-31 +authors: [xvw] +link: + url: https://xvw.lol/pages/modules-import.html + lang: fra +tags: [ocaml, module] diff --git a/data/articles/merlin-destruct.yml b/data/articles/merlin-destruct.yml new file mode 100644 index 0000000..ac82899 --- /dev/null +++ b/data/articles/merlin-destruct.yml @@ -0,0 +1,8 @@ +title: Effective ML Through Merlin's Destruct Command +synopsis: This article presents the use of the destruct command in Merlin + and OCaml-lsp to generate missing patterns, or to specify patterns in + pattern matching. +date: 2024-05-29 +authors: [xvw] +link: https://tarides.com/blog/2024-05-29-effective-ml-through-merlin-s-destruct-command/ +tags: [ocaml, lsp, ide, emacs, vscode, vim, merlin] diff --git a/data/blog.md b/data/blog.md new file mode 100644 index 0000000..b095f79 --- /dev/null +++ b/data/blog.md @@ -0,0 +1,9 @@ +--- +page_title: Blog +description: A federated blog of Webring's member +--- + +The **Federated Blog** allows [webring members](/) to showcase federated +articles on this page from _time to time_. The list of articles is not +calculated automatically (via RSS/Atom feeds) but is the result of **a manual +addition**. diff --git a/lib/action/all.ml b/lib/action/all.ml index 0c3ddcd..193cad5 100644 --- a/lib/action/all.ml +++ b/lib/action/all.ml @@ -13,6 +13,7 @@ let run (module R : Sigs.RESOLVER) () = >>= Fonts.run (module R) >>= Css.run (module R) >>= Images.run (module R) + >>= Articles.run (module R) chain >>= Opml.run (module R) chain >>= Chain.run (module R) chain >>= Index.run (module R) chain diff --git a/lib/action/articles.ml b/lib/action/articles.ml new file mode 100644 index 0000000..7b30c6c --- /dev/null +++ b/lib/action/articles.ml @@ -0,0 +1,17 @@ +let run (module R : Sigs.RESOLVER) chain = + Yocaml.Action.write_static_file R.Target.blog + (let open Yocaml.Task in + R.track_common_dependencies + >>> Yocaml.Pipeline.track_file R.Source.articles + >>> Yocaml_yaml.Pipeline.read_file_with_metadata + (module Model.Page) + R.Source.blog + >>> first @@ Model.Articles.index chain R.Source.articles + >>> Yocaml_omd.content_to_html () + >>> Yocaml_jingoo.Pipeline.as_template + (module Model.Articles) + (R.Source.template "blog.html") + >>> Yocaml_jingoo.Pipeline.as_template + (module Model.Articles) + (R.Source.template "layout.html") + >>> drop_first ()) diff --git a/lib/action/articles.mli b/lib/action/articles.mli new file mode 100644 index 0000000..365335a --- /dev/null +++ b/lib/action/articles.mli @@ -0,0 +1,3 @@ +(** An action that builds the webring blog. *) + +val run : (module Sigs.RESOLVER) -> Model.Chain.t -> Yocaml.Action.t diff --git a/lib/model/article.ml b/lib/model/article.ml index 413af8c..e796bda 100644 --- a/lib/model/article.ml +++ b/lib/model/article.ml @@ -1,10 +1,12 @@ +open Model_util + type t = { title : string; synopsis : string option; date : Yocaml.Archetype.Datetime.t; tags : string list; authors : string list; - url : Url.t; + link : Link.t; } let entity_name = "Article" @@ -16,32 +18,37 @@ let validate = let+ title = required fl "title" string and+ synopsis = optional fl "synopsis" string and+ date = required fl "date" Yocaml.Archetype.Datetime.validate - and+ url = required fl "url" Url.validate + and+ link = required fl "link" Link.validate and+ tags = optional_or fl ~default:[] "tags" @@ list_of Yocaml.Slug.validate and+ authors = required fl "authors" @@ ((string $ fun x -> [ x ]) / list_of Yocaml.Slug.validate) in - { title; synopsis; date; tags; authors; url }) + { title; synopsis; date; tags; authors; link }) let authors_in_chain chain { authors; _ } = - chain - |> Chain.to_list - |> List.exists (fun (x, _) -> - List.exists (String.equal @@ Member.id x) authors) + let chain = Chain.to_list chain in + List.for_all + (fun author -> + chain |> List.exists (fun (x, _) -> String.equal author (Member.id x))) + authors -let normalize { title; synopsis; date; tags; authors; url } = +let normalize { title; synopsis; date; tags; authors; link } = let open Yocaml.Data in [ ("title", string title); + ("has_synopsis", has_opt synopsis); ("synopsis", option string synopsis); ("date", Yocaml.Archetype.Datetime.normalize date); ("tags", list_of string tags); + ("has_tags", has_list tags); ("authors", list_of string authors); - ("url", Url.normalize url); + ("link", Link.normalize link); ] let pp ppf article = Format.fprintf ppf "%a" Yocaml.Data.pp (article |> normalize |> Yocaml.Data.record) + +let sort a b = Yocaml.Archetype.Datetime.compare a.date b.date diff --git a/lib/model/article.mli b/lib/model/article.mli index d2749b0..2296bb5 100644 --- a/lib/model/article.mli +++ b/lib/model/article.mli @@ -7,6 +7,7 @@ val authors_in_chain : Chain.t -> t -> bool (** Ensure that authors are present in chain. *) val pp : Format.formatter -> t -> unit +val sort : t -> t -> int (** {1 Dealing as metadata} *) diff --git a/lib/model/articles.ml b/lib/model/articles.ml new file mode 100644 index 0000000..8c25e07 --- /dev/null +++ b/lib/model/articles.ml @@ -0,0 +1,40 @@ +open Model_util + +type t = { page : Page.t; articles : Article.t list } + +let from_page = Yocaml.Task.lift (fun (page, articles) -> { page; articles }) + +let fetch ?limit chain path = + Yocaml.Task.from_effect (fun () -> + let open Yocaml.Eff in + let* files = + read_directory ~on:`Source ~only:`Files + ~where:(Yocaml.Path.has_extension "yml") + path + in + + let+ articles = + List.traverse + (fun file -> + Yocaml_yaml.Eff.read_file_as_metadata + (module Article) + ~on:`Source file) + files + in + limit + |> Option.fold ~none:articles ~some:(fun limit -> + articles |> Stdlib.List.filteri (fun i _ -> i > limit)) + |> Stdlib.List.sort (fun a b -> Article.sort b a) + |> Stdlib.List.filter (Article.authors_in_chain chain)) + +let index ?limit chain path = + let open Yocaml.Task in + lift (fun x -> (x, ())) >>> second (fetch ?limit chain path) >>> from_page + +let normalize { page; articles } = + let open Yocaml.Data in + Page.normalize page + @ [ + ("articles", list_of (fun x -> record (Article.normalize x)) articles); + ("has_articles", has_list articles); + ] diff --git a/lib/model/articles.mli b/lib/model/articles.mli new file mode 100644 index 0000000..f0e5e7a --- /dev/null +++ b/lib/model/articles.mli @@ -0,0 +1,10 @@ +(** Describes a federation page of external articles published by ring members. *) + +type t +(** The type describing the federation. *) + +val index : ?limit:int -> Chain.t -> Yocaml.Path.t -> (Page.t, t) Yocaml.Task.t + +(** {1 Dealing as metadata} *) + +include Yocaml.Required.DATA_INJECTABLE with type t := t diff --git a/lib/model/link.ml b/lib/model/link.ml index db4ed1a..ce31313 100644 --- a/lib/model/link.ml +++ b/lib/model/link.ml @@ -4,14 +4,15 @@ type t = string * Lang.t * Url.t let validate = let open Yocaml.Data.Validation in - record (fun fields -> - let* url = required fields "url" Url.validate in - let+ lang = optional_or fields "lang" ~default:Lang.Eng Lang.validate - and+ title = - optional_or fields ~default:(Url.url url) "title" - (string & minimal_length 1) - in - (title, lang, url)) + (Url.validate $ fun url -> (Url.url url, Lang.Eng, url)) + / record (fun fields -> + let* url = required fields "url" Url.validate in + let+ lang = optional_or fields "lang" ~default:Lang.Eng Lang.validate + and+ title = + optional_or fields ~default:(Url.url url) "title" + (string & minimal_length 1) + in + (title, lang, url)) let normalize_underlying_link (title, lang, url) = let open Yocaml.Data in diff --git a/lib/resolver.ml b/lib/resolver.ml index ef619c2..b898602 100644 --- a/lib/resolver.ml +++ b/lib/resolver.ml @@ -12,10 +12,12 @@ module Make (R : Sigs.RESOLVABLE) = struct let templates = Path.(static / "templates") let template file = Path.(templates / file) let members = Path.(data / "members") + let articles = Path.(data / "articles") let chain = Path.(data / "chain.yml") let common_deps = [ binary; chain ] let cname = Path.(static / "CNAME") let index = Path.(data / "index.md") + let blog = Path.(data / "blog.md") let static_images = Path.(static / "images") let avatars = Path.(data / "avatars") end @@ -32,6 +34,7 @@ module Make (R : Sigs.RESOLVABLE) = struct let images = Path.(R.target / "images") let avatars = Path.(images / "avatars") let member ~id = Path.(members / id / "index.html") + let blog = Path.(R.target / "blog.html") let member_redirection ~id pred_or_succ = let target = Path.(members / id) in diff --git a/lib/sigs.mli b/lib/sigs.mli index 8440746..3b64142 100644 --- a/lib/sigs.mli +++ b/lib/sigs.mli @@ -41,8 +41,10 @@ module type RESOLVER = sig val fonts : Yocaml.Path.t val templates : Yocaml.Path.t val members : Yocaml.Path.t + val articles : Yocaml.Path.t val chain : Yocaml.Path.t val index : Yocaml.Path.t + val blog : Yocaml.Path.t val avatars : Yocaml.Path.t val template : Yocaml.Path.fragment -> Yocaml.Path.t @@ -74,5 +76,6 @@ module type RESOLVER = sig val member_redirection : id:string -> [ `Pred | `Succ ] -> Yocaml.Path.t val member : id:string -> Yocaml.Path.t val avatars : Yocaml.Path.t + val blog : Yocaml.Path.t end end diff --git a/static/css/style.css b/static/css/style.css index 510634a..0834891 100644 --- a/static/css/style.css +++ b/static/css/style.css @@ -74,6 +74,27 @@ footer p { padding: 32px 12px; } +header > .container { + display: flex; + flex-direction: row; +} + +header > .container > h1 { + flex: 1; +} + +.button, +header > .container nav > a { + font-family: "Inter"; + text-decoration: none; + background-color: var(--main-contrast-dark-color); + padding: 4px 12px; +} + +header > .container nav > a { + font-size: 80%; +} + .members { display: grid; grid-template-columns: repeat(3, 1fr); @@ -82,7 +103,7 @@ footer p { } .members > div { - border-left: 8px solid var(--main-contrast-light-color); + border-left: 6px solid var(--main-contrast-light-color); background-color: var(--main-contrast-dark-color); padding: 8px; font-family: "Inter"; @@ -122,7 +143,7 @@ footer p { font-size: 80%; } -.no-members { +.no-elts { color: var(--main-contrast-light-color); border-left: 8px solid var(--main-contrast-dark-color); padding: 32px; @@ -165,7 +186,7 @@ footer p { .member .link-list > div { background-color: var(--main-contrast-dark-color); padding: 4px 12px; - border-left: 4px solid var(--main-contrast-light-color); + font-size: 80%; } .member nav > div > a, @@ -190,13 +211,84 @@ footer p { text-align: right; } +section.articles { + margin-top: 64px; + font-size: 90%; + padding-bottom: 32px; +} + +section.articles article { + border-bottom: 4px solid var(--main-contrast-dark-color); + padding-bottom: 32px; + margin-bottom: 32px; +} + +section.articles article:last-child { + border-bottom-color: transparent; +} + +section.articles .lang > span { + margin-bottom: 12px; + background-color: var(--main-contrast-dark-color); + padding: 4px 12px; + display: inline-block; + color: var(--main-contrast-light-color); + font-family: "Inter"; + text-transform: uppercase; +} + +section.articles .date span { + color: var(--main-contrast-light-color); + font-weight: 700; + font-family: "Inter"; +} + +section.articles .date a { + margin-left: 4px; +} + +section.articles h2 { + margin-bottom: 12px; +} + +section.articles h2 > a { + text-decoration: none; + color: var(--main-light-color); + font-weight: 300; +} + +section.articles p { + padding: 12px 0; + font-weight: 200; +} + +section.articles ul.tags { + padding: 0; +} + +section.articles ul.tags > li:first-child { + padding-left: 0; +} +section.articles ul.tags > li { + list-style: none; + display: inline-block; + padding: 4px; + font-weight: 300; + font-family: "Inter"; +} + +section.articles ul.tags > li::before { + content: "#"; + color: var(--main-contrast-light-color); +} + @media all and (max-width: 1024px) { .members { grid-template-columns: repeat(2, 1fr); } } -@media all and (orientation: portrait), @media all and (max-width: 800px) { +@media all and (orientation: portrait), @media all and (max-width: 820px) { body { font-size: 1.5rem; line-height: 1.8; @@ -209,6 +301,7 @@ footer p { header h1 { line-height: 4rem; + margin-bottom: 32px; } .member { @@ -222,4 +315,8 @@ footer p { .member img { margin: 32px auto; } + + header > .container { + flex-direction: column; + } } diff --git a/static/templates/blog.html b/static/templates/blog.html new file mode 100644 index 0000000..e68a88f --- /dev/null +++ b/static/templates/blog.html @@ -0,0 +1,30 @@ +{%- autoescape false -%} {{ yocaml_body }} {%- endautoescape -%} {%- if +has_articles -%} +
+ {%- for article in articles -%} +
+
+
{{ article.link.lang }}
+

{{ article.title }}

+
+ published on {{ article.date.repr.date }} by {% for author + in article.authors -%} + {{ author }} + {%- endfor -%} +
+
+ {%- if article.has_synopsis -%} +

{{ article.synopsis }}

+ {%- endif -%} {%- if article.has_tags -%} + + {%- endif -%} +
+ {%- endfor -%} +
+{%- else -%} +
There are no federated articles
+{%- endif -%} diff --git a/static/templates/index.html b/static/templates/index.html index ab1974f..6af0d06 100644 --- a/static/templates/index.html +++ b/static/templates/index.html @@ -31,5 +31,5 @@

{{ m.display_name }}

{%- endfor -%} {%- else -%} -
The ring is empty
+
The ring is empty
{%- endif -%} diff --git a/static/templates/layout.html b/static/templates/layout.html index 8c33fd8..1f42f17 100644 --- a/static/templates/layout.html +++ b/static/templates/layout.html @@ -21,6 +21,9 @@

{{ sub_path }} {%- endif -%}

+
+ +
diff --git a/test/gem/article_test.ml b/test/gem/article_test.ml index 6732872..8c061e0 100644 --- a/test/gem/article_test.ml +++ b/test/gem/article_test.ml @@ -10,20 +10,21 @@ let%expect_test "Validate a minimal article" = ("title", string "An Article"); ("date", string "2024-08-11"); ("authors", string "xvw"); - ("url", string "https://xvw.lol/a.html"); + ("link", record [ ("url", string "https://xvw.lol/a.html") ]); ] in print_validated_value Article.pp (Article.validate article); [%expect {| - {"title": "An Article", "synopsis": null, "date": + {"title": "An Article", "has_synopsis": false, "synopsis": null, "date": {"year": 2024, "month": 8, "day": 11, "hour": 0, "min": 0, "sec": 0, "has_time": false, "day_of_week": 6, "repr": {"month": "aug", "datetime": "2024-08-11 00:00:00", "date": "2024-08-11", "time": "00:00:00", "day_of_week": "sun"}}, - "tags": [], "authors": ["xvw"], "url": - {"url": "https://xvw.lol/a.html", "scheme": "https", "url_without_scheme": - "xvw.lol/a.html"}} + "tags": [], "has_tags": false, "authors": ["xvw"], "link": + {"title": "xvw.lol/a.html", "lang": "eng", "url": + {"url": "https://xvw.lol/a.html", "scheme": "https", "url_without_scheme": + "xvw.lol/a.html"}}} |}] let%expect_test "Validate a full article" = @@ -35,21 +36,24 @@ let%expect_test "Validate a full article" = ("date", string "2024-08-11"); ("authors", list_of string [ "xvw"; "grim" ]); ("synopsis", string "A synopsis"); - ("url", string "https://xvw.lol/a.html"); + ("link", record [ ("url", string "https://xvw.lol/a.html") ]); ("tags", list_of string [ "a"; "b"; "c-d" ]); ] in print_validated_value Article.pp (Article.validate article); [%expect {| - {"title": "An Article", "synopsis": "A synopsis", "date": + {"title": "An Article", "has_synopsis": true, "synopsis": "A synopsis", + "date": {"year": 2024, "month": 8, "day": 11, "hour": 0, "min": 0, "sec": 0, "has_time": false, "day_of_week": 6, "repr": {"month": "aug", "datetime": "2024-08-11 00:00:00", "date": "2024-08-11", "time": "00:00:00", "day_of_week": "sun"}}, - "tags": ["a", "b", "c-d"], "authors": ["xvw", "grim"], "url": - {"url": "https://xvw.lol/a.html", "scheme": "https", "url_without_scheme": - "xvw.lol/a.html"}} + "tags": ["a", "b", "c-d"], "has_tags": true, "authors": ["xvw", "grim"], + "link": + {"title": "xvw.lol/a.html", "lang": "eng", "url": + {"url": "https://xvw.lol/a.html", "scheme": "https", "url_without_scheme": + "xvw.lol/a.html"}}} |}] let%expect_test "Validate an invalid article" = @@ -67,6 +71,6 @@ let%expect_test "Validate an invalid article" = [%expect {| for {"title": "An Article", "authors": ["xvw", "grim"], - "synopsis": "A synopsis", "tags": ["a", "b", "c-d"]} + missing field: link> for {"title": "An Article", "authors": ["xvw", "grim"], + "synopsis": "A synopsis", "tags": ["a", "b", "c-d"]} |}]