From 0b75d1e51f51431cbb48143e8d5e765a1a3b195b Mon Sep 17 00:00:00 2001 From: elyukai Date: Mon, 26 Apr 2021 01:25:31 +0200 Subject: [PATCH] refactor: add complex sex options --- bsconfig.json | 2 + docs/Structure.md | 4 +- src/Common/Id.ml | 8 ++ src/Common/Sex.ml | 105 ++++++++++++++++++ src/Common/Sex.mli | 33 ++++++ src/Localization/Locale.ml | 64 +++++++++++ src/{Utilities => Localization}/Locale.mli | 19 ++-- .../TranslationMap.ml | 0 .../TranslationMap.mli | 0 src/Utilities/JsonStatic.ml | 5 + src/Utilities/JsonStatic.mli | 6 +- src/Utilities/Locale.ml | 56 ---------- 12 files changed, 236 insertions(+), 66 deletions(-) create mode 100644 src/Common/Id.ml create mode 100644 src/Common/Sex.ml create mode 100644 src/Common/Sex.mli create mode 100644 src/Localization/Locale.ml rename src/{Utilities => Localization}/Locale.mli (69%) rename src/{Utilities => Localization}/TranslationMap.ml (100%) rename src/{Utilities => Localization}/TranslationMap.mli (100%) delete mode 100644 src/Utilities/Locale.ml diff --git a/bsconfig.json b/bsconfig.json index 73049ea7..949bb1f7 100644 --- a/bsconfig.json +++ b/bsconfig.json @@ -3,6 +3,8 @@ "version": "0.1.0", "sources": [ { "dir": "src" }, + { "dir": "src/Common" }, + { "dir": "src/Localization" }, { "dir": "src/Rated" }, { "dir": "src/Rules" }, { "dir": "src/Sources" }, diff --git a/docs/Structure.md b/docs/Structure.md index d62c507c..55b82789 100644 --- a/docs/Structure.md +++ b/docs/Structure.md @@ -1,7 +1,9 @@ # Structure -- `src` – The source code. +- `src` – The source code main folder, containing program entry points. + - `Common` – Types and functions associated with multiple ‘namespaces’. - `Database` – The flat-file database containing all static data from the source books. + - `Localization` – Types and functions related to different languages in the app and the source books. - `Rated` – All data types for entries with *ratings* (attributes, skills or combat techniques) and related types and logic. - `Rules` – All data types for rule entries. - `Sources` – Types and functions dealing with data related to source books: Source books themselves, references, availability by book and errata. diff --git a/src/Common/Id.ml b/src/Common/Id.ml new file mode 100644 index 00000000..92b1a7fa --- /dev/null +++ b/src/Common/Id.ml @@ -0,0 +1,8 @@ +module ActivatableAndSkill = struct + type t = + | Advantage of int + | Disadvantage of int + | SpecialAbility of int + | Spell of int + | LiturgicalChant of int +end diff --git a/src/Common/Sex.ml b/src/Common/Sex.ml new file mode 100644 index 00000000..e58ee7b8 --- /dev/null +++ b/src/Common/Sex.ml @@ -0,0 +1,105 @@ +type binary_handling = { as_male : bool; as_female : bool } + +type t = + | Male + | Female + | BalThani of binary_handling + | Tsajana of binary_handling + | Custom of { binary_handling : binary_handling; name : string } + +type prerequisite = Male | Female + +let matches (sex : t) (prerequisite : prerequisite) = + match (prerequisite, sex) with + | Male, Male | Female, Female -> true + | Male, Female | Female, Male -> false + | Male, BalThani { as_male = as_sex; _ } + | Male, Tsajana { as_male = as_sex; _ } + | Male, Custom { binary_handling = { as_male = as_sex; _ }; _ } + | Female, BalThani { as_female = as_sex; _ } + | Female, Tsajana { as_female = as_sex; _ } + | Female, Custom { binary_handling = { as_female = as_sex; _ }; _ } -> + as_sex + +module Decode = struct + open Json.Decode + + let binary_handling json = + { + as_male = json |> field "as_male" bool; + as_female = json |> field "as_female" bool; + } + + let make = + oneOf + [ + string + |> map (function + | "Male" -> (Male : t) + | "Female" -> Female + | str -> + JsonStatic.raise_unknown_variant ~variant_name:"Sex" + ~invalid:str); + field "type" string + |> andThen (function + | "BalThani" -> + field "value" (field "binary_handling" binary_handling) + |> map (fun opt -> BalThani opt) + | "Tsajana" -> + field "value" (field "binary_handling" binary_handling) + |> map (fun opt -> Tsajana opt) + | "Custom" -> + field "value" (fun json -> + Custom + { + binary_handling = + json |> field "binary_handling" binary_handling; + name = json |> field "name" string; + }) + | str -> + JsonStatic.raise_unknown_variant ~variant_name:"Sex" + ~invalid:str); + ] + + let make_prerequisite = + string + |> map (function + | "Male" -> (Male : prerequisite) + | "Female" -> Female + | str -> + JsonStatic.raise_unknown_variant ~variant_name:"Sex" ~invalid:str) +end + +module Encode = struct + open Json.Encode + + let binary_handling { as_male; as_female } = + object_ [ ("as_male", bool as_male); ("as_female", bool as_female) ] + + let make (sex : t) = + match sex with + | Male -> string "Male" + | Female -> string "Female" + | BalThani bin -> + object_ + [ + ("type", string "BalThani"); + ("value", object_ [ ("binary_handling", binary_handling bin) ]); + ] + | Tsajana bin -> + object_ + [ + ("type", string "BalThani"); + ("value", object_ [ ("binary_handling", binary_handling bin) ]); + ] + | Custom { binary_handling = bin; name } -> + object_ + [ + ("type", string "BalThani"); + ( "value", + object_ + [ + ("binary_handling", binary_handling bin); ("name", string name); + ] ); + ] +end diff --git a/src/Common/Sex.mli b/src/Common/Sex.mli new file mode 100644 index 00000000..541f76d1 --- /dev/null +++ b/src/Common/Sex.mli @@ -0,0 +1,33 @@ +type binary_handling = { + as_male : bool; + (** Defines if the sex should be treated as male when checking prerequisites. *) + as_female : bool; + (** Defines if the sex should be treated as female when checking prerequisites. *) +} +(** Defines how a non-binary sex should be treated when checking prerequisites. *) + +(** A possible character's sex which may be binary or non-binary. If a sex is + non-binary, options how to handle binary prerequisites must be specified. *) +type t = + | Male + | Female + | BalThani of binary_handling + | Tsajana of binary_handling + | Custom of { binary_handling : binary_handling; name : string } + +(** A binary sex prerequisite*) +type prerequisite = Male | Female + +val matches : t -> prerequisite -> bool +(** [matches sex prerequisite] validates a binary sex prerequisite against a + character's sex. *) + +module Decode : sig + val make : t Json.Decode.decoder + + val make_prerequisite : prerequisite Json.Decode.decoder +end + +module Encode : sig + val make : t Json.Encode.encoder +end diff --git a/src/Localization/Locale.ml b/src/Localization/Locale.ml new file mode 100644 index 00000000..0ea27da5 --- /dev/null +++ b/src/Localization/Locale.ml @@ -0,0 +1,64 @@ +module Order = struct + type t = string list + + let from_list def xs = match xs with [] -> [ def ] | prefs -> prefs + + let to_list xs = xs + + let preferred = List.hd +end + +module Supported = struct + type t = { id : string; name : string; region : string } + + let system_locale_to_id supported_locales system_locale = + (system_locale |> Js.String.split "-" |> fun arr -> arr.(0)) + |> fun systemLocaleStart -> + StrMap.find + (fun { id; _ } -> Js.String.startsWith systemLocaleStart id) + supported_locales + |> Option.option "en-US" (fun locale -> locale.id) + + module Decode = struct + open Json.Decode + open JsonStrict + + type multilingual = { + id : string; + name : string; + region : string; + isMissingImplementation : bool option; + } + + let multilingual json = + { + id = json |> field "id" string; + name = json |> field "name" string; + region = json |> field "region" string; + isMissingImplementation = + json |> optionalField "isMissingImplementation" bool; + } + |> Option.ensure (fun { isMissingImplementation; _ } -> + Option.dis isMissingImplementation) + + let make_assoc json = + let open Option.Infix in + json |> multilingual <&> fun multilingual -> + ( multilingual.id, + { + id = multilingual.id; + name = multilingual.name; + region = multilingual.region; + } ) + + let make_strmap json = + json |> list make_assoc |> Option.catOptions |> StrMap.fromList + end +end + +(* let filterBySupported def supportedLocales order = + order + |> Ley_List.filter (Ley_Function.flip Ley_StrMap.member supportedLocales) + |> function + | [] -> [ def ] + | order -> order *) diff --git a/src/Utilities/Locale.mli b/src/Localization/Locale.mli similarity index 69% rename from src/Utilities/Locale.mli rename to src/Localization/Locale.mli index e39483a9..2bc5988b 100644 --- a/src/Utilities/Locale.mli +++ b/src/Localization/Locale.mli @@ -19,21 +19,24 @@ module Order : sig order of possible locales. *) end -(* module Supported : sig - type t = { id : string; name : string; region : string } - (** A language supported in Optolith. It's id is it's IETF language tag - (BCP47), and it features the languages name as well as the region name - defined in the standard. *) +module Supported : sig + type t = { + id : string; (** The IETF language tag (BCP47). *) + name : string; + region : string; + } + (** A language supported in Optolith. It features the language's identifier + and name as well as the region name defined in the BCP47 standard. *) - val systemLocaleToId : t Ley_StrMap.t -> string -> string + val system_locale_to_id : t StrMap.t -> string -> string (** Derive the default locale's id from the system locale's id. *) module Decode : sig - val map : t Ley_StrMap.t Json.Decode.decoder + val make_strmap : t StrMap.t Json.Decode.decoder end end -val filterBySupported : string -> Supported.t Ley_StrMap.t -> Order.t -> Order.t +(* val filterBySupported : string -> Supported.t Ley_StrMap.t -> Order.t -> Order.t (** [filterBySupported defaultLocale supportedLocales localeOrder] filters the order of locales set by the user by the locales that are supported. If this causes the order to be empty, a default locale will be used. *) *) diff --git a/src/Utilities/TranslationMap.ml b/src/Localization/TranslationMap.ml similarity index 100% rename from src/Utilities/TranslationMap.ml rename to src/Localization/TranslationMap.ml diff --git a/src/Utilities/TranslationMap.mli b/src/Localization/TranslationMap.mli similarity index 100% rename from src/Utilities/TranslationMap.mli rename to src/Localization/TranslationMap.mli diff --git a/src/Utilities/JsonStatic.ml b/src/Utilities/JsonStatic.ml index d24ba1bd..a26456cc 100644 --- a/src/Utilities/JsonStatic.ml +++ b/src/Utilities/JsonStatic.ml @@ -1 +1,6 @@ +let raise_unknown_variant ~variant_name ~invalid = + raise + (Json.Decode.DecodeError + ("Unknown variant tag of variant \"" ^ variant_name ^ "\": " ^ invalid)) + type 'a make_assoc = Locale.Order.t -> (int * 'a) option Json.Decode.decoder diff --git a/src/Utilities/JsonStatic.mli b/src/Utilities/JsonStatic.mli index b5e325d2..aedfc170 100644 --- a/src/Utilities/JsonStatic.mli +++ b/src/Utilities/JsonStatic.mli @@ -1,4 +1,8 @@ -(** Utility types for static data JSON decoders. *) +(** Utility types and functions for static data JSON decoders. *) + +val raise_unknown_variant : variant_name:string -> invalid:string -> 'a +(** Utility function for throwing an exception if a string is not part of a + variant. *) type 'a make_assoc = Locale.Order.t -> (int * 'a) option Json.Decode.decoder (** A decoder returning a pair that can be used to build an [IntMap]. *) diff --git a/src/Utilities/Locale.ml b/src/Utilities/Locale.ml deleted file mode 100644 index a9d0402d..00000000 --- a/src/Utilities/Locale.ml +++ /dev/null @@ -1,56 +0,0 @@ -module Order = struct - type t = string list - - let from_list def xs = match xs with [] -> [ def ] | prefs -> prefs - - let to_list xs = xs - - let preferred = List.hd -end - -(* module Supported = struct - type t = { id : string; name : string; region : string } - - module Decode = struct - type multilingual = { - id : string; - name : string; - region : string; - isMissingImplementation : bool option; - } - [@@decco] - - let makeAssoc multilingual = - match multilingual.isMissingImplementation with - | None | Some false -> - Some - ( multilingual.id, - { - id = multilingual.id; - name = multilingual.name; - region = multilingual.region; - } ) - | Some true -> None - - let assoc json = json |> multilingual_decode |. Belt.Result.map makeAssoc - - let map json = - Json.Decode.( - json |> list assoc |> Ley_Option.catOptions |> Ley_StrMap.fromList) - end - - let systemLocaleToId supportedLocales systemLocale = - (systemLocale |> Js.String.split "-" |> fun arr -> arr.(0)) - |> fun systemLocaleStart -> - Ley_StrMap.find - (fun { id; _ } -> Js.String.startsWith systemLocaleStart id) - supportedLocales - |> Ley_Option.option "en-US" (fun locale -> locale.id) -end - -let filterBySupported def supportedLocales order = - order - |> Ley_List.filter (Ley_Function.flip Ley_StrMap.member supportedLocales) - |> function - | [] -> [ def ] - | order -> order *)