Handle cover in page and OG

capsule.toml

@@ -3,6 +3,12 @@ repository = "github/xvw/capsule"
 branch = "main"
 main_url = "https://xvw.lol"
 
+[default_cover]
+url = "/images/xvw-cover.png"
+width = 1200
+height = 630
+alt = "Cover image xvw.lol"
+
 [software_license]
 title = "MIT"
 url = "https://opensource.org/license/mit"

lib/static/archetype/config.ml

@@ -3,6 +3,7 @@ type t =
   ; repository : Model.Repo.t
   ; main_url : Model.Url.t
   ; branch : string
+  ; default_cover : Model.Cover.t option
   ; software_license : Model.Link.t
   ; content_license : Model.Link.t
   ; owner : Model.Identity.t
@@ -22,6 +23,7 @@ let validate =
     and+ software_license = required bag "software_license" Model.Link.validate
     and+ content_license = required bag "content_license" Model.Link.validate
     and+ owner = required bag "owner" Model.Identity.validate
+    and+ default_cover = optional bag "default_cover" Model.Cover.validate
     and+ svg = optional_or ~default:[] bag "svg" (list_of Model.Svg.validate) in
     { title
     ; repository
@@ -30,6 +32,7 @@ let validate =
     ; content_license
     ; owner
     ; svg
+    ; default_cover
     ; main_url
     })
 ;;
@@ -43,6 +46,7 @@ let normalize
   ; owner
   ; svg
   ; main_url
+  ; default_cover
   }
   =
   let open Yocaml.Data in
@@ -55,9 +59,13 @@ let normalize
     ; "content_license", Model.Link.normalize content_license
     ; "owner", Model.Identity.normalize owner
     ; "svg", Model.Svg.normalize_list svg
+    ; "default_cover", option Model.Cover.normalize default_cover
+    ; "has_default_cover", Model.Model_util.exists_from_opt default_cover
     ]
 ;;
 
 let repository_of { repository; _ } = repository
 let branch_of { branch; _ } = branch
 let owner_of { owner; _ } = owner
+let main_url_of { main_url; _ } = main_url
+let default_cover_of { default_cover; _ } = default_cover

lib/static/archetype/config.mli

@@ -5,5 +5,7 @@ include Yocaml.Required.DATA_READABLE with type t := t
 val repository_of : t -> Model.Repo.t
 val branch_of : t -> string
 val owner_of : t -> Model.Identity.t
+val main_url_of : t -> Model.Url.t
+val default_cover_of : t -> Model.Cover.t option
 
 include Model.Types.NORMALIZABLE with type t := t

lib/static/archetype/page.ml

@@ -17,6 +17,10 @@ class type t = object
   inherit Model.Types.with_source_path
 end
 
