From af36a9a6db734e29fb66f1f8cb60723730cce99c Mon Sep 17 00:00:00 2001 From: xvw Date: Wed, 31 Jul 2024 17:45:39 +0200 Subject: [PATCH] Move model in a qualified subdir --- lib/action.ml | 8 +- lib/dune | 2 + lib/index.ml | 46 ------ lib/index.mli | 11 -- lib/model.ml | 308 -------------------------------------- lib/model.mli | 177 ---------------------- lib/{ => model}/chain.ml | 24 +-- lib/{ => model}/chain.mli | 22 ++- lib/model/lang.ml | 17 +++ lib/model/lang.mli | 28 ++++ lib/model/link.ml | 38 +++++ lib/model/link.mli | 31 ++++ lib/model/member.ml | 145 ++++++++++++++++++ lib/model/member.mli | 47 ++++++ lib/model/model_util.ml | 12 ++ lib/model/model_util.mli | 22 +++ lib/model/page.ml | 24 +++ lib/model/page.mli | 14 ++ lib/model/url.ml | 51 +++++++ lib/model/url.mli | 36 +++++ test/gem/chain_test.ml | 14 +- 21 files changed, 502 insertions(+), 575 deletions(-) delete mode 100644 lib/index.ml delete mode 100644 lib/index.mli delete mode 100644 lib/model.ml delete mode 100644 lib/model.mli rename lib/{ => model}/chain.ml (79%) rename lib/{ => model}/chain.mli (74%) create mode 100644 lib/model/lang.ml create mode 100644 lib/model/lang.mli create mode 100644 lib/model/link.ml create mode 100644 lib/model/link.mli create mode 100644 lib/model/member.ml create mode 100644 lib/model/member.mli create mode 100644 lib/model/model_util.ml create mode 100644 lib/model/model_util.mli create mode 100644 lib/model/page.ml create mode 100644 lib/model/page.mli create mode 100644 lib/model/url.ml create mode 100644 lib/model/url.mli diff --git a/lib/action.ml b/lib/action.ml index daa6538..f394af6 100644 --- a/lib/action.ml +++ b/lib/action.ml @@ -18,7 +18,7 @@ let init_chain (module R : Sigs.RESOLVER) = let* cache = Yocaml.Action.restore_cache ~on:`Target R.Target.cache in let* chain = Yocaml_yaml.Eff.read_file_as_metadata - (module Model.Chain) + (module Model.Chain.Metadata) ~on:`Source R.Source.chain in let+ cache, members = @@ -34,7 +34,7 @@ let init_chain (module R : Sigs.RESOLVER) = (cache, member :: state)) cache in - (cache, Chain.init ~chain ~members) + (cache, Model.Chain.init ~chain ~members) let init_message (module R : Sigs.RESOLVER) = Yocaml.Eff.logf ~level:`Debug "ring.muhokama [source: `%a`, target: `%a`]" @@ -48,7 +48,7 @@ let generate_opml (module R : Sigs.RESOLVER) chain = R.track_common_dependencies >>> Yocaml.Pipeline.track_file R.Source.members >>> const chain - >>> Chain.to_opml) + >>> Model.Chain.to_opml) let process_chain_member (module R : Sigs.RESOLVER) pred_or_succ current_member target_member = @@ -69,7 +69,7 @@ let process_chain_member (module R : Sigs.RESOLVER) pred_or_succ current_member let process_chain (module R : Sigs.RESOLVER) chain = let process_chain_member = process_chain_member (module R) in - Yocaml.Action.batch_list (Chain.to_list chain) + Yocaml.Action.batch_list (Model.Chain.to_list chain) (fun (curr, (pred, succ)) cache -> let open Yocaml.Eff in cache diff --git a/lib/dune b/lib/dune index 7de2bdd..db2f56b 100644 --- a/lib/dune +++ b/lib/dune @@ -4,3 +4,5 @@ (synopsis "The name [gem] is because it's set with a ring. lol") (modules_without_implementation sigs) (libraries yocaml yocaml_yaml yocaml_syndication yocaml_jingoo yocaml_omd)) + +(include_subdirs qualified) diff --git a/lib/index.ml b/lib/index.ml deleted file mode 100644 index c8ab172..0000000 --- a/lib/index.ml +++ /dev/null @@ -1,46 +0,0 @@ -type t = { page : Model.Page.t; chain : Chain.t; interests : Model.Link.t list } - -let entity_name = "Parge" - -let neutral = - Ok { page = Model.Page.empty; chain = Chain.empty; interests = [] } - -let validate = - let open Yocaml.Data.Validation in - record (fun fields -> - let+ page = Model.Page.validate_underlying_page fields - and+ interests = - optional_or ~default:[] fields "interests" (list_of Model.Link.validate) - in - { page; interests; chain = Chain.empty }) - -let merge_chain chain = - Yocaml.Task.lift ~has_dynamic_dependencies:false (fun x -> { x with chain }) - -let normalize { page; chain; interests } = - let open Yocaml.Data in - let len = List.length interests in - let interests = - List.mapi - (fun i link -> - let sep = - if i >= len - 1 then "" else if i >= len - 2 then " and " else ", " - in - record (("sep", string sep) :: Model.Link.normalize_underlying_link link)) - interests - in - let members = - chain - |> Chain.to_list - |> List.map (fun (curr, (pred, succ)) -> - record - (("pred", record @@ Model.Member.normalize pred) - :: ("succ", record @@ Model.Member.normalize succ) - :: Model.Member.normalize curr)) - in - Model.Page.normalize page - @ [ - ("has_interest", bool @@ List.is_empty interests); - ("interests", list interests); - ("chain", list members); - ] diff --git a/lib/index.mli b/lib/index.mli deleted file mode 100644 index f9378b3..0000000 --- a/lib/index.mli +++ /dev/null @@ -1,11 +0,0 @@ -(** Describes an index. *) - -type t -(** The type describing the index. *) - -val merge_chain : Chain.t -> (t, t) Yocaml.Task.t - -(** {1 Dealing as metadata} *) - -include Yocaml.Required.DATA_READABLE with type t := t -include Yocaml.Required.DATA_INJECTABLE with type t := t diff --git a/lib/model.ml b/lib/model.ml deleted file mode 100644 index d531239..0000000 --- a/lib/model.ml +++ /dev/null @@ -1,308 +0,0 @@ -let minimal_length len = - let open Yocaml.Data.Validation in - where ~pp:Format.pp_print_string - ~message:(fun s -> s ^ " should be at least of size " ^ string_of_int len) - (fun s -> String.length s >= len) - -let has_opt x = Yocaml.Data.bool @@ Option.is_some x -let has_list x = Yocaml.Data.bool @@ not (List.is_empty x) - -let token = - Yocaml.Data.Validation.( - string $ fun x -> x |> String.trim |> String.lowercase_ascii) - -module Lang = struct - type t = Eng | Fra - - let validate = - let open Yocaml.Data.Validation in - token & function - | "fra" -> Ok Fra - | "eng" -> Ok Eng - | given -> fail_with ~given "Invalid Lang Value" - - let to_string = function Fra -> "fra" | Eng -> "eng" - let normalize lang = Yocaml.Data.string @@ to_string lang - let pp ppf lang = Format.fprintf ppf "%s" @@ to_string lang - - let equal a b = - match (a, b) with Fra, Fra | Eng, Eng -> true | Fra, _ | Eng, _ -> false -end - -module Url = struct - type scheme = Http | Https | Gemini - type t = scheme * string - - let scheme_to_string = function - | Http -> "http" - | Https -> "https" - | Gemini -> "gemini" - - let scheme_to_prefix scheme = scheme_to_string scheme ^ "://" - let invalid_url given = Yocaml.Data.Validation.fail_with ~given "Invalid url" - - let validate_with_scheme scheme given = - let prefix = scheme_to_prefix scheme in - if String.starts_with ~prefix given then - try - let len = String.length prefix in - let gln = String.length given in - let rest = String.sub given len (gln - len) in - if String.length rest >= 3 then Ok (scheme, rest) else invalid_url given - with _ -> invalid_url given - else invalid_url given - - let validate = - let open Yocaml.Data.Validation in - string - & validate_with_scheme Http - / validate_with_scheme Https - / validate_with_scheme Gemini - - let equal_scheme a b = - match (a, b) with - | Http, Http | Https, Https | Gemini, Gemini -> true - | Http, _ | Https, _ | Gemini, _ -> false - - let equal (scheme_a, url_a) (scheme_b, url_b) = - equal_scheme scheme_a scheme_b && String.equal url_a url_b - - let to_string (scheme, url) = scheme_to_prefix scheme ^ url - let pp ppf url = Format.fprintf ppf "%s" @@ to_string url - - let normalize ((scheme, url) as full_url) = - let open Yocaml.Data in - record - [ - ("url", string @@ to_string full_url); - ("scheme", string @@ scheme_to_string scheme); - ("url_without_scheme", string url); - ] -end - -module Link = struct - 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:(snd url) "title" - (string & minimal_length 2) - in - (title, lang, url)) - - let normalize_underlying_link (title, lang, url) = - let open Yocaml.Data in - [ - ("title", string title); - ("lang", Lang.normalize lang); - ("url", Url.normalize url); - ] - - let normalize link = Yocaml.Data.record (normalize_underlying_link link) - - let pp ppf (title, lang, url) = - Format.fprintf ppf "%s, %a, %a" title Lang.pp lang Url.pp url - - let to_string = Format.asprintf "%a" pp - - let equal (title_a, lang_a, url_a) (title_b, lang_b, url_b) = - String.equal title_a title_b - && Lang.equal lang_a lang_b - && Url.equal url_a url_b - - let title (title, _, _) = title - let lang (_, lang, _) = lang - let url (_, _, url) = url -end - -module Link_table = struct end - -module Member = struct - type t = { - id : string; - display_name : string option; - bio : string option; - has_avatar : bool; - nouns : string list; - main_link : Link.t; - main_feed : Link.t option; - additional_links : Link.t list; - additional_feeds : Link.t list; - location : string option; - } - - let id { id; _ } = id - - let display_name { id; display_name; _ } = - Option.value ~default:id display_name - - let entity_name = "Member" - let neutral = Yocaml.Metadata.required entity_name - let validate_id = Yocaml.(Data.Validation.(Slug.validate & minimal_length 2)) - - let validate = - let open Yocaml.Data.Validation in - record (fun fields -> - let+ id = required fields "id" validate_id - and+ display_name = - optional fields "display_name" (string & minimal_length 2) - and+ bio = optional fields "bio" (string & minimal_length 5) - and+ has_avatar = optional_or fields ~default:false "has_avatar" bool - and+ main_link = required fields "main_link" Link.validate - and+ main_feed = optional fields "main_feed" Link.validate - and+ nouns = optional_or fields ~default:[] "nouns" (list_of token) - and+ location = optional fields "location" string - and+ additional_links = - optional_or fields ~default:[] "additional_links" - (list_of Link.validate) - and+ additional_feeds = - optional_or fields ~default:[] "additional_feeds" - (list_of Link.validate) - in - { - id; - display_name; - bio; - has_avatar; - main_link; - main_feed; - nouns; - additional_links; - additional_feeds; - location; - }) - - let normalize - { - id; - display_name; - bio; - has_avatar; - main_link; - main_feed; - nouns; - additional_links; - additional_feeds; - location; - } = - let open Yocaml.Data in - [ - ("id", string id); - ("has_display_name", has_opt display_name); - ("display_name", option string display_name); - ("has_bio", has_opt bio); - ("bio", option string bio); - ("has_avatar", bool has_avatar); - ("main_link", Link.normalize main_link); - ("has_main_feed", has_opt main_feed); - ("main_feed", option Link.normalize main_feed); - ("has_nouns", has_list nouns); - ("nouns", list_of string nouns); - ("has_additional_links", has_list additional_links); - ("additional_links", list_of Link.normalize additional_links); - ("has_additional_feeds", has_list additional_feeds); - ("additional_feeds", list_of Link.normalize additional_feeds); - ("has_location", has_opt location); - ("location", option string location); - ] - - let pp ppf member = - Format.fprintf ppf "%a" Yocaml.Data.pp - (member |> normalize |> Yocaml.Data.record) - - let to_string = Format.asprintf "%a" pp - - let equal - { - id; - bio; - display_name; - has_avatar; - main_link; - main_feed; - nouns; - additional_links; - additional_feeds; - location; - } other = - String.equal id other.id - && Option.equal String.equal bio other.bio - && Option.equal String.equal display_name other.display_name - && Bool.equal has_avatar other.has_avatar - && Link.equal main_link other.main_link - && Option.equal Link.equal main_feed other.main_feed - && List.equal String.equal nouns other.nouns - && List.equal Link.equal additional_links other.additional_links - && List.equal Link.equal additional_feeds other.additional_feeds - && Option.equal String.equal location other.location - - let feed_to_outline ?main_link title description feed_url = - Yocaml_syndication.Opml.subscription - ~language:(feed_url |> Link.lang |> Lang.to_string) - ~title ~description - ?html_url: - (main_link |> Option.map (fun x -> x |> Link.url |> Url.to_string)) - ~feed_url:(feed_url |> Link.url |> Url.to_string) - () - - let to_outline member = - let display_name = display_name member in - let main_feed = - let description = "Main feed of " ^ display_name in - let title = member.main_link |> Link.title in - member.main_feed - |> Option.map - (feed_to_outline ~main_link:member.main_link title description) - |> Option.to_list - in - let additional_feeds = - member.additional_feeds - |> List.mapi (fun index feed -> - let title = feed |> Link.title in - let description = - "Additional feed " ^ string_of_int index ^ "of " ^ display_name - in - feed_to_outline title description feed) - in - main_feed @ additional_feeds -end - -module Page = struct - type t = { page_title : string option; description : string option } - - let entity_name = "Page" - let empty = { page_title = None; description = None } - let neutral = Ok { page_title = None; description = None } - - let validate_underlying_page fields = - let open Yocaml.Data.Validation in - let+ page_title = optional fields "page_title" string - and+ description = optional fields "description" string in - { page_title; description } - - let validate = Yocaml.Data.Validation.record validate_underlying_page - - let normalize { page_title; description } = - let open Yocaml.Data in - [ - ("has_page_title", has_opt page_title); - ("page_title", option string page_title); - ("has_description", has_opt description); - ("description", option string description); - ] -end - -module Chain = struct - type t = string list - - let entity_name = "Chain" - let neutral = Ok [] - - let validate = - let open Yocaml.Data.Validation in - list_of Yocaml.Slug.validate -end diff --git a/lib/model.mli b/lib/model.mli deleted file mode 100644 index 75810eb..0000000 --- a/lib/model.mli +++ /dev/null @@ -1,177 +0,0 @@ -(** Describes the different data models used to describe the webring. Each model - is described in a sub-module to avoid having to leake an overly large (and - potentially useless) API. *) - -(** {1 Components} - - Intermediate data models used to describe model components. *) - -module Lang : sig - (** Very minimalist support for possible languages. This model is intended to - evolve according to the participants in the Webring. Currently, only a - very small subset of languages is supported. - - The languages are an approximation of the - {{:https://iso639-3.sil.org/code_tables/639/data} ISO639-3} standard - (without linguistic precision). - - Once normalized, a language is just a string. *) - - (** Currently, a very small subset is supported but feel free to add more - language.*) - type t = Eng | Fra - - val validate : Yocaml.Data.t -> t Yocaml.Data.Validation.validated_value - (** [validate data] validate a lang from a {!type:Yocaml.Data.t} value. *) - - val normalize : t -> Yocaml.Data.t - (** [normalize lang] serialize a lang into a {!type:Yocaml.Data.t}. *) - - val pp : Format.formatter -> t -> unit - (** Pretty-printer for lang. *) - - val to_string : t -> string - (** serialize a lang into a string. *) - - val equal : t -> t -> bool - (** Equality between langs. *) -end - -module Url : sig - (** A rather naive implementation of a validator for URLs (which simply checks - the existence of a scheme). In the near future, we will probably have to - relay on the {{:https://ocaml.org/p/uri/latest} URI} library. Currently, - prefix supported are: - - http - - https - - gemini (because of heyPlzLookAtMe) - - Once normalized, an url has this complicated shape (to give control on the - template side): - - [url]: the full url representation ([scheme + "://" + url]) - - [scheme] the scheme of the url ([Http | Https | Gemini]) - - [url_without_scheme] the url without the scheme. *) - - type t - (** The type describing an url. *) - - val validate : Yocaml.Data.t -> t Yocaml.Data.Validation.validated_value - (** [validate data] validate an url from a {!type:Yocaml.Data.t} value. *) - - val normalize : t -> Yocaml.Data.t - (** [normalize url] serialize an url into a {!type:Yocaml.Data.t}. *) - - val pp : Format.formatter -> t -> unit - (** Pretty-printer for url. *) - - val to_string : t -> string - (** serialize an url into a string. *) - - val equal : t -> t -> bool - (** Equality between url. *) -end - -module Link : sig - (** A link is a triplet of {!type:Gem.Model.Lang.t}, {!type:Gem.Model.Url.t} - and title. - - Once normalized, a link is a record: - - [title] the title of the link - - [lang] the lang of the link (normalized as a {!module:Gem.Model.Lang}) - - [url] the url of the link (normalized as a {!module:Gem.Model.Url}) *) - - type t - (** The type describing a member. *) - - val normalize_underlying_link : t -> (string * Yocaml.Data.t) list - - val validate : Yocaml.Data.t -> t Yocaml.Data.Validation.validated_value - (** [validate data] validate a link from a {!type:Yocaml.Data.t} value. *) - - val normalize : t -> Yocaml.Data.t - (** [normalize url] serialize an link into a {!type:Yocaml.Data.t}. *) - - val pp : Format.formatter -> t -> unit - (** Pretty-printer for url. *) - - val to_string : t -> string - (** serialize an url into a string. *) - - val equal : t -> t -> bool - (** Equality between url. *) -end - -module Member : sig - (** Describes a member of Webring! A Webring member is an entity that can be - treated independently. - - Once normalized, a member is a record: - - [id] the slug identifier for the member (ie: [xvw]) - - [bio] a short optional string that identify the member (associated to - [has_bio: bool]) - - [location] an short optional string that identify the location of the - member (associated to [has_location]) - - [has_avatar] if [true] avatar that should be present in the avatar - folder, otherwise [false] - - [main_link] the main link of the the member - - [main_feed] an optional link that point the main RSS/ATOM feed of the - member (associated to [has_main_feed]) - - [nouns] an optional list of string that describes nouns of the member - (associated to [has_nouns]) - - [additional_links] an optional list of additional links (associated to - [has_additional_links]) - - [additional_feeds] an optional list of additional feeds (associated to - [has_additional_feeds]) *) - - type t - (** The type describing a member. *) - - val pp : Format.formatter -> t -> unit - (** Pretty-printer for members. *) - - val to_string : t -> string - (** serialize a member into a string. *) - - val equal : t -> t -> bool - (** Equality between members. *) - - (** {1 Dealing as metadata} *) - - include Yocaml.Required.DATA_READABLE with type t := t - include Yocaml.Required.DATA_INJECTABLE with type t := t - - (** {1 Accessors and Mutators} *) - - val id : t -> string - (** Returns the id of a member. *) - - (** {1 OPML generation} *) - - val to_outline : t -> Yocaml_syndication.Opml.outline list - (** [to_outline m] transform a member to a list of OPML outlines. *) -end - -module Chain : sig - (** Describes the chain of members (as a list of identifiers). *) - - type t = string list - - include Yocaml.Required.DATA_READABLE with type t := t -end - -module Page : sig - (** Describes a generic page, mostly used on top of another model. *) - - type t - (** The type describing a page. *) - - val empty : t - - val validate_underlying_page : - (string * Yocaml.Data.t) list -> t Yocaml.Data.Validation.validated_record - - (** {1 Dealing as metadata} *) - - include Yocaml.Required.DATA_READABLE with type t := t - include Yocaml.Required.DATA_INJECTABLE with type t := t -end diff --git a/lib/chain.ml b/lib/model/chain.ml similarity index 79% rename from lib/chain.ml rename to lib/model/chain.ml index a26991c..5a56a71 100644 --- a/lib/chain.ml +++ b/lib/model/chain.ml @@ -1,14 +1,18 @@ -module SMap = Map.Make (String) +module Metadata = struct + type t = string list -type elt = { - pred : Model.Member.t; - curr : Model.Member.t; - succ : Model.Member.t; -} + let entity_name = "Chain" + let neutral = Ok [] -type t = elt list + let validate = + let open Yocaml.Data.Validation in + list_of Yocaml.Slug.validate +end -let empty = [] +module SMap = Map.Make (String) + +type elt = { pred : Member.t; curr : Member.t; succ : Member.t } +type t = elt list let from_member_list = function | [] -> [] @@ -37,7 +41,7 @@ let init ~chain ~members = let members = List.fold_left (fun acc member -> - let key = Model.Member.id member in + let key = Member.id member in SMap.add key member acc) SMap.empty members in @@ -56,5 +60,5 @@ let to_list chain = let to_opml = let open Yocaml.Task in - List.concat_map (fun { curr; _ } -> Model.Member.to_outline curr) + List.concat_map (fun { curr; _ } -> Member.to_outline curr) |>> Yocaml_syndication.Opml.opml2_from ~title:"ring.muhokama.fun" () diff --git a/lib/chain.mli b/lib/model/chain.mli similarity index 74% rename from lib/chain.mli rename to lib/model/chain.mli index eead7dd..7a339dd 100644 --- a/lib/chain.mli +++ b/lib/model/chain.mli @@ -9,7 +9,7 @@ type t (** {1 Interaction with the chain} *) -val init : chain:string list -> members:Model.Member.t list -> t +val init : chain:string list -> members:Member.t list -> t (** Intialize thes chain of the application, used for generating every pages. The chain is a list of member (that maintain the order) and members is just the list of members, if a member from the chain is not present in the @@ -17,23 +17,21 @@ val init : chain:string list -> members:Model.Member.t list -> t the chain are discarded (also). *) val fold : - ('a -> - pred:Model.Member.t -> - curr:Model.Member.t -> - succ:Model.Member.t -> - 'a) -> - 'a -> - t -> - 'a + ('a -> pred:Member.t -> curr:Member.t -> succ:Member.t -> 'a) -> 'a -> t -> 'a (** [fold f default chain] Traverses all the elements in the chain by applying a function that takes the predecessor, the current member, the successor and the current state. *) -val to_list : t -> (Model.Member.t * (Model.Member.t * Model.Member.t)) list +val to_list : t -> (Member.t * (Member.t * Member.t)) list (** [to_list chain] returns a chain into a list of [curr, (pred, succ)]. *) val to_opml : (t, string) Yocaml.Task.t (** [to_opml] An arrow that lift a chain into an OPML file. *) -val empty : t -(** [empty] returns an empty chain. *) +(** {1 Reading chain from a file} *) + +module Metadata : sig + type t = string list + + include Yocaml.Required.DATA_READABLE with type t := t +end diff --git a/lib/model/lang.ml b/lib/model/lang.ml new file mode 100644 index 0000000..2d31fdf --- /dev/null +++ b/lib/model/lang.ml @@ -0,0 +1,17 @@ +open Model_util + +type t = Eng | Fra + +let validate = + let open Yocaml.Data.Validation in + token & function + | "fra" -> Ok Fra + | "eng" -> Ok Eng + | given -> fail_with ~given "Invalid Lang Value" + +let to_string = function Fra -> "fra" | Eng -> "eng" +let normalize lang = Yocaml.Data.string @@ to_string lang +let pp ppf lang = Format.fprintf ppf "%s" @@ to_string lang + +let equal a b = + match (a, b) with Fra, Fra | Eng, Eng -> true | Fra, _ | Eng, _ -> false diff --git a/lib/model/lang.mli b/lib/model/lang.mli new file mode 100644 index 0000000..1beeced --- /dev/null +++ b/lib/model/lang.mli @@ -0,0 +1,28 @@ +(** Very minimalist support for possible languages. This model is intended to + evolve according to the participants in the Webring. Currently, only a very + small subset of languages is supported. + + The languages are an approximation of the + {{:https://iso639-3.sil.org/code_tables/639/data} ISO639-3} standard + (without linguistic precision). + + Once normalized, a language is just a string. *) + +(** Currently, a very small subset is supported but feel free to add more + language.*) +type t = Eng | Fra + +val validate : Yocaml.Data.t -> t Yocaml.Data.Validation.validated_value +(** [validate data] validate a lang from a {!type:Yocaml.Data.t} value. *) + +val normalize : t -> Yocaml.Data.t +(** [normalize lang] serialize a lang into a {!type:Yocaml.Data.t}. *) + +val pp : Format.formatter -> t -> unit +(** Pretty-printer for lang. *) + +val to_string : t -> string +(** serialize a lang into a string. *) + +val equal : t -> t -> bool +(** Equality between langs. *) diff --git a/lib/model/link.ml b/lib/model/link.ml new file mode 100644 index 0000000..8bf822e --- /dev/null +++ b/lib/model/link.ml @@ -0,0 +1,38 @@ +open Model_util + +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 2) + in + (title, lang, url)) + +let normalize_underlying_link (title, lang, url) = + let open Yocaml.Data in + [ + ("title", string title); + ("lang", Lang.normalize lang); + ("url", Url.normalize url); + ] + +let normalize link = Yocaml.Data.record (normalize_underlying_link link) + +let pp ppf (title, lang, url) = + Format.fprintf ppf "%s, %a, %a" title Lang.pp lang Url.pp url + +let to_string = Format.asprintf "%a" pp + +let equal (title_a, lang_a, url_a) (title_b, lang_b, url_b) = + String.equal title_a title_b + && Lang.equal lang_a lang_b + && Url.equal url_a url_b + +let title (title, _, _) = title +let lang (_, lang, _) = lang +let url (_, _, url) = url diff --git a/lib/model/link.mli b/lib/model/link.mli new file mode 100644 index 0000000..8924802 --- /dev/null +++ b/lib/model/link.mli @@ -0,0 +1,31 @@ +(** A link is a triplet of {!type:Gem.Model.Lang.t}, {!type:Gem.Model.Url.t} and + title. + + Once normalized, a link is a record: + - [title] the title of the link + - [lang] the lang of the link (normalized as a {!module:Gem.Model.Lang}) + - [url] the url of the link (normalized as a {!module:Gem.Model.Url}) *) + +type t +(** The type describing a member. *) + +val normalize_underlying_link : t -> (string * Yocaml.Data.t) list + +val validate : Yocaml.Data.t -> t Yocaml.Data.Validation.validated_value +(** [validate data] validate a link from a {!type:Yocaml.Data.t} value. *) + +val normalize : t -> Yocaml.Data.t +(** [normalize url] serialize an link into a {!type:Yocaml.Data.t}. *) + +val pp : Format.formatter -> t -> unit +(** Pretty-printer for url. *) + +val to_string : t -> string +(** serialize an url into a string. *) + +val equal : t -> t -> bool +(** Equality between url. *) + +val title : t -> string +val lang : t -> Lang.t +val url : t -> Url.t diff --git a/lib/model/member.ml b/lib/model/member.ml new file mode 100644 index 0000000..1830d03 --- /dev/null +++ b/lib/model/member.ml @@ -0,0 +1,145 @@ +open Model_util + +type t = { + id : string; + display_name : string option; + bio : string option; + has_avatar : bool; + nouns : string list; + main_link : Link.t; + main_feed : Link.t option; + additional_links : Link.t list; + additional_feeds : Link.t list; + location : string option; +} + +let id { id; _ } = id +let display_name { id; display_name; _ } = Option.value ~default:id display_name +let entity_name = "Member" +let neutral = Yocaml.Metadata.required entity_name +let validate_id = Yocaml.(Data.Validation.(Slug.validate & minimal_length 2)) + +let validate = + let open Yocaml.Data.Validation in + record (fun fields -> + let+ id = required fields "id" validate_id + and+ display_name = + optional fields "display_name" (string & minimal_length 2) + and+ bio = optional fields "bio" (string & minimal_length 5) + and+ has_avatar = optional_or fields ~default:false "has_avatar" bool + and+ main_link = required fields "main_link" Link.validate + and+ main_feed = optional fields "main_feed" Link.validate + and+ nouns = optional_or fields ~default:[] "nouns" (list_of token) + and+ location = optional fields "location" string + and+ additional_links = + optional_or fields ~default:[] "additional_links" + (list_of Link.validate) + and+ additional_feeds = + optional_or fields ~default:[] "additional_feeds" + (list_of Link.validate) + in + { + id; + display_name; + bio; + has_avatar; + main_link; + main_feed; + nouns; + additional_links; + additional_feeds; + location; + }) + +let normalize + { + id; + display_name; + bio; + has_avatar; + main_link; + main_feed; + nouns; + additional_links; + additional_feeds; + location; + } = + let open Yocaml.Data in + [ + ("id", string id); + ("has_display_name", has_opt display_name); + ("display_name", option string display_name); + ("has_bio", has_opt bio); + ("bio", option string bio); + ("has_avatar", bool has_avatar); + ("main_link", Link.normalize main_link); + ("has_main_feed", has_opt main_feed); + ("main_feed", option Link.normalize main_feed); + ("has_nouns", has_list nouns); + ("nouns", list_of string nouns); + ("has_additional_links", has_list additional_links); + ("additional_links", list_of Link.normalize additional_links); + ("has_additional_feeds", has_list additional_feeds); + ("additional_feeds", list_of Link.normalize additional_feeds); + ("has_location", has_opt location); + ("location", option string location); + ] + +let pp ppf member = + Format.fprintf ppf "%a" Yocaml.Data.pp + (member |> normalize |> Yocaml.Data.record) + +let to_string = Format.asprintf "%a" pp + +let equal + { + id; + bio; + display_name; + has_avatar; + main_link; + main_feed; + nouns; + additional_links; + additional_feeds; + location; + } other = + String.equal id other.id + && Option.equal String.equal bio other.bio + && Option.equal String.equal display_name other.display_name + && Bool.equal has_avatar other.has_avatar + && Link.equal main_link other.main_link + && Option.equal Link.equal main_feed other.main_feed + && List.equal String.equal nouns other.nouns + && List.equal Link.equal additional_links other.additional_links + && List.equal Link.equal additional_feeds other.additional_feeds + && Option.equal String.equal location other.location + +let feed_to_outline ?main_link title description feed_url = + Yocaml_syndication.Opml.subscription + ~language:(feed_url |> Link.lang |> Lang.to_string) + ~title ~description + ?html_url:(main_link |> Option.map (fun x -> x |> Link.url |> Url.to_string)) + ~feed_url:(feed_url |> Link.url |> Url.to_string) + () + +let to_outline member = + let display_name = display_name member in + let main_feed = + let description = "Main feed of " ^ display_name in + let title = member.main_link |> Link.title in + member.main_feed + |> Option.map + (feed_to_outline ~main_link:member.main_link title description) + |> Option.to_list + in + let additional_feeds = + member.additional_feeds + |> List.mapi (fun index feed -> + let title = feed |> Link.title in + let description = + "Additional feed " ^ string_of_int index ^ "of " ^ display_name + in + feed_to_outline title description feed) + in + main_feed @ additional_feeds diff --git a/lib/model/member.mli b/lib/model/member.mli new file mode 100644 index 0000000..e70902f --- /dev/null +++ b/lib/model/member.mli @@ -0,0 +1,47 @@ +(** Describes a member of Webring! A Webring member is an entity that can be + treated independently. + + Once normalized, a member is a record: + - [id] the slug identifier for the member (ie: [xvw]) + - [bio] a short optional string that identify the member (associated to + [has_bio: bool]) + - [location] an short optional string that identify the location of the + member (associated to [has_location]) + - [has_avatar] if [true] avatar that should be present in the avatar folder, + otherwise [false] + - [main_link] the main link of the the member + - [main_feed] an optional link that point the main RSS/ATOM feed of the + member (associated to [has_main_feed]) + - [nouns] an optional list of string that describes nouns of the member + (associated to [has_nouns]) + - [additional_links] an optional list of additional links (associated to + [has_additional_links]) + - [additional_feeds] an optional list of additional feeds (associated to + [has_additional_feeds]) *) + +type t +(** The type describing a member. *) + +val pp : Format.formatter -> t -> unit +(** Pretty-printer for members. *) + +val to_string : t -> string +(** serialize a member into a string. *) + +val equal : t -> t -> bool +(** Equality between members. *) + +(** {1 Dealing as metadata} *) + +include Yocaml.Required.DATA_READABLE with type t := t +include Yocaml.Required.DATA_INJECTABLE with type t := t + +(** {1 Accessors and Mutators} *) + +val id : t -> string +(** Returns the id of a member. *) + +(** {1 OPML generation} *) + +val to_outline : t -> Yocaml_syndication.Opml.outline list +(** [to_outline m] transform a member to a list of OPML outlines. *) diff --git a/lib/model/model_util.ml b/lib/model/model_util.ml new file mode 100644 index 0000000..99fb523 --- /dev/null +++ b/lib/model/model_util.ml @@ -0,0 +1,12 @@ +let minimal_length len = + let open Yocaml.Data.Validation in + where ~pp:Format.pp_print_string + ~message:(fun s -> s ^ " should be at least of size " ^ string_of_int len) + (fun s -> String.length s >= len) + +let has_opt x = Yocaml.Data.bool @@ Option.is_some x +let has_list x = Yocaml.Data.bool @@ not (List.is_empty x) + +let token = + Yocaml.Data.Validation.( + string $ fun x -> x |> String.trim |> String.lowercase_ascii) diff --git a/lib/model/model_util.mli b/lib/model/model_util.mli new file mode 100644 index 0000000..1917efa --- /dev/null +++ b/lib/model/model_util.mli @@ -0,0 +1,22 @@ +(** Generic utilities for describing models *) + +(** {1 Validation helpers} *) + +val minimal_length : + int -> string -> string Yocaml.Data.Validation.validated_value +(** A validator which ensures that a character string has at least the size + given as an argument. *) + +val token : Yocaml.Data.t -> string Yocaml.Data.Validation.validated_value +(** A validator that ensure that a data is a string and apply [trim] and + [lowercase]. *) + +(** {1 Data helpers} *) + +val has_opt : 'a option -> Yocaml.Data.t +(** Transforms an option into [bool true] (if it exists) or [bool false] (if it + doesn't exist). *) + +val has_list : 'a list -> Yocaml.Data.t +(** Transforms a list into [bool true] (if it is not empty) or [bool false] (if + it is empty). *) diff --git a/lib/model/page.ml b/lib/model/page.ml new file mode 100644 index 0000000..7674060 --- /dev/null +++ b/lib/model/page.ml @@ -0,0 +1,24 @@ +open Model_util + +type t = { page_title : string option; description : string option } + +let entity_name = "Page" +let empty = { page_title = None; description = None } +let neutral = Ok { page_title = None; description = None } + +let validate_underlying_page fields = + let open Yocaml.Data.Validation in + let+ page_title = optional fields "page_title" string + and+ description = optional fields "description" string in + { page_title; description } + +let validate = Yocaml.Data.Validation.record validate_underlying_page + +let normalize { page_title; description } = + let open Yocaml.Data in + [ + ("has_page_title", has_opt page_title); + ("page_title", option string page_title); + ("has_description", has_opt description); + ("description", option string description); + ] diff --git a/lib/model/page.mli b/lib/model/page.mli new file mode 100644 index 0000000..045f4f0 --- /dev/null +++ b/lib/model/page.mli @@ -0,0 +1,14 @@ +(** Describes a generic page, mostly used on top of another model. *) + +type t +(** The type describing a page. *) + +val empty : t + +val validate_underlying_page : + (string * Yocaml.Data.t) list -> t Yocaml.Data.Validation.validated_record + +(** {1 Dealing as metadata} *) + +include Yocaml.Required.DATA_READABLE with type t := t +include Yocaml.Required.DATA_INJECTABLE with type t := t diff --git a/lib/model/url.ml b/lib/model/url.ml new file mode 100644 index 0000000..832663b --- /dev/null +++ b/lib/model/url.ml @@ -0,0 +1,51 @@ +type scheme = Http | Https | Gemini +type t = scheme * string + +let scheme_to_string = function + | Http -> "http" + | Https -> "https" + | Gemini -> "gemini" + +let scheme_to_prefix scheme = scheme_to_string scheme ^ "://" +let invalid_url given = Yocaml.Data.Validation.fail_with ~given "Invalid url" + +let validate_with_scheme scheme given = + let prefix = scheme_to_prefix scheme in + if String.starts_with ~prefix given then + try + let len = String.length prefix in + let gln = String.length given in + let rest = String.sub given len (gln - len) in + if String.length rest >= 3 then Ok (scheme, rest) else invalid_url given + with _ -> invalid_url given + else invalid_url given + +let validate = + let open Yocaml.Data.Validation in + string + & validate_with_scheme Http + / validate_with_scheme Https + / validate_with_scheme Gemini + +let equal_scheme a b = + match (a, b) with + | Http, Http | Https, Https | Gemini, Gemini -> true + | Http, _ | Https, _ | Gemini, _ -> false + +let equal (scheme_a, url_a) (scheme_b, url_b) = + equal_scheme scheme_a scheme_b && String.equal url_a url_b + +let to_string (scheme, url) = scheme_to_prefix scheme ^ url +let pp ppf url = Format.fprintf ppf "%s" @@ to_string url + +let normalize ((scheme, url) as full_url) = + let open Yocaml.Data in + record + [ + ("url", string @@ to_string full_url); + ("scheme", string @@ scheme_to_string scheme); + ("url_without_scheme", string url); + ] + +let scheme (s, _) = s +let url (_, u) = u diff --git a/lib/model/url.mli b/lib/model/url.mli new file mode 100644 index 0000000..100f2de --- /dev/null +++ b/lib/model/url.mli @@ -0,0 +1,36 @@ +(** A rather naive implementation of a validator for URLs (which simply checks + the existence of a scheme). In the near future, we will probably have to + relay on the {{:https://ocaml.org/p/uri/latest} URI} library. Currently, + prefix supported are: + - http + - https + - gemini (because of heyPlzLookAtMe) + + Once normalized, an url has this complicated shape (to give control on the + template side): + - [url]: the full url representation ([scheme + "://" + url]) + - [scheme] the scheme of the url ([Http | Https | Gemini]) + - [url_without_scheme] the url without the scheme. *) + +type scheme = Http | Https | Gemini + +type t +(** The type describing an url. *) + +val validate : Yocaml.Data.t -> t Yocaml.Data.Validation.validated_value +(** [validate data] validate an url from a {!type:Yocaml.Data.t} value. *) + +val normalize : t -> Yocaml.Data.t +(** [normalize url] serialize an url into a {!type:Yocaml.Data.t}. *) + +val pp : Format.formatter -> t -> unit +(** Pretty-printer for url. *) + +val to_string : t -> string +(** serialize an url into a string. *) + +val equal : t -> t -> bool +(** Equality between url. *) + +val scheme : t -> scheme +val url : t -> string diff --git a/test/gem/chain_test.ml b/test/gem/chain_test.ml index ede4897..0da0f23 100644 --- a/test/gem/chain_test.ml +++ b/test/gem/chain_test.ml @@ -1,3 +1,5 @@ +open Gem.Model + let make_member ident url = let open Yocaml.Data in ( ident, @@ -11,19 +13,17 @@ let m4 = make_member "m4" "https://vvv.lol" let make l = let chain, members = List.split l in - Yocaml.Data.Validation.list_of Gem.Model.Member.validate - (Yocaml.Data.list members) + Yocaml.Data.Validation.list_of Member.validate (Yocaml.Data.list members) |> Result.map (fun members -> (chain, members)) let from_list list = make list |> Result.map (fun (chain, members) -> - Gem.Chain.init ~chain ~members - |> Gem.Chain.fold + Chain.init ~chain ~members + |> Chain.fold (fun acc ~pred ~curr ~succ -> - Format.asprintf "%s\n%s [< %s | %s >]" acc - (Gem.Model.Member.id curr) (Gem.Model.Member.id pred) - (Gem.Model.Member.id succ)) + Format.asprintf "%s\n%s [< %s | %s >]" acc (Member.id curr) + (Member.id pred) (Member.id succ)) "") let%expect_test "Test with a regular chain" =