open Yocaml let article_path file = let filename = basename $ replace_extension file "html" in filename |> into "posts" module Author = struct type t = { name : string; } let equal a b = String.equal a.name b.name let make name = { name } let from (type a) (module V : Metadata.VALIDABLE with type t = a) obj = V.object_and (fun assoc -> let open Validate.Applicative in make <$> V.(required_assoc string) "name" assoc) obj let default_author = make "Reynir Björnsson" let inject (type a) (module D : Key_value.DESCRIBABLE with type t = a) { name } = D.[ "name", string name ] end module Article = struct type t = { title : string; date : Date.t; author : Author.t; } let make title date author = { title; date; author } let from (type a) (module V : Metadata.VALIDABLE with type t = a) obj = V.object_and (fun assoc -> let open Validate.Applicative in make <$> V.(required_assoc string) "title" assoc <*> V.(required_assoc (Metadata.Date.from (module V))) "date" assoc <*> V.(optional_assoc_or (Author.from (module V))) "author" assoc ~default:Author.default_author) obj let from_string (module V : Metadata.VALIDABLE) = function | None -> Validate.error $ Error.Required_metadata [ "Article" ] | Some str -> let open Validate.Monad in V.from_string str >>= from (module V) let inject (type a) (module D : Key_value.DESCRIBABLE with type t = a) { title; date; author } = D.[ "title", string title; "date", object_ $ Metadata.Date.inject (module D) date; "author", object_ $ Author.inject (module D) author ]; end module Articles = struct type t = (string * Article.t) list let make path article = (path, article) let sort articles = List.sort (fun (_, a) (_, b) -> ~-(Date.compare a.Article.date b.Article.date)) articles let inject (type a) (module D : Key_value.DESCRIBABLE with type t = a) articles = D.[ "articles", list (List.map (fun (path, article) -> object_ @@ [ "location", string path ] @ Article.inject (module D) article) articles) ] end module With_path (V : Metadata.INJECTABLE) = struct type t = { path : string; extension : V.t; } let merge path v = { path; extension=v; } let inject (type a) (module D : Key_value.DESCRIBABLE with type t = a) { path; extension } = D.[ "path", string path ] @ V.inject (module D) extension end module Page = struct type t = { title : string; head_extra : string option; } let make title head_extra = { title; head_extra } let from (type a) (module V : Metadata.VALIDABLE with type t = a) obj = V.object_and (fun assoc -> let open Validate.Applicative in make <$> V.(required_assoc string) "title" assoc <*> V.(optional_assoc string) "head_extra" assoc) obj let from_string (module V : Metadata.VALIDABLE) = function | None -> Validate.valid { title = "TODO"; head_extra = None } | Some str -> Validate.Monad.bind (from (module V)) (V.from_string str) let inject (type a) (module D : Key_value.DESCRIBABLE with type t = a) { title; head_extra } = let r = D.[ "title", string title ] in match head_extra with | None -> r | Some head_extra -> ("head_extra", D.string head_extra) :: r end module With_layout (V : Metadata.INJECTABLE) = struct type t = { title : string; head_extra : string option; extension : V.t } let merge ~title ~head_extra v = { title; head_extra; extension = v } let inject (type a) (module D : Key_value.DESCRIBABLE with type t = a) { title; head_extra; extension = v } = let r = D.[ "title", string title ] @ V.inject (module D) v in match head_extra with | None -> r | Some head_extra -> ("head_extra", D.string head_extra) :: r end