From e8de83d6d9d2c20f6643a817b423d4807b06ceaa Mon Sep 17 00:00:00 2001
From: "Sean T. Allen" <sean@seantallen.com>
Date: Tue, 6 Feb 2024 20:49:41 +0000
Subject: [PATCH] Add constrained_types package to the standard library

Implements RFC 79.

https://github.com/ponylang/rfcs/blob/main/text/0079-constrained-types.md

Closes #4492
---
 packages/constrained_types/_test.pony         | 124 +++++++++++++++
 packages/constrained_types/constrained.pony   |  37 +++++
 .../constrained_types/constrained_types.pony  | 147 ++++++++++++++++++
 packages/stdlib/_test.pony                    |   2 +
 4 files changed, 310 insertions(+)
 create mode 100644 packages/constrained_types/_test.pony
 create mode 100644 packages/constrained_types/constrained.pony
 create mode 100644 packages/constrained_types/constrained_types.pony

diff --git a/packages/constrained_types/_test.pony b/packages/constrained_types/_test.pony
new file mode 100644
index 0000000000..ff93d39e3a
--- /dev/null
+++ b/packages/constrained_types/_test.pony
@@ -0,0 +1,124 @@
+use "pony_test"
+
+actor \nodoc\ Main is TestList
+  new create(env: Env) => PonyTest(env, this)
+  new make() => None
+
+  fun tag tests(test: PonyTest) =>
+    test(_TestFailureMultipleMessages)
+    test(_TestFailurePlumbingWorks)
+    test(_TestMultipleMessagesSanity)
+    test(_TestSuccessPlumbingWorks)
+
+class \nodoc\ iso _TestSuccessPlumbingWorks is UnitTest
+  """
+  Test that what should be a success, comes back as a success.
+  We are expecting to get a constrained type back.
+  """
+  fun name(): String => "constrained_types/SuccessPlumbingWorks"
+
+  fun ref apply(h: TestHelper) =>
+    let less: USize = 9
+
+    match MakeConstrained[USize, _LessThan10Validator](less)
+    | let s: Constrained[USize, _LessThan10Validator] =>
+      h.assert_true(true)
+    | let f: ValidationFailure =>
+      h.assert_true(false)
+    end
+
+class \nodoc\ iso _TestFailurePlumbingWorks is UnitTest
+  """
+  Test that what should be a failure, comes back as a failure.
+  This is a basic plumbing test.
+  """
+  fun name(): String => "constrained_types/FailurePlumbingWorks"
+
+  fun ref apply(h: TestHelper) =>
+    let more: USize = 11
+
+    match MakeConstrained[USize, _LessThan10Validator](more)
+    | let s: Constrained[USize, _LessThan10Validator] =>
+      h.assert_true(false)
+    | let f: ValidationFailure =>
+      h.assert_true(f.errors().size() == 1)
+      h.assert_array_eq[String](["not less than 10"], f.errors())
+    end
+
+class \nodoc\ iso _TestMultipleMessagesSanity is UnitTest
+  """
+  Sanity check that the _MultipleErrorsValidator works as expected and that
+  we can trust the _TestFailureMultipleMessages working results.
+  """
+  fun name(): String => "constrained_types/MultipleMessagesSanity"
+
+  fun ref apply(h: TestHelper) =>
+    let string = "magenta"
+
+    match MakeConstrained[String, _MultipleErrorsValidator](string)
+    | let s: Constrained[String, _MultipleErrorsValidator] =>
+      h.assert_true(true)
+    | let f: ValidationFailure =>
+      h.assert_true(false)
+    end
+
+class \nodoc\ iso _TestFailureMultipleMessages is UnitTest
+  """
+  Verify that collecting errors works as expected.
+  """
+  fun name(): String => "constrained_types/FailureMultipleMessages"
+
+  fun ref apply(h: TestHelper) =>
+    let string = "A1"
+
+    match MakeConstrained[String, _MultipleErrorsValidator](string)
+    | let s: Constrained[String, _MultipleErrorsValidator] =>
+      h.assert_true(false)
+    | let f: ValidationFailure =>
+      h.assert_true(f.errors().size() == 2)
+      h.assert_array_eq_unordered[String](
+        ["bad length"; "bad character"],
+        f.errors())
+    end
+
+primitive \nodoc\ _LessThan10Validator is Validator[USize]
+  fun apply(num: USize): ValidationResult =>
+    recover val
+      if num < 10 then
+        ValidationSuccess
+      else
+        ValidationFailure("not less than 10")
+      end
+    end
+
+primitive \nodoc\ _MultipleErrorsValidator is Validator[String]
+  fun apply(string: String): ValidationResult =>
+    recover val
+      let errors: Array[String] = Array[String]()
+
+      // Isn't too big or too small
+      if (string.size() < 6) or (string.size() > 12) then
+        let msg = "bad length"
+        errors.push(msg)
+      end
+
+      // Every character is valid
+      for c in string.values() do
+        if (c < 97) or (c > 122) then
+          errors.push("bad character")
+          break
+        end
+      end
+
+      if errors.size() == 0 then
+        ValidationSuccess
+      else
+        // We have some errors, let's package them all up
+        // and return the failure
+        let failure = ValidationFailure
+        for e in errors.values() do
+          failure(e)
+        end
+        failure
+      end
+    end
diff --git a/packages/constrained_types/constrained.pony b/packages/constrained_types/constrained.pony
new file mode 100644
index 0000000000..ef1495eaab
--- /dev/null
+++ b/packages/constrained_types/constrained.pony
@@ -0,0 +1,37 @@
+type ValidationResult is (ValidationSuccess | ValidationFailure)
+
+primitive ValidationSuccess
+
+class val ValidationFailure
+  let _errors: Array[String val] = _errors.create()
+
+  new create(e: (String val | None) = None) =>
+    match e
+    | let s: String val => _errors.push(s)
+    end
+
+  fun ref apply(e: String val) =>
+    _errors.push(e)
+
+  fun errors(): this->Array[String val] =>
+    _errors
+
+interface val Validator[T]
+  new val create()
+  fun apply(i: T): ValidationResult
+
+class val Constrained[T: Any val, F: Validator[T]]
+  let _value: T val
+
+  new val _create(value: T val) =>
+    _value = value
+
+  fun val apply(): T val =>
+    _value
+
+primitive MakeConstrained[T: Any val, F: Validator[T] val]
+  fun apply(value: T): (Constrained[T, F] | ValidationFailure) =>
+    match F(value)
+    | ValidationSuccess => Constrained[T, F]._create(value)
+    | let e: ValidationFailure => e
+    end
diff --git a/packages/constrained_types/constrained_types.pony b/packages/constrained_types/constrained_types.pony
new file mode 100644
index 0000000000..1261a557a3
--- /dev/null
+++ b/packages/constrained_types/constrained_types.pony
@@ -0,0 +1,147 @@
+"""
+# Constrained Types package
+
+The constrained types package provides a standard means for encoding domain constraints using the Pony type system.
+
+For example, in your applications domain, you have usernames that must be between 6 and 12 characters and can only contain lower case ASCII letters. The constrained types package allows you to express those constraints in the type system and assure that your usernames conform.
+
+The key user supplied component of constrained types is a `Validator`. A validator takes a base type and confirms that meets certain criteria. You then have a type of `Constrained[BaseType, ValidatedBy]` to enforce the constraint via the Pony type system.
+
+## Example
+
+For the sake of simplicity, let's represent a username as a constrained `String`. Here's a full Pony program that takes a potential username as a command line argument and validates whether is is acceptable as a username and if it is, prints the username. Note, that the "username printing" function will only take a valid username and there's no way to create a Username that doesn't involve going through the validation step:
+
+```pony
+use "constrained_types"
+
+actor Main
+  let _env: Env
+
+  new create(env: Env) =>
+    _env = env
+
+    try
+      let arg1 = env.args(1)?
+      let username = MakeUsername(arg1)
+      match username
+      | let u: Username =>
+        print_username(u)
+      | let e: ValidationFailure =>
+        print_errors(e)
+      end
+    end
+
+  fun print_username(username: Username) =>
+    _env.out.print(username() + " is a valid username!")
+
+  fun print_errors(errors: ValidationFailure) =>
+    _env.err.print("Unable to create username")
+    for s in errors.errors().values() do
+      _env.err.print("\t- " + s)
+    end
+
+type Username is Constrained[String, UsernameValidator]
+type MakeUsername is MakeConstrained[String, UsernameValidator]
+
+primitive UsernameValidator is Validator[String]
+  fun apply(string: String): ValidationResult =>
+    // We do all our work in a recover block so we
+    // can mutate any failure object before returning
+    // it as a `val`.
+    recover val
+      let errors: Array[String] = Array[String]()
+
+      // Isn't too big or too small
+      if (string.size() < 6) or (string.size() > 12) then
+        let msg = "Username must be between 6 and 12 characters"
+        errors.push(msg)
+      end
+
+      // Every character is valid
+      for c in string.values() do
+        if (c < 97) or (c > 122) then
+          errors.push("Username can only contain lower case ASCII characters")
+          break
+        end
+      end
+
+      // If no errors, return success
+      if errors.size() == 0 then
+        ValidationSuccess
+      else
+        // We have some errors, let's package them all up
+        // and return the failure
+        let failure = ValidationFailure
+        for e in errors.values() do
+          failure(e)
+        end
+        failure
+      end
+    end
+```
+
+## Discussion
+
+Let's dig into that code some:
+
+`type Username is Constrained[String, UsernameValidator]` defines a type `Username` that is `Constrained` type. `Constrained` is a generic type that takes two type arguments: the base type being constrained and the validator used to validate that base type conforms to our constraints. So, `Username` is an alias for a `String` that has been constrained using the `UsernameValidator`.
+
+`type MakeUsername is MakeConstrained[String, UsernameValidator]` is another type alias. It's a nice name for "constraint constructor" type `MakeConstrained`. Like `Constrained`, `MakeConstrained` takes the base type being constrained and the validator used.
+
+`primitive UsernameValidator is Validator[String]` is our validator for the `Username` type. It's single function `apply` takes a `String` and examines it returning either `ValidationSuccess` or `ValidationFailure`.
+
+On our usage side we have:
+
+```pony
+    let username = MakeUsername(arg1)
+    match username
+    | let u: Username =>
+      print_username(u)
+    | let e: ValidationFailure =>
+      print_errors(e)
+    end
+``
+
+Where we use the `MakeUsername` alias that we use to attempt to create a
+`Username` and get back either a `Username` or `ValidationFailure` that should
+have one ore more error messages for us to display.
+
+Finally, we have a function that can only be used with a valid `Username`:
+
+```pony
+fun print_username(username: Username) =>
+  _env.out.print(username() + " is a valid username!")
+```
+
+In a "real program", we would be doing more complicated things with our `Username` safe in the knowledge that it will always be between 6 and 12 characters and only contain lower case ASCII values.
+
+## Notes
+
+### `val` Entities only
+
+It is important to note that only `val` entities can be used with the
+constrained types package. If an entity was mutable, then it could be changed
+in a way that violates the constraints after it was validated. And that
+wouldn't be very useful.
+
+### Valdatior Requirements
+
+Because validators must:
+
+- Be `val`
+- Have a zero argument constructor that returns a `val` Validator
+
+We recommend using `primitive` for your validators although, using a class is supported. However, given that validators are required to be stateless, there is no advantage to using a `class` instead of a `primitive`.
+
+The `interface` for validators is:
+
+```pony
+interface val Validator[T]
+  new val create()
+  fun apply(i: T): ValidationResult
+```
+
+### Validators aren't Composable
+
+Also note, that unfortunately, there is no way with the Pony type system to be able to compose validators. You can't for example have a function that takes a "must be lower case" `String` and use a `Username` in place of it. We know that the `Username` type has been validated to be "only lower case strings", but there's no way to represent that in the type system.
+"""
diff --git a/packages/stdlib/_test.pony b/packages/stdlib/_test.pony
index 880538ddc4..a88a2fa04f 100644
--- a/packages/stdlib/_test.pony
+++ b/packages/stdlib/_test.pony
@@ -24,6 +24,7 @@ use capsicum = "capsicum"
 use cli = "cli"
 use collections = "collections"
 use collections_persistent = "collections/persistent"
+use constrained_types = "constrained_types"
 use debug = "debug"
 use files = "files"
 use format = "format"
@@ -57,6 +58,7 @@ actor \nodoc\ Main is TestList
     cli.Main.make().tests(test)
     collections.Main.make().tests(test)
     collections_persistent.Main.make().tests(test)
+    constrained_types.Main.make().tests(test)
     files.Main.make().tests(test)
     format.Main.make().tests(test)
     ini.Main.make().tests(test)