optolith/optolith-client
1
0
Fork 0
Code Issues Pull Requests 2 Actions Packages Projects Releases Wiki Activity

refactor: add complex sex options

Browse Source
This commit is contained in:
elyukai
2021-04-26 01:25:31 +02:00
parent 7d9d3ed449
commit 0b75d1e51f
12 changed files with 236 additions and 66 deletions
Download Patch File Download Diff File Expand all files Collapse all files
bsconfig.json
+2
View File
@@ -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" },
docs/Structure.md
+3 -1
View File
@@ -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.
src/Common/Id.ml
+8
View File
@@ -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
src/Common/Sex.ml
+105
View File
@@ -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
src/Common/Sex.mli
+33
View File
@@ -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
src/Localization/Locale.ml
+64
View File
@@ -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 *)
src/Utilities/Locale.mli → src/Localization/Locale.mli
+11 -8
View File
@@ -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. *) *)
src/Utilities/TranslationMap.ml → src/Localization/TranslationMap.ml
View File
src/Utilities/TranslationMap.mli → src/Localization/TranslationMap.mli
View File
src/Utilities/JsonStatic.ml
+5
View File
@@ -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
src/Utilities/JsonStatic.mli
+5 -1
View File
@@ -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]. *)
src/Utilities/Locale.ml
-56
View File
@@ -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 *)