Skip to content

Commit

Permalink
Add a federated blog
Browse files Browse the repository at this point in the history
  • Loading branch information
xvw committed Aug 12, 2024
1 parent cc92c93 commit 955ec8d
Show file tree
Hide file tree
Showing 19 changed files with 294 additions and 34 deletions.
13 changes: 13 additions & 0 deletions data/articles/guarded-methods.yml
Original file line number Diff line number Diff line change
@@ -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]
10 changes: 10 additions & 0 deletions data/articles/import-modules.yml
Original file line number Diff line number Diff line change
@@ -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]
8 changes: 8 additions & 0 deletions data/articles/merlin-destruct.yml
Original file line number Diff line number Diff line change
@@ -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]
9 changes: 9 additions & 0 deletions data/blog.md
Original file line number Diff line number Diff line change
@@ -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**.
1 change: 1 addition & 0 deletions lib/action/all.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
17 changes: 17 additions & 0 deletions lib/action/articles.ml
Original file line number Diff line number Diff line change
@@ -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 ())
3 changes: 3 additions & 0 deletions lib/action/articles.mli
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
(** An action that builds the webring blog. *)

val run : (module Sigs.RESOLVER) -> Model.Chain.t -> Yocaml.Action.t
25 changes: 16 additions & 9 deletions lib/model/article.ml
Original file line number Diff line number Diff line change
@@ -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"
Expand All @@ -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
1 change: 1 addition & 0 deletions lib/model/article.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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} *)

Expand Down
40 changes: 40 additions & 0 deletions lib/model/articles.ml
Original file line number Diff line number Diff line change
@@ -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);
]
10 changes: 10 additions & 0 deletions lib/model/articles.mli
Original file line number Diff line number Diff line change
@@ -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
17 changes: 9 additions & 8 deletions lib/model/link.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
3 changes: 3 additions & 0 deletions lib/resolver.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down
3 changes: 3 additions & 0 deletions lib/sigs.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Loading

0 comments on commit 955ec8d

Please sign in to comment.