summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/input.ml36
-rw-r--r--lib/manifest.ml12
-rw-r--r--lib/name.ml2
-rw-r--r--lib/uTF8.ml28
4 files changed, 53 insertions, 25 deletions
diff --git a/lib/input.ml b/lib/input.ml
index 1aed440..b233292 100644
--- a/lib/input.ml
+++ b/lib/input.ml
@@ -8,7 +8,7 @@ type jg_models2 = string -> Jingoo.Jg_types.tvalue
module Template = struct
type t =
- Template of string
+ Template of UTF8.t
[@@unboxed]
[@@deriving show, eq, qcheck]
@@ -40,7 +40,7 @@ module Latest = struct
type t = {
cmd: Cmd.t option;
- value: string option;
+ value: UTF8.t option;
}
[@@deriving show, eq, make, qcheck]
end
@@ -66,8 +66,8 @@ end
module Git = struct
module Reference = struct
type t = [
- | `Branch of string
- | `Ref of string
+ | `Branch of UTF8.t
+ | `Ref of UTF8.t
]
[@@deriving show, eq, qcheck]
end
@@ -76,10 +76,10 @@ module Git = struct
repository: Template.t;
mirrors: Template.t list;
reference: Reference.t;
- datetime: string option; (* ISO 8601 RFC 3339 *)
+ datetime: UTF8.t option; (* ISO 8601 RFC 3339 *)
submodules: bool; [@default false]
lfs: bool; [@default false]
- latest_revision: string option;
+ latest_revision: UTF8.t option;
}
[@@deriving show, eq, make, qcheck]
@@ -99,14 +99,14 @@ end
module Darcs = struct
module Reference = struct
type context_grounds = [
- | `Assumed of string option
- | `Stated of string
+ | `Assumed of UTF8.t option
+ | `Stated of UTF8.t
]
[@@deriving show, eq, qcheck]
type t = [
| `Context of context_grounds
- | `Tag of string
+ | `Tag of UTF8.t
]
[@@deriving show, eq, qcheck]
end
@@ -115,8 +115,8 @@ module Darcs = struct
repository: Template.t;
mirrors: Template.t list;
reference: Reference.t;
- datetime: string option; (* ISO 8601 RFC 3339 *)
- latest_weak_hash: string option;
+ datetime: UTF8.t option; (* ISO 8601 RFC 3339 *)
+ latest_weak_hash: UTF8.t option;
}
[@@deriving show, eq, make, qcheck]
@@ -126,9 +126,9 @@ end
module Pijul = struct
module Reference = struct
type t = [
- | `Channel of string
- | `State of string
- | `Change of string
+ | `Channel of UTF8.t
+ | `State of UTF8.t
+ | `Change of UTF8.t
]
[@@deriving show, eq, qcheck]
end
@@ -137,8 +137,8 @@ module Pijul = struct
remote: Template.t;
mirrors: Template.t list;
reference: Reference.t;
- datetime: string option; (* ISO 8601 RFC 3339 *)
- latest_state: string option;
+ datetime: UTF8.t option; (* ISO 8601 RFC 3339 *)
+ latest_state: UTF8.t option;
}
[@@deriving show, eq, make, qcheck]
end
@@ -171,9 +171,9 @@ module Hash = struct
algorithm: algorithm;
[@default default_algorithm]
(* None is for not yet calculated *)
- value: string option;
+ value: UTF8.t option;
(* used to assert in fetching for manually-updated pins *)
- expected: string option;
+ expected: UTF8.t option;
}
[@@deriving show, eq, make, qcheck]
end
diff --git a/lib/manifest.ml b/lib/manifest.ml
index 179a753..a8cc965 100644
--- a/lib/manifest.ml
+++ b/lib/manifest.ml
@@ -371,7 +371,7 @@ end
module Hash = struct
type t = {
algorithm: Input.Hash.algorithm; [@default Input.Hash.default_algorithm]
- expected: string option;
+ expected: UTF8.t option;
}
[@@deriving show, eq, make, qcheck]
@@ -409,13 +409,13 @@ module Hash = struct
| Some av -> Ok (Some av)
| None ->
let len : int = Input.Hash.max_algorithm - Input.Hash.min_algorithm + 1
- and algo_str (i : int) : string =
+ and algo_str (i : int) : UTF8.t =
i + Input.Hash.min_algorithm
|> Input.Hash.algorithm_of_enum
|> Option.get
|> Input.Hash.algorithm_to_string
in
- let algo_str_list : string list = List.init len algo_str in
+ let algo_str_list : UTF8.t list = List.init len algo_str in
Logs.err (fun m ->
m
"Got hash algorithm “%s”, but exepected one of %a"
@@ -428,7 +428,7 @@ module Hash = struct
| Error (`Missing_prop "algorithm") -> ll @@ Ok !default_hash_algorithm
| Error err -> ll @@ Error err
- and+ expected : string option =
+ and+ expected : UTF8.t option =
ll @@
match hash.@(prop "expected") with
| Ok exp -> map Option.some @@ exp.@(string_value)
@@ -627,7 +627,7 @@ module Input' = struct
end
type t = {
- version: string;
+ version: UTF8.t;
inputs: Input'.t list;
}
[@@deriving show, eq, make, qcheck]
@@ -649,7 +649,7 @@ let document_to_t (doc : Kdl.t) : t Util.KDL.Valid.t =
Error errs
in
let () = default_hash_algorithm := manifest_default_hash_algorithm in
- let+ version : string =
+ let+ version : UTF8.t =
ll @@ doc.@(node "version" // arg 0 // string_value)
and+ inputs : Input'.t list =
(* TODO: a lens would mean this could use `each` *)
diff --git a/lib/name.ml b/lib/name.ml
index dfc338c..abf6e96 100644
--- a/lib/name.ml
+++ b/lib/name.ml
@@ -4,7 +4,7 @@
└─────────────────────────────────────────────────────────────────────────────*)
module Name = struct
type t =
- Name of string
+ Name of UTF8.t
[@@unboxed]
[@@deriving eq, qcheck]
diff --git a/lib/uTF8.ml b/lib/uTF8.ml
new file mode 100644
index 0000000..867046f
--- /dev/null
+++ b/lib/uTF8.ml
@@ -0,0 +1,28 @@
+(*─────────────────────────────────────────────────────────────────────────────┐
+│ SPDX-FileCopyrightText: 2025 toastal <https://toast.al/contact/> │
+│ SPDX-License-Identifier: LGPL-2.1-or-later WITH OCaml-LGPL-linking-exception │
+└─────────────────────────────────────────────────────────────────────────────*)
+(* Extending Camomile *)
+include Camomile.UTF8
+
+let equal a b = compare a b = 0
+
+let pp ppf str = Fmt.pf ppf "%s" str
+
+let gen_uchar : Camomile.UChar.t QCheck.Gen.t =
+ let open QCheck.Gen in
+ let* i =
+ oneof [
+ int_range 0 0xD7FF;
+ int_range 0xE000 0x10FFFF;
+ ];
+ in
+ return (Camomile.UChar.of_int i)
+
+let gen : t QCheck.Gen.t =
+ let open QCheck.Gen in
+ let* size = int_bound 40 in
+ let* chars = list_size (return size) gen_uchar in
+ let buf = Buf.create size in
+ List.iter (fun u -> Buf.add_char buf u) chars;
+ return (Buf.contents buf)