+let resolve_cover config cover =
+  Option.map (Model.Cover.resolve (Config.main_url_of config)) cover
+;;
+
 class make p config source_path target_path =
   object (_ : #t)
     inherit
@@ -25,6 +29,7 @@ class make p config source_path target_path =
         ~document_kind:p#document_kind
         ~section:p#section
         ~charset:p#page_charset
+        ~cover:(resolve_cover config p#cover)
         ~description:p#description
         ~synopsis:p#synopsis
         ~published_at:p#published_at
@@ -71,8 +76,22 @@ let normalize_build_info page =
 ;;
 
 let meta page =
+  let cover =
+    match page#cover with
+    | Some x -> Some x
+    | None ->
+      resolve_cover
+        page#configuration
+        (Config.default_cover_of page#configuration)
+  in
+  let meta_cover =
+    match cover with
+    | None -> []
+    | Some x -> Model.Cover.meta_for x
+  in
   Model.Common.meta page
   @ Model.Identity.meta_for (Config.owner_of page#configuration)
+  @ meta_cover
 ;;
 
 let normalize page =

lib/static/model/common.ml

@@ -4,6 +4,7 @@ class t
   ~document_kind
   ~title
   ~charset
+  ~cover
   ~description
   ~synopsis
   ~section
@@ -19,6 +20,7 @@ class t
     method document_kind = document_kind
     method page_title = title
     method page_charset = charset
+    method cover = cover
     method description = description_value
     method section = section
     method published_at = published_at
@@ -61,6 +63,7 @@ let validate fields =
     optional fields "updated_at" Yocaml.Archetype.Datetime.validate
   and+ synopsis = required fields "synopsis" string
   and+ tags = optional_or fields ~default:[] "tags" (list_of Slug.validate)
+  and+ cover = optional fields "cover" Cover.validate
   and+ breadcrumb =
     optional_or fields ~default:[] "breadcrumb" (list_of Link.validate)
   and+ display_toc = optional_or fields ~default:false "display_toc" bool in
@@ -69,6 +72,7 @@ let validate fields =
     ~document_kind
     ~section
     ~charset:(Some charset)
+    ~cover
     ~description
     ~published_at
     ~updated_at
@@ -131,12 +135,14 @@ let normalize obj =
   ; "updated_at", option Yocaml.Archetype.Datetime.normalize obj#updated_at
   ; "tags", list_of string obj#tags
   ; "breadcrumb", list_of Link.normalize obj#breadcrumb
+  ; "cover", option Cover.normalize obj#cover
   ; "toc", option string obj#toc
   ; "has_section", exists_from_opt obj#section
   ; "has_toc", bool (obj#display_toc && Option.is_some obj#toc)
   ; "has_page_title", exists_from_opt obj#page_title
   ; "has_page_charset", exists_from_opt obj#page_charset
   ; "has_description", exists_from_opt obj#description
+  ; "has_cover", exists_from_opt obj#cover
   ; "has_breadcrumb", exists_from_list obj#breadcrumb
   ; "has_published_date", exists_from_opt obj#published_at
   ; "has_updated_date", exists_from_opt obj#updated_at

lib/static/model/common.mli

@@ -2,6 +2,7 @@ class t :
   document_kind:Types.document_kind
   -> title:string option
   -> charset:string option
+  -> cover:Cover.t option
   -> description:string option
   -> synopsis:string
   -> section:string option

lib/static/model/cover.ml

@@ -24,18 +24,37 @@ let mime_type =
       Yocaml.Data.Validation.fail_with ~given "Unknowm mime/type for image")
 ;;
 
-let validate ?root_uri () =
+let validate =
   let open Yocaml.Data.Validation in
   record (fun fields ->
     let+ url = required fields "url" Url.validate
     and+ mime_type = required fields "url" mime_type
     and+ width = optional fields "width" int
     and+ height = optional fields "height" int
     and+ alt = optional fields "alt" string in
-    let url =
-      match root_uri with
-      | None -> url
-      | Some root_uri -> Url.resolve root_uri url
-    in
     { url; mime_type; width; height; alt })
 ;;
+
+let normalize { url; mime_type; width; height; alt } =
+  let open Yocaml.Data in
+  record
+    [ "url", Url.normalize url
+    ; "mime_type", string mime_type
+    ; "width", option int width
+    ; "height", option int height
+    ; "alt", option string alt
+    ]
+;;
+
+let meta_for { url; mime_type; width; height; alt } =
+  let url = Some (Url.to_string url) in
+  [ Meta.from_option "og:image" url
+  ; Meta.from_option "og:image:url" url
+  ; Meta.from_option "og:image:type" (Some mime_type)
+  ; Meta.from_option "og:image:width" (Option.map string_of_int width)
+  ; Meta.from_option "og:image:height" (Option.map string_of_int height)
+  ; Meta.from_option "og:image:alt" alt
+  ]
+;;
+
+let resolve url c = { c with url = Url.resolve url c.url }

lib/static/model/cover.mli

@@ -0,0 +1,6 @@
+type t
+
+val validate : Yocaml.Data.t -> t Yocaml.Data.Validation.validated_value
+val normalize : t -> Yocaml.Data.t
+val meta_for : t -> Meta.t option list
+val resolve : Url.t -> t -> t

lib/static/model/identity.mli

@@ -3,4 +3,3 @@ type t
 include Types.MODEL with type t := t
 
 val meta_for : t -> Meta.t option list
-val to_open_graph : t -> Meta.t option list

lib/static/model/types.ml

@@ -18,6 +18,7 @@ class type common = object ('a)
   method document_kind : document_kind
   method page_title : string option
   method page_charset : string option
+  method cover : Cover.t option
   method description : string option
   method published_at : Yocaml.Archetype.Datetime.t option
   method updated_at : Yocaml.Archetype.Datetime.t option

lib/static/model/url.ml

@@ -139,11 +139,15 @@ let get_url ?(with_scheme = false) = function
 let resolve source target =
   match source, target with
   | External (scheme, path), Internal target ->
-    External (scheme, Filename.concat path (Yocaml.Path.to_string target))
+    let t = Yocaml.Path.to_string target in
+    let p = if t.[0] = '/' then path ^ t else Filename.concat path t in
+    External (scheme, p)
   | _ -> target (* do not resolve target if target are not resolvable. *)
 ;;
 
 let extension = function
   | Internal path -> Yocaml.Path.extension path
   | External (_, k) -> Filename.extension k
 ;;
+
+let to_string u = fst @@ make_urls u

lib/static/model/url.mli

@@ -10,3 +10,4 @@ val equal : t -> t -> bool
 val get_url : ?with_scheme:bool -> t -> string
 val resolve : t -> t -> t
 val extension : t -> string
+val to_string : t -> string