From 3af27545ef9260bd48b89ac244195349a9672724 Mon Sep 17 00:00:00 2001
From: Yann Hamdaoui <yann.hamdaoui@tweag.io>
Date: Wed, 19 Jun 2024 12:08:39 +0200
Subject: [PATCH 1/8] Add validator as a form of custom contract

---
 core/src/pretty.rs                | 32 ++++++++++++--------
 core/src/term/mod.rs              | 50 ++++++++++++++++++-------------
 core/src/transform/free_vars.rs   |  1 +
 core/src/typecheck/mk_uniftype.rs |  2 +-
 core/src/typecheck/mod.rs         | 48 +++++++++++++++++++++++++----
 5 files changed, 93 insertions(+), 40 deletions(-)

diff --git a/core/src/pretty.rs b/core/src/pretty.rs
index 9c4cad7a6f..2bb5175e05 100644
--- a/core/src/pretty.rs
+++ b/core/src/pretty.rs
@@ -142,7 +142,7 @@ fn needs_parens_in_type_pos(typ: &Type) -> bool {
             term.as_ref(),
             Term::Fun(..)
                 | Term::FunPattern(..)
-                | Term::CustomContract(CustomContract::Predicate(..))
+                | Term::CustomContract(_)
                 | Term::Let(..)
                 | Term::LetPattern(..)
                 | Term::Op1(UnaryOp::IfThenElse, _)
@@ -821,22 +821,28 @@ where
             Str(v) => allocator.escaped_string(v).double_quotes(),
             StrChunks(chunks) => allocator.chunks(chunks, StringRenderStyle::Multiline),
             Fun(id, body) => allocator.function(allocator.as_string(id), body),
-            CustomContract(ContractNode::PartialIdentity(ctr)) => docs![
-                allocator,
-                "%contract/custom%",
-                docs![allocator, allocator.line(), ctr.pretty(allocator).parens()]
+            // Format this as the primop application `<custom contract constructor> <contract impl>`.
+            CustomContract(contract_node) => {
+                let (constructor, contract) = match contract_node {
+                    ContractNode::Predicate(p) => ("%contract/from_predicate%", p),
+                    ContractNode::Validator(v) => ("%contract/from_validator%", v),
+                    ContractNode::PartialIdentity(pid) => ("%contract/custom%", pid),
+                };
+
+                docs![
+                    allocator,
+                    constructor,
+                    docs![
+                        allocator,
+                        allocator.line(),
+                        contract.pretty(allocator).parens()
+                    ]
                     .nest(2)
                     .group()
-            ],
+                ]
+            }
             FunPattern(pat, body) => allocator.function(allocator.pat_with_parens(pat), body),
             // Format this as the application `std.contract.from_predicate <pred>`.
-            CustomContract(ContractNode::Predicate(pred)) => docs![
-                allocator,
-                "%contract/from_predicate%",
-                docs![allocator, allocator.line(), pred.pretty(allocator).parens()]
-                    .nest(2)
-                    .group()
-            ],
             Lbl(_lbl) => allocator.text("%<label>").append(allocator.line()),
             Let(id, rt, body, attrs) => docs![
                 allocator,
diff --git a/core/src/term/mod.rs b/core/src/term/mod.rs
index 144c8b14a6..e1a827146a 100644
--- a/core/src/term/mod.rs
+++ b/core/src/term/mod.rs
@@ -216,23 +216,24 @@ pub enum Term {
     #[serde(skip)]
     Type(Type),
 
-    /// A custom contract built using e.g. `std.contract.from_predicate`. Currently, custom
-    /// contracts can be partial identities (the most general form, which either blame or return
-    /// the value with potential delayed checks buried inside) or a predicate. Ideally, both
-    /// would fall under then `CustomContract` node.
-    ///
-    /// Custom contracts built from `std.contract.custom` are stored in this node. Note that, for
-    /// backward compatibility, users can also use naked functions [Term::Fun] as a custom
-    /// contract. But this is discouraged and will be deprecated in the future.
-    ///
-    /// The reason for having a separate node is that we can leverage the metadata for example to
-    /// implement a restricted `or` combinator on contracts, which needs to know which contracts
-    /// are built from predicates, or for better error messages in the future when parametric
-    /// contracts aren't fully applied ([#1460](https://github.com/tweag/nickel/issues/1460)).
-    ///
-    /// Also, custom contracts aren't supposed to be applied using the standard function
-    /// application, because we need to perform additional bookkeeping upon application. So there's
-    /// no strong incentive to represent them as naked functions.
+    /// A custom contract built.
+    ///
+    /// Custom contracts can be partial identities (the most general form, which either blame or
+    /// return the value with potential delayed checks buried inside), predicates or validator (see
+    /// [CustomContract].
+    ///
+    /// Partial identity are built using `std.contract.custom`. Note that, for backward
+    /// compatibility, users can also use naked functions ([Term::Fun]) for partial identities
+    /// instead. But this is discouraged and will be deprecated in the future. Indeed, custom
+    /// contracts aren't supposed to be applied using the standard function application, because we
+    /// need to perform additional bookkeeping upon application, so there's no good reason to
+    /// represent them as naked functions.
+    ///
+    /// Having a separate node lets us leverage the additional information for example to implement
+    /// a restricted `or` combinator on contracts, which needs to know which contracts support
+    /// booleans operations (predicates and validators), or for better error messages in the future
+    /// when parametric contracts aren't fully applied
+    /// ([#1460](https://github.com/tweag/nickel/issues/1460)).
     #[serde(skip)]
     CustomContract(CustomContract),
 
@@ -401,12 +402,16 @@ pub enum BindingType {
 /// better error messages in some situations.
 #[derive(Debug, Clone, Serialize, Deserialize)]
 pub enum CustomContract {
-    /// A generic custom contract, represented as a partial identity function of type `Label -> Dyn
-    /// -> Dyn`.
-    PartialIdentity(RichTerm),
     /// A contract built from a predicate. The argument is a function of type
     /// `Dyn -> Bool`.
     Predicate(RichTerm),
+    /// A contract built from a validator. A validator is a function of type `Dyn -> [| 'Ok, 'Error
+    /// ReifiedLabel |}` where `ReifiedLabel` is a record with error reporting data (a message,
+    /// notes, etc.)
+    Validator(RichTerm),
+    /// A generic custom contract, represented as a partial identity function of type `Label -> Dyn
+    /// -> Dyn`.
+    PartialIdentity(RichTerm),
 }
 
 /// A runtime representation of a contract, as a term and a label ready to be applied via
@@ -2109,6 +2114,10 @@ impl Traverse<RichTerm> for RichTerm {
                 let t = t.traverse(f, order)?;
                 RichTerm::new(Term::CustomContract(CustomContract::Predicate(t)), pos)
             }
+            Term::CustomContract(CustomContract::Validator(t)) => {
+                let t = t.traverse(f, order)?;
+                RichTerm::new(Term::CustomContract(CustomContract::Validator(t)), pos)
+            }
             Term::CustomContract(CustomContract::PartialIdentity(t)) => {
                 let t = t.traverse(f, order)?;
                 RichTerm::new(
@@ -2308,6 +2317,7 @@ impl Traverse<RichTerm> for RichTerm {
             Term::Fun(_, t)
             | Term::FunPattern(_, t)
             | Term::CustomContract(CustomContract::Predicate(t))
+            | Term::CustomContract(CustomContract::Validator(t))
             | Term::CustomContract(CustomContract::PartialIdentity(t))
             | Term::EnumVariant { arg: t, .. }
             | Term::Op1(_, t)
diff --git a/core/src/transform/free_vars.rs b/core/src/transform/free_vars.rs
index da4ab2cb6b..06a687ebc2 100644
--- a/core/src/transform/free_vars.rs
+++ b/core/src/transform/free_vars.rs
@@ -110,6 +110,7 @@ impl CollectFreeVars for RichTerm {
             | Term::Sealed(_, t, _)
             | Term::EnumVariant { arg: t, .. }
             | Term::CustomContract(CustomContract::Predicate(t))
+            | Term::CustomContract(CustomContract::Validator(t))
             | Term::CustomContract(CustomContract::PartialIdentity(t)) => {
                 t.collect_free_vars(free_vars)
             }
diff --git a/core/src/typecheck/mk_uniftype.rs b/core/src/typecheck/mk_uniftype.rs
index 5208be0d4d..f031f05e16 100644
--- a/core/src/typecheck/mk_uniftype.rs
+++ b/core/src/typecheck/mk_uniftype.rs
@@ -21,7 +21,7 @@ macro_rules! mk_uty_arrow {
 /// Multi-ary enum row constructor for types implementing `Into<TypeWrapper>`.
 /// `mk_uty_enum_row!(id1, .., idn; tail)` correspond to `[| 'id1, .., 'idn; tail |]. With the
 /// addition of algebraic data types (enum variants), individual rows can also take an additional
-/// type parameter, specificed as a tuple: for example, `mk_uty_enum_row!(id1, (id2, ty2); tail)`
+/// type parameter, specified as a tuple: for example, `mk_uty_enum_row!(id1, (id2, ty2); tail)`
 /// is `[| 'id1, 'id2 ty2; tail |]`.
 #[macro_export]
 macro_rules! mk_uty_enum_row {
diff --git a/core/src/typecheck/mod.rs b/core/src/typecheck/mod.rs
index c86e49bdd4..41cd27d8ad 100644
--- a/core/src/typecheck/mod.rs
+++ b/core/src/typecheck/mod.rs
@@ -1600,8 +1600,9 @@ fn walk<V: TypecheckVisitor>(
         Term::EnumVariant { arg: t, ..}
         | Term::Sealed(_, t, _)
         | Term::Op1(_, t)
-        | Term::CustomContract(CustomContract::Predicate(t)) | Term::CustomContract(CustomContract::PartialIdentity(t))
-        => walk(state, ctxt.clone(), visitor, t),
+        | Term::CustomContract(CustomContract::Predicate(t))
+        | Term::CustomContract(CustomContract::Validator(t))
+        | Term::CustomContract(CustomContract::PartialIdentity(t)) => walk(state, ctxt.clone(), visitor, t),
         Term::Op2(_, t1, t2) => {
             walk(state, ctxt.clone(), visitor, t1)?;
             walk(state, ctxt, visitor, t2)
@@ -1925,7 +1926,7 @@ fn check<V: TypecheckVisitor>(
         // Additionally, because this rule can't produce a polymorphic type (it produces a `Dyn`,
         // or morally a `Contract` type, if we had one), we don't lose anything by making it a
         // check rule, as for e.g. literals.
-        Term::CustomContract(CustomContract::Predicate(body)) => {
+        Term::CustomContract(CustomContract::Predicate(t)) => {
             // The overall type of a custom contract is currently `Dyn`, as we don't have a better
             // one.
             ty.unify(mk_uniftype::dynamic(), state, &ctxt)
@@ -1936,13 +1937,48 @@ fn check<V: TypecheckVisitor>(
                 state,
                 ctxt,
                 visitor,
-                body,
+                t,
                 mk_uniftype::arrow(mk_uniftype::dynamic(), mk_uniftype::bool()),
             )
         }
+        Term::CustomContract(CustomContract::Validator(t)) => {
+            // The overall type of a custom contract is currently `Dyn`, as we don't have a better
+            // one.
+            ty.unify(mk_uniftype::dynamic(), state, &ctxt)
+                .map_err(|err| err.into_typecheck_err(state, rt.pos))?;
+
+            // A validator must be of type `Dyn -> [| 'Ok, 'Error _SomeType |]` where `_SomeType`
+            // is the type of a reified label. For now, we use a more restrictive static type `[|
+            // 'Ok, 'Error {message : String, notes : Array String} |]` (in practice the `notes`
+            // are optional). We can always relax this type later.
+            //
+            // Also remember that custom contracts shouldn't appear directly in the source code of
+            // Nickel: they are built using `std.contract.from_xxx` and `std.contract.custom`
+            // functions. We implement typechecking for them mostly because we can (to avoid an
+            // `unimplemented!` or a `panic!`), but we don't expect this case to trigger at the
+            // moment, so it's of the utmost importance.
+            let codom = mk_uty_enum!(
+                "Ok",
+                (
+                    "Error",
+                    mk_uty_record!(
+                        ("message", mk_uniftype::str()),
+                        ("notes", mk_uniftype::array(mk_uniftype::str()))
+                    )
+                )
+            );
+
+            check(
+                state,
+                ctxt,
+                visitor,
+                t,
+                mk_uniftype::arrow(mk_uniftype::dynamic(), codom),
+            )
+        }
         // See [^predicate-is-check]. We took `Predicate` as an example, but this reasoning applies
         // to other kind of custom contracts, such as `PartialIdentity`.
-        Term::CustomContract(CustomContract::PartialIdentity(body)) => {
+        Term::CustomContract(CustomContract::PartialIdentity(t)) => {
             // The overall type of a custom contract is currently `Dyn`, as we don't have a better
             // one.
             ty.unify(mk_uniftype::dynamic(), state, &ctxt)
@@ -1956,7 +1992,7 @@ fn check<V: TypecheckVisitor>(
                 mk_uniftype::dynamic()
             );
 
-            check(state, ctxt, visitor, body, partial_id_type)
+            check(state, ctxt, visitor, t, partial_id_type)
         }
         Term::Array(terms, _) => {
             let ty_elts = state.table.fresh_type_uvar(ctxt.var_level);

From d125550011da1b1b2e4302d257ddbfb487347442 Mon Sep 17 00:00:00 2001
From: Yann Hamdaoui <yann.hamdaoui@tweag.io>
Date: Wed, 19 Jun 2024 13:45:55 +0200
Subject: [PATCH 2/8] Support validators in %contract/apply%

---
 core/src/eval/operation.rs |  5 +++++
 core/src/stdlib.rs         |  1 +
 core/stdlib/internals.ncl  | 42 +++++++++++++++++++++++++++++---------
 3 files changed, 38 insertions(+), 10 deletions(-)

diff --git a/core/src/eval/operation.rs b/core/src/eval/operation.rs
index a9e0e88e92..e89dc668f2 100644
--- a/core/src/eval/operation.rs
+++ b/core/src/eval/operation.rs
@@ -1588,6 +1588,11 @@ impl<R: ImportResolver, C: Cache> VirtualMachine<R, C> {
                                 .with_pos(pos1),
                             env: env1,
                         }),
+                        Term::CustomContract(CustomContract::Validator(validator)) => Ok(Closure {
+                            body: mk_app!(internals::validator_to_ctr(), validator.clone())
+                                .with_pos(pos1),
+                            env: env1,
+                        }),
                         Term::Record(..) => {
                             let closurized = RichTerm {
                                 term: t1,
diff --git a/core/src/stdlib.rs b/core/src/stdlib.rs
index 1eb6b7b0e1..ed4e6a5d42 100644
--- a/core/src/stdlib.rs
+++ b/core/src/stdlib.rs
@@ -103,6 +103,7 @@ pub mod internals {
     generate_accessor!(stdlib_contract_equal);
 
     generate_accessor!(predicate_to_ctr);
+    generate_accessor!(validator_to_ctr);
 
     generate_accessor!(rec_default);
     generate_accessor!(rec_force);
diff --git a/core/stdlib/internals.ncl b/core/stdlib/internals.ncl
index 41d8a35288..9f7a82f5d3 100644
--- a/core/stdlib/internals.ncl
+++ b/core/stdlib/internals.ncl
@@ -281,15 +281,37 @@
     else
       %blame% label,
 
-  # Recursive priorities operators
+  # Take a contract as a validator, built using %contract/from_validator%, and
+  # turn it into a generic custom contract (a partial identity Label -> Dyn ->
+  # Dyn) that can be passed to %contract/apply%.
+  "$validator_to_ctr" = fun validator label value =>
+    validator
+    |> match {
+      'Ok => value,
+      'Error { message, notes ? [], .. } =>
+        %blame% (%label/with_message% message (%label/with_notes% notes label)),
+      # Any other value than 'Ok leads to blame. We don't want to silently
+      # accept values if the validator is ill-formed
+      _ =>
+        %blame%
+          (
+            %label/with_notes%
+              [
+                "The validator for this contract returned an invalid result (which must be either `'Ok` or `'Error {message, ..}`)"
+                  "Please check the implementation of the contract that has been broken"
+              )
+              label,
+        },
+
+      # Recursive priorities operators
 
-  "$rec_force" = fun value => %rec_force% (%force% value),
-  "$rec_default" = fun value => %rec_default% (%force% value),
+      "$rec_force" = fun value => %rec_force% (%force% value),
+      "$rec_default" = fun value => %rec_default% (%force% value),
 
-  # Provide access to std.contract.Equal within the initial environement. Merging
-  # makes use of `std.contract.Equal`, but it can't blindly substitute such an
-  # expression, because `contract` might have been redefined locally. Putting it
-  # in an internal value prefixed with `$` makes it accessible from the initial
-  # environment and prevents it from being shadowed.
-  "$stdlib_contract_equal" = std.contract.Equal,
-}
+      # Provide access to std.contract.Equal within the initial environement. Merging
+      # makes use of `std.contract.Equal`, but it can't blindly substitute such an
+      # expression, because `contract` might have been redefined locally. Putting it
+      # in an internal value prefixed with `$` makes it accessible from the initial
+      # environment and prevents it from being shadowed.
+      "$stdlib_contract_equal" = std.contract.Equal,
+    }

From a346fa1bb6775196a7f994ac1065ff076bf92882 Mon Sep 17 00:00:00 2001
From: Yann Hamdaoui <yann.hamdaoui@tweag.io>
Date: Wed, 19 Jun 2024 18:16:10 +0200
Subject: [PATCH 3/8] Add from_validator primop and stdlib function

---
 core/src/eval/operation.rs      | 19 ++++++++
 core/src/parser/grammar.lalrpop |  2 +
 core/src/parser/lexer.rs        |  2 +
 core/src/term/mod.rs            |  5 ++
 core/src/typecheck/mod.rs       | 29 +-----------
 core/src/typecheck/operation.rs | 31 +++++++++++++
 core/stdlib/internals.ncl       | 60 ++++++++++++++++--------
 core/stdlib/std.ncl             | 82 ++++++++++++++++++++++++++++-----
 8 files changed, 170 insertions(+), 60 deletions(-)

diff --git a/core/src/eval/operation.rs b/core/src/eval/operation.rs
index e89dc668f2..ae787df58a 100644
--- a/core/src/eval/operation.rs
+++ b/core/src/eval/operation.rs
@@ -1214,6 +1214,25 @@ impl<R: ImportResolver, C: Cache> VirtualMachine<R, C> {
                     ))
                 }
             }
+            UnaryOp::ContractFromValidator => {
+                if matches!(&*t, Term::Fun(..) | Term::Match(_)) {
+                    Ok(Closure {
+                        body: RichTerm::new(
+                            Term::CustomContract(CustomContract::Validator(RichTerm {
+                                term: t,
+                                pos,
+                            })),
+                            pos,
+                        ),
+                        env,
+                    })
+                } else {
+                    Err(mk_type_error!(
+                        "contract/from_validator",
+                        "Function or MatchExpression"
+                    ))
+                }
+            }
             UnaryOp::ContractCustom => {
                 if matches!(&*t, Term::Fun(..) | Term::Match(_)) {
                     Ok(Closure {
diff --git a/core/src/parser/grammar.lalrpop b/core/src/parser/grammar.lalrpop
index 8eb00a4d74..a937d5fd36 100644
--- a/core/src/parser/grammar.lalrpop
+++ b/core/src/parser/grammar.lalrpop
@@ -1082,6 +1082,7 @@ UOp: UnaryOp = {
     "label/go_array" => UnaryOp::LabelGoArray,
     "label/go_dict" => UnaryOp::LabelGoDict,
     "contract/from_predicate" => UnaryOp::ContractFromPredicate,
+    "contract/from_validator" => UnaryOp::ContractFromValidator,
     "contract/custom" => UnaryOp::ContractCustom,
     "enum/embed" <Ident> => UnaryOp::EnumEmbed(<>),
     "array/map"  => UnaryOp::ArrayMap,
@@ -1515,6 +1516,7 @@ extern {
         "contract/array_lazy_app" => Token::Normal(NormalToken::ContractArrayLazyApp),
         "contract/record_lazy_app" => Token::Normal(NormalToken::ContractRecordLazyApp),
         "contract/from_predicate" => Token::Normal(NormalToken::ContractFromPredicate),
+        "contract/from_validator" => Token::Normal(NormalToken::ContractFromValidator),
         "contract/custom" => Token::Normal(NormalToken::ContractCustom),
         "op force" => Token::Normal(NormalToken::OpForce),
         "blame" => Token::Normal(NormalToken::Blame),
diff --git a/core/src/parser/lexer.rs b/core/src/parser/lexer.rs
index 94c0c7daff..b0bbae2e69 100644
--- a/core/src/parser/lexer.rs
+++ b/core/src/parser/lexer.rs
@@ -202,6 +202,8 @@ pub enum NormalToken<'input> {
     ContractRecordLazyApp,
     #[token("%contract/from_predicate%")]
     ContractFromPredicate,
+    #[token("%contract/from_validator%")]
+    ContractFromValidator,
     #[token("%contract/custom%")]
     ContractCustom,
     #[token("%blame%")]
diff --git a/core/src/term/mod.rs b/core/src/term/mod.rs
index e1a827146a..43ff9cfebd 100644
--- a/core/src/term/mod.rs
+++ b/core/src/term/mod.rs
@@ -1314,6 +1314,10 @@ pub enum UnaryOp {
     /// a type constructor for custom contracts.
     ContractFromPredicate,
 
+    /// Wrap a validator function as a [CustomContract]. You can think of this primop as a type
+    /// constructor for custom contracts.
+    ContractFromValidator,
+
     /// Wrap a partial identity function as a [CustomContract]. You can think of this primop as a
     /// type constructor for contracts.
     ContractCustom,
@@ -1529,6 +1533,7 @@ impl fmt::Display for UnaryOp {
             LabelGoArray => write!(f, "label/go_array"),
             LabelGoDict => write!(f, "label/go_dict"),
             ContractFromPredicate => write!(f, "contract/from_predicate"),
+            ContractFromValidator => write!(f, "contract/from_validator"),
             ContractCustom => write!(f, "contract/custom"),
             Seq => write!(f, "seq"),
             DeepSeq => write!(f, "deep_seq"),
diff --git a/core/src/typecheck/mod.rs b/core/src/typecheck/mod.rs
index 41cd27d8ad..599ba9a178 100644
--- a/core/src/typecheck/mod.rs
+++ b/core/src/typecheck/mod.rs
@@ -1947,34 +1947,7 @@ fn check<V: TypecheckVisitor>(
             ty.unify(mk_uniftype::dynamic(), state, &ctxt)
                 .map_err(|err| err.into_typecheck_err(state, rt.pos))?;
 
-            // A validator must be of type `Dyn -> [| 'Ok, 'Error _SomeType |]` where `_SomeType`
-            // is the type of a reified label. For now, we use a more restrictive static type `[|
-            // 'Ok, 'Error {message : String, notes : Array String} |]` (in practice the `notes`
-            // are optional). We can always relax this type later.
-            //
-            // Also remember that custom contracts shouldn't appear directly in the source code of
-            // Nickel: they are built using `std.contract.from_xxx` and `std.contract.custom`
-            // functions. We implement typechecking for them mostly because we can (to avoid an
-            // `unimplemented!` or a `panic!`), but we don't expect this case to trigger at the
-            // moment, so it's of the utmost importance.
-            let codom = mk_uty_enum!(
-                "Ok",
-                (
-                    "Error",
-                    mk_uty_record!(
-                        ("message", mk_uniftype::str()),
-                        ("notes", mk_uniftype::array(mk_uniftype::str()))
-                    )
-                )
-            );
-
-            check(
-                state,
-                ctxt,
-                visitor,
-                t,
-                mk_uniftype::arrow(mk_uniftype::dynamic(), codom),
-            )
+            check(state, ctxt, visitor, t, operation::validator_type())
         }
         // See [^predicate-is-check]. We took `Predicate` as an example, but this reasoning applies
         // to other kind of custom contracts, such as `PartialIdentity`.
diff --git a/core/src/typecheck/operation.rs b/core/src/typecheck/operation.rs
index feacb42c9f..b7ac3841a0 100644
--- a/core/src/typecheck/operation.rs
+++ b/core/src/typecheck/operation.rs
@@ -86,6 +86,9 @@ pub fn get_uop_type(
             mk_uniftype::dynamic(),
         ),
         // Morally returns a contract, but we don't have a proper type for that yet
+        // <validator_type()> -> Dyn (see `validator_type()` below for more details)
+        UnaryOp::ContractFromValidator => (validator_type(), mk_uniftype::dynamic()),
+        // Morally returns a contract, but we don't have a proper type for that yet
         // (Dyn -> Dyn -> Bool) -> Dyn
         UnaryOp::ContractCustom => (
             mk_uty_arrow!(
@@ -562,3 +565,31 @@ pub fn get_nop_type(
         ),
     })
 }
+
+/// Return the type of a validator, which is one way of representing a custom contract. This static
+/// type is more rigid than the actual values accepted by `std.contract.from_validator`, because we
+/// can't represent optional fields in the type system. But it's ok to be stricter in statically
+/// typed code.
+///
+/// Also remember that custom contracts shouldn't appear directly in the source code of Nickel:
+/// they are built using `std.contract.from_xxx` and `std.contract.custom` functions. We implement
+/// typechecking for them mostly because we can (to avoid an `unimplemented!` or a `panic!`), but
+/// we don't expect this case to trigger at the moment, so it's of the utmost importance.
+///
+/// The result represents the type `Dyn -> [| 'Ok, 'Error { message: String, notes: Array
+/// String } |]`.
+pub fn validator_type() -> UnifType {
+    mk_uty_arrow!(
+        mk_uniftype::dynamic(),
+        mk_uty_enum!(
+            "Ok",
+            (
+                "Error",
+                mk_uty_record!(
+                    ("message", mk_uniftype::str()),
+                    ("notes", mk_uniftype::array(mk_uniftype::str()))
+                )
+            )
+        )
+    )
+}
diff --git a/core/stdlib/internals.ncl b/core/stdlib/internals.ncl
index 9f7a82f5d3..4365e7568b 100644
--- a/core/stdlib/internals.ncl
+++ b/core/stdlib/internals.ncl
@@ -285,33 +285,53 @@
   # turn it into a generic custom contract (a partial identity Label -> Dyn ->
   # Dyn) that can be passed to %contract/apply%.
   "$validator_to_ctr" = fun validator label value =>
-    validator
+    validator value
     |> match {
       'Ok => value,
-      'Error { message, notes ? [], .. } =>
-        %blame% (%label/with_message% message (%label/with_notes% notes label)),
-      # Any other value than 'Ok leads to blame. We don't want to silently
-      # accept values if the validator is ill-formed
+      'Error { message ? null, notes ? [], .. } =>
+        let label =
+          if message != null && std.is_string message then
+            %label/with_message% message label
+          else
+            label
+        in
+
+        let label =
+          if notes != [] && std.is_array notes then
+            %label/with_notes% (%force% notes) label
+          else
+            label
+        in
+
+        %blame% label,
+      # The contract of `std.contract.from_validator` should guarantee that we
+      # never reach this case. However, nothing prevents user from using
+      # `%contract/from_validator%` directly, so we still try to handle a
+      # misbehaving validator gracefully.
       _ =>
         %blame%
           (
             %label/with_notes%
-              [
-                "The validator for this contract returned an invalid result (which must be either `'Ok` or `'Error {message, ..}`)"
-                  "Please check the implementation of the contract that has been broken"
+              (
+                %force%
+                  [
+                    "The validator for this contract returned an invalid result (which must be either `'Ok` or `'Error {message, ..}`)"
+                      "Please check the implementation of the contract that has been broken"
+                  ]
               )
-              label,
-        },
+              label
+          )
+    },
 
-      # Recursive priorities operators
+  # Recursive priorities operators
 
-      "$rec_force" = fun value => %rec_force% (%force% value),
-      "$rec_default" = fun value => %rec_default% (%force% value),
+  "$rec_force" = fun value => %rec_force% (%force% value),
+  "$rec_default" = fun value => %rec_default% (%force% value),
 
-      # Provide access to std.contract.Equal within the initial environement. Merging
-      # makes use of `std.contract.Equal`, but it can't blindly substitute such an
-      # expression, because `contract` might have been redefined locally. Putting it
-      # in an internal value prefixed with `$` makes it accessible from the initial
-      # environment and prevents it from being shadowed.
-      "$stdlib_contract_equal" = std.contract.Equal,
-    }
+  # Provide access to std.contract.Equal within the initial environement. Merging
+  # makes use of `std.contract.Equal`, but it can't blindly substitute such an
+  # expression, because `contract` might have been redefined locally. Putting it
+  # in an internal value prefixed with `$` makes it accessible from the initial
+  # environment and prevents it from being shadowed.
+  "$stdlib_contract_equal" = std.contract.Equal,
+}
diff --git a/core/stdlib/std.ncl b/core/stdlib/std.ncl
index f033240d4a..12ab59f8f6 100644
--- a/core/stdlib/std.ncl
+++ b/core/stdlib/std.ncl
@@ -1,4 +1,4 @@
-# Nickel standrd library. This file is included at compile-time in the nickel
+# Nickel standard library. This file is included at compile-time in the nickel
 # binary and populates the `std` entry in the initial environment.
 #
 # It would be nice to split this module file into separate files, such as
@@ -1006,12 +1006,10 @@
       = fun message label => %blame% (%label/with_message% message label),
 
     custom
+      : (Dyn -> Dyn -> Dyn) -> Dyn
       | doc m%"
           Build a generic custom contract.
 
-          Type: `(Dyn -> Dyn -> Dyn) -> Contract`
-          (for technical reasons, this function isn't actually statically typed)
-
           # Custom contract
 
           In general, you should use more specific contract constructors
@@ -1026,11 +1024,18 @@
           parameters and apply them (using `std.contract.apply`).
 
           Custom contracts built using `std.contract.custom` are the most
-          general form of custom contracts. They take a label and a value as
-          parameters, and either blame the label or return the original value
-          with potential delayed checks pushed inside. For more details on
-          custom contracts, please refer to the corresponding section of the
-          user manual.
+          general form of custom contracts. The implementation given as an
+          argument must be a function taking a label and a value as parameters,
+          and either blame the label or return the original value with potential
+          delayed checks pushed inside. For more details on custom contracts,
+          please refer to the corresponding section of the user manual.
+
+          # Typing
+
+          Because Nickel doesn't currently have proper types for labels and
+          contracts, they are replaced with `Dyn` in the type signature. You can
+          think of the actual type of `custom` as `(Label -> Dyn -> Dyn) ->
+          Contract`.
 
           # Examples
 
@@ -1050,12 +1055,10 @@
       = fun custom => %contract/custom% custom,
 
     from_predicate
+      : (Dyn -> Bool) -> Dyn
       | doc m%"
           Build a custom contract from a boolean predicate.
 
-          Type: `(Dyn -> Bool) -> Contract`
-          (for technical reasons, this function isn't actually statically typed)
-
           # Contract application
 
           Before Nickel 1.8, `from_predicate` used to wrap the predicate as a
@@ -1071,6 +1074,13 @@
           `std.contract.apply` or other operations on contracts, but can't be
           used as normal function anymore.
 
+          # Typing
+
+          Because Nickel doesn't currently have proper types for contracts, the
+          return type of `from_predicate` is simply `Dyn` in the type signature.
+          You should think of `from_predicate` as some returning a value of some
+          hypothetical type `Contract`.
+
           # Examples
 
           ```nickel
@@ -1080,6 +1090,54 @@
         "%
       = fun pred => %contract/from_predicate% pred,
 
+    from_validator
+      | (
+        Dyn -> [|
+          'Ok,
+          'Error { message | String | optional, notes | Array String | optional }
+        |]
+      ) -> Dyn
+      | doc m%%"
+          Build a custom contract from a validator.
+
+          # Validator
+
+          A validator is a function returning either `'Ok` or `'Error
+          {message, notes}` with an optional error message and notes to
+          display. A validator is similar to a predicate (see
+          `std.contract.from_predicate`) as both are contract implementations
+          that must decide right away if the value passes or fails (that is,
+          those contracts aren't lazy). But as opposed to predicates, but
+          validators have the additional ability to customize the error
+          reporting.
+
+          # Typing
+
+          Because Nickel doesn't currently have proper types for contracts, the
+          return type of `from_validator` is simply `Dyn` in the type signature.
+          You should think of `from_validator` as some returning a value of some
+          hypothetical type `Contract`.
+
+          # Examples
+
+          ```nickel
+          let IsZero = std.contract.from_validator (match {
+            0 => 'Ok,
+            n if std.is_number n =>
+              'Error {
+                message = "expected 0, got %{std.to_string n}",
+                notes = ["The value is a number, but it isn't 0"],
+              },
+            v =>
+              let vtype = v |> std.typeof |> std.to_string in
+              'Error { message = "expected a number, got a %{vtype}" }
+          })
+          in
+          0 | IsZero
+          ```
+        "%%
+      = fun validator => %contract/from_validator% validator,
+
     Sequence
       | doc m%"
           Apply multiple contracts from left to right.

From f6a1ad122ffbf62fbb739111172a2bbc4c6faa5b Mon Sep 17 00:00:00 2001
From: Yann Hamdaoui <yann.hamdaoui@tweag.io>
Date: Wed, 19 Jun 2024 18:16:52 +0200
Subject: [PATCH 4/8] Add tests for custom contract constructors

---
 .../inputs/errors/validator_custom_error.ncl      | 12 ++++++++++++
 ...t__eval_stderr_validator_custom_error.ncl.snap | 15 +++++++++++++++
 .../inputs/contracts/custom_generic_fail.ncl      |  6 ++++++
 .../inputs/contracts/custom_generic_succeed.ncl   |  3 +++
 .../inputs/contracts/custom_predicate_fail.ncl    |  6 ++++++
 .../inputs/contracts/custom_predicate_succeed.ncl |  3 +++
 .../inputs/contracts/custom_validator_fail.ncl    |  6 ++++++
 .../inputs/contracts/custom_validator_succeed.ncl |  3 +++
 8 files changed, 54 insertions(+)
 create mode 100644 cli/tests/snapshot/inputs/errors/validator_custom_error.ncl
 create mode 100644 cli/tests/snapshot/snapshots/snapshot__eval_stderr_validator_custom_error.ncl.snap
 create mode 100644 core/tests/integration/inputs/contracts/custom_generic_fail.ncl
 create mode 100644 core/tests/integration/inputs/contracts/custom_generic_succeed.ncl
 create mode 100644 core/tests/integration/inputs/contracts/custom_predicate_fail.ncl
 create mode 100644 core/tests/integration/inputs/contracts/custom_predicate_succeed.ncl
 create mode 100644 core/tests/integration/inputs/contracts/custom_validator_fail.ncl
 create mode 100644 core/tests/integration/inputs/contracts/custom_validator_succeed.ncl

diff --git a/cli/tests/snapshot/inputs/errors/validator_custom_error.ncl b/cli/tests/snapshot/inputs/errors/validator_custom_error.ncl
new file mode 100644
index 0000000000..0647ecfa57
--- /dev/null
+++ b/cli/tests/snapshot/inputs/errors/validator_custom_error.ncl
@@ -0,0 +1,12 @@
+# capture = 'stderr'
+# command = ['eval']
+let Is42 = std.contract.from_validator (fun value =>
+  if value == 42 then
+    'Ok value
+  else
+    'Error {
+      message = "Value must be 42",
+      notes = ["This is a first custom note", "This is a second custom note"]
+    }
+) in
+43 | Is42
diff --git a/cli/tests/snapshot/snapshots/snapshot__eval_stderr_validator_custom_error.ncl.snap b/cli/tests/snapshot/snapshots/snapshot__eval_stderr_validator_custom_error.ncl.snap
new file mode 100644
index 0000000000..28f4f4360c
--- /dev/null
+++ b/cli/tests/snapshot/snapshots/snapshot__eval_stderr_validator_custom_error.ncl.snap
@@ -0,0 +1,15 @@
+---
+source: cli/tests/snapshot/main.rs
+expression: err
+---
+error: contract broken by a value
+       Value must be 42
+   ┌─ [INPUTS_PATH]/errors/validator_custom_error.ncl:12:1
+   │
+12 │ 43 | Is42
+   │ ^^   ---- expected type
+   │ │     
+   │ applied to this expression
+   │
+   = This is a first custom note
+   = This is a second custom note
diff --git a/core/tests/integration/inputs/contracts/custom_generic_fail.ncl b/core/tests/integration/inputs/contracts/custom_generic_fail.ncl
new file mode 100644
index 0000000000..3af2c26e61
--- /dev/null
+++ b/core/tests/integration/inputs/contracts/custom_generic_fail.ncl
@@ -0,0 +1,6 @@
+# test.type = 'error'
+#
+# [test.metadata]
+# error = 'EvalError::BlameError'
+let AlwaysFail = std.contract.custom (fun label _ => std.contract.blame label) in
+3 | AlwaysFail
diff --git a/core/tests/integration/inputs/contracts/custom_generic_succeed.ncl b/core/tests/integration/inputs/contracts/custom_generic_succeed.ncl
new file mode 100644
index 0000000000..f542410de5
--- /dev/null
+++ b/core/tests/integration/inputs/contracts/custom_generic_succeed.ncl
@@ -0,0 +1,3 @@
+# test.type = 'pass'
+let AlwaysSucceed = std.contract.custom (fun _ value => value) in
+(3 | AlwaysSucceed) == 3
diff --git a/core/tests/integration/inputs/contracts/custom_predicate_fail.ncl b/core/tests/integration/inputs/contracts/custom_predicate_fail.ncl
new file mode 100644
index 0000000000..371f2e50e7
--- /dev/null
+++ b/core/tests/integration/inputs/contracts/custom_predicate_fail.ncl
@@ -0,0 +1,6 @@
+# test.type = 'error'
+#
+# [test.metadata]
+# error = 'EvalError::BlameError'
+let AlwaysFail = std.contract.from_predicate (fun _ => false) in
+3 | AlwaysFail
diff --git a/core/tests/integration/inputs/contracts/custom_predicate_succeed.ncl b/core/tests/integration/inputs/contracts/custom_predicate_succeed.ncl
new file mode 100644
index 0000000000..e8097da695
--- /dev/null
+++ b/core/tests/integration/inputs/contracts/custom_predicate_succeed.ncl
@@ -0,0 +1,3 @@
+# test.type = 'pass'
+let AlwaysSucceed = std.contract.from_predicate (fun _ => true) in
+(3 | AlwaysSucceed) == 3
diff --git a/core/tests/integration/inputs/contracts/custom_validator_fail.ncl b/core/tests/integration/inputs/contracts/custom_validator_fail.ncl
new file mode 100644
index 0000000000..8ad4487d50
--- /dev/null
+++ b/core/tests/integration/inputs/contracts/custom_validator_fail.ncl
@@ -0,0 +1,6 @@
+# test.type = 'error'
+#
+# [test.metadata]
+# error = 'EvalError::BlameError'
+let AlwaysFail = std.contract.from_validator (fun _ => 'Error {}) in
+3 | AlwaysFail
diff --git a/core/tests/integration/inputs/contracts/custom_validator_succeed.ncl b/core/tests/integration/inputs/contracts/custom_validator_succeed.ncl
new file mode 100644
index 0000000000..dbff37a50f
--- /dev/null
+++ b/core/tests/integration/inputs/contracts/custom_validator_succeed.ncl
@@ -0,0 +1,3 @@
+# test.type = 'pass'
+let AlwaysSucceed = std.contract.from_validator (fun _ => 'Ok) in
+(3 | AlwaysSucceed) == 3

From b4443dc4049d39e528fd81c3ee25906ba1db98d5 Mon Sep 17 00:00:00 2001
From: Yann Hamdaoui <yann.hamdaoui@tweag.io>
Date: Wed, 19 Jun 2024 18:45:02 +0200
Subject: [PATCH 5/8] Migrate stdlib to use validators

---
 core/stdlib/internals.ncl                     |   4 +-
 core/stdlib/std.ncl                           | 142 +++++++-----------
 examples/config-gcc/config-gcc.ncl            |  20 +--
 .../simple-contracts/simple-contract-bool.ncl |  11 +-
 4 files changed, 66 insertions(+), 111 deletions(-)

diff --git a/core/stdlib/internals.ncl b/core/stdlib/internals.ncl
index 4365e7568b..c11546dfa3 100644
--- a/core/stdlib/internals.ncl
+++ b/core/stdlib/internals.ncl
@@ -315,8 +315,8 @@
               (
                 %force%
                   [
-                    "The validator for this contract returned an invalid result (which must be either `'Ok` or `'Error {message, ..}`)"
-                      "Please check the implementation of the contract that has been broken"
+                    "The validator for this contract returned an invalid result (which must be either `'Ok` or `'Error {message, ..}`)",
+                    "Please check the implementation of the contract that has been broken"
                   ]
               )
               label
diff --git a/core/stdlib/std.ncl b/core/stdlib/std.ncl
index 12ab59f8f6..694400a95c 100644
--- a/core/stdlib/std.ncl
+++ b/core/stdlib/std.ncl
@@ -60,16 +60,16 @@
           ```
         "%
       =
-        %contract/custom%
+        %contract/from_validator%
           (
-            fun label value =>
+            fun value =>
               if %typeof% value == 'Array then
                 if %array/length% value != 0 then
-                  value
+                  'Ok
                 else
-                  %blame% (%label/with_message% "empty array" label)
+                  'Error { message = "empty array" }
               else
-                %blame% (%label/with_message% "not a array" label)
+                'Error { message = "not a array" }
           ),
 
     first
@@ -1440,51 +1440,28 @@
                     |> std.contract.apply (Codomain arg_with_ctr) label
               ),
 
-        PosNumber
-          | doc m%"
-              **Warning**: this is an unstable item. It might be renamed,
-              modified or deleted in any subsequent minor Nickel version.
-
-              A contract for a positive number.
-
-              This contract blames only if the value is a number but is not
-              positive: the fact that the value is a number is assumed to be
-              checked by an associated static type annotation.
-            "%
-          =
-            %contract/custom%
-              (
-                fun label value =>
-                  if %typeof% value == 'Number then
-                    if value >= 0 then
-                      value
-                    else
-                      %blame% (%label/append_note% "Expected a positive number, got %{%to_string% value}" label)
-                  else
-                    value
-              ),
-
         RangeStep
           | doc m%"
               **Warning**: this is an unstable item. It might be renamed,
               modified or deleted in any subsequent minor Nickel version.
 
               A contract for a range step, which must be a positive number.
-              Mostly a wrapper around `std.contract.unstable.PosNumber` with a
-              custom error message.
 
               This contract blames only if the value is a number but is not
               positive: the fact that the value is a number is assumed to be
               checked by an associated static type annotation.
             "%
           =
-            %contract/custom%
+            %contract/from_validator%
               (
-                fun label value =>
-                  %contract/apply%
-                    PosNumber
-                    (%label/with_message% "invalid range step" label)
-                    value
+                fun value =>
+                  if %typeof% value == 'Number && value < 0 then
+                    'Error {
+                      message = "invalid range step",
+                      notes = ["Expected a positive number, got %{%to_string% value}"],
+                    }
+                  else
+                    'Ok
               ),
 
         RangeFun
@@ -1659,7 +1636,7 @@
                           |> attach_message
                           |> label_module.append_note "Expected the array slice end index to be a positive integer, got %{%to_string% value}"
                         in
-                        std.contract.apply std.number.Nat label value
+                        %contract/apply% std.number.Nat label value
                     else
                       value
                 )
@@ -1783,7 +1760,7 @@
         ("tag" | std.enum.Enum) =>
           error
         "%
-      = std.contract.from_predicate std.is_enum,
+      = %contract/from_predicate% std.is_enum,
 
     TagOrString
       | doc m%%"
@@ -2088,16 +2065,16 @@
         ```
       "%
       =
-        %contract/custom%
+        %contract/from_validator%
           (
-            fun label value =>
+            fun value =>
               if %typeof% value == 'Number then
                 if value % 1 == 0 then
-                  value
+                  'Ok
                 else
-                  %blame% (%label/with_message% "not an integer" label)
+                  'Error { message = "not an integer" }
               else
-                %blame% (%label/with_message% "not a number" label)
+                'Error { message = "not a number" }
           ),
 
     Nat
@@ -2116,16 +2093,16 @@
         ```
       "%
       =
-        %contract/custom%
+        %contract/from_validator%
           (
-            fun label value =>
+            fun value =>
               if %typeof% value == 'Number then
                 if value % 1 == 0 && value >= 0 then
-                  value
+                  'Ok
                 else
-                  %blame% (%label/with_message% "not a natural" label)
+                  'Error { message = "not a natural" }
               else
-                %blame% (%label/with_message% "not a number" label)
+                'Error { message = "not a number" }
           ),
 
     PosNat
@@ -2144,16 +2121,16 @@
         ```
       "%
       =
-        %contract/custom%
+        %contract/from_validator%
           (
-            fun label value =>
+            fun value =>
               if %typeof% value == 'Number then
                 if value % 1 == 0 && value > 0 then
-                  value
+                  'Ok
                 else
-                  %blame% (%label/with_message% "not positive integer" label)
+                  'Error { message = "not positive integer" }
               else
-                %blame% (%label/with_message% "not a number" label)
+                'Error { message = "not a number" }
           ),
 
     NonZero
@@ -2170,16 +2147,16 @@
         ```
       "%
       =
-        %contract/custom%
+        %contract/from_validator%
           (
-            fun label value =>
+            fun value =>
               if %typeof% value == 'Number then
                 if value != 0 then
-                  value
+                  'Ok
                 else
-                  %blame% (%label/with_message% "is zero" label)
+                  'Error { message = "is zero" }
               else
-                %blame% (%label/with_message% "not a number" label)
+                'Error { message = "not a number" }
           ),
 
     is_integer
@@ -2846,16 +2823,16 @@
         let pattern = m%"^[+-]?(\d+(\.\d*)?(e[+-]?\d+)?|\.\d+(e[+-]?\d+)?)$"% in
         let is_num_literal = %string/is_match% pattern in
 
-        %contract/custom%
+        %contract/from_validator%
           (
-            fun label value =>
+            fun value =>
               if %typeof% value == 'String then
                 if is_num_literal value then
-                  value
+                  'Ok
                 else
-                  %blame% (%label/with_message% "invalid number literal" label)
+                  'Error { message = "invalid number literal" }
               else
-                %blame% (%label/with_message% "not a string" label)
+                'Error { message = "not a string" }
           ),
 
     Character
@@ -2876,16 +2853,16 @@
         ```
       "%
       =
-        %contract/custom%
+        %contract/from_validator%
           (
-            fun label value =>
+            fun value =>
               if %typeof% value == 'String then
                 if length value == 1 then
-                  value
+                  'Ok
                 else
-                  %blame% (%label/with_message% "length different than one" label)
+                  'Error { message = "length different than one" }
               else
-                %blame% (%label/with_message% "not a string" label)
+                'Error { message = "not a string" }
           ),
 
     Stringable
@@ -2944,16 +2921,16 @@
         ```
       "%
       =
-        %contract/custom%
+        %contract/from_validator%
           (
-            fun label value =>
+            fun value =>
               if %typeof% value == 'String then
                 if %string/length% value > 0 then
-                  value
+                  'Ok
                 else
-                  %blame% (%label/with_message% "empty string" label)
+                  'Error { message = "empty string" }
               else
-                %blame% (%label/with_message% "not a string" label)
+                'Error { message = "not a string" }
           ),
 
     join
@@ -3447,16 +3424,7 @@
          => true
         ```
         "%
-      =
-        %contract/custom%
-          (
-            fun label value =>
-              if value then
-                true
-              else
-                %blame%
-                  label
-          ),
+      = %contract/from_predicate% (fun x => x),
 
     assert_all
       | Array Assert -> Bool
@@ -3763,11 +3731,7 @@
       ```
     "%
     = fun msg =>
-      %contract/custom%
-        (
-          fun label value =>
-            std.contract.blame_with_message msg label
-        ),
+      %contract/from_validator% (fun _ => 'Error { message = msg }),
 
   fail_with
     | String -> Dyn
diff --git a/examples/config-gcc/config-gcc.ncl b/examples/config-gcc/config-gcc.ncl
index 624fff6b24..145daaa9f9 100644
--- a/examples/config-gcc/config-gcc.ncl
+++ b/examples/config-gcc/config-gcc.ncl
@@ -34,30 +34,30 @@ in
 
 let Path =
   let pattern = m%"^(.+)/([^/]+)$"% in
-  std.contract.custom
+  std.contract.from_validator
     (
-      fun label value =>
+      fun value =>
         if std.is_string value then
           if std.string.is_match pattern value then
-            value
+            'Ok
           else
-            std.contract.blame_with_message "invalid path" label
+            'Error { message = "invalid path" }
         else
-          std.contract.blame_with_message "not a string" label
+          'Error { message = "not a string" }
     )
 in
 
 let SharedObjectFile =
-  std.contract.custom
+  std.contract.from_validator
     (
-      fun label value =>
+      fun value =>
         if std.is_string value then
           if std.string.is_match m%"\.so$"% value then
-            value
+            'Ok
           else
-            std.contract.blame_with_message "not an .so file" label
+            'Error { message = "not an .so file" }
         else
-          std.contract.blame_with_message "not a string" label
+          'Error { message = "not a string" }
     )
 in
 
diff --git a/examples/simple-contracts/simple-contract-bool.ncl b/examples/simple-contracts/simple-contract-bool.ncl
index 50d019b8eb..f739928aaa 100644
--- a/examples/simple-contracts/simple-contract-bool.ncl
+++ b/examples/simple-contracts/simple-contract-bool.ncl
@@ -1,17 +1,8 @@
 # test = 'pass'
 
 # Example of simple custom contract, parametrized by a first argument.
-# In practice, for this kind of simple predicate, one should rather use
-# `contract.from_predicate`
 let EqualsTo = fun reference_value =>
-  std.contract.custom
-    (
-      fun label value =>
-        if reference_value == value then
-          value
-        else
-          std.contract.blame label
-    )
+  std.contract.from_predicate ((==) reference_value)
 in
 
 let AlwaysTrue = EqualsTo true in

From 7e1db31512fef01ecf26fee7b927592e9ba42c4d Mon Sep 17 00:00:00 2001
From: Yann Hamdaoui <yann.hamdaoui@tweag.io>
Date: Wed, 19 Jun 2024 19:45:16 +0200
Subject: [PATCH 6/8] Add documentation on validators

---
 doc/manual/contracts.md | 71 ++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 70 insertions(+), 1 deletion(-)

diff --git a/doc/manual/contracts.md b/doc/manual/contracts.md
index f49aa8a198..50bd64c2e7 100644
--- a/doc/manual/contracts.md
+++ b/doc/manual/contracts.md
@@ -127,7 +127,76 @@ wrong.
 
 ### With `from_validator`
 
-TODO once `from_validator` is implemented.
+Predicates are useful for simple contracts, but they have an important
+shortcoming: it's impossible to customize the reported error messages in case of
+contract violation. Validators are an enhanced version of predicates that can
+include additional information to be reported in case of error. They leverage
+Nickel's enum variants to do so.
+
+Instead of returning a boolean, a validator returns a value of type:
+
+```nickel
+[|
+  'Ok,
+  'Error {
+    message
+      | String
+      | optional,
+    notes
+      | Array String
+      | optional,
+  }
+|]
+```
+
+This type includes the value `'Ok` to signal success and `'Error data` to signal
+a violation, where `data` is a record that has an optional field `message`
+representing the main error explanation and an optional field `notes`, which is
+an array of strings, for additional notes included at the end of the error
+message. Each note spans a new line.
+
+Let's rewrite the `IsFoo` contract using a validator with more precise error
+reporting:
+
+```nickel #repl
+> let IsFoo =
+  std.contract.from_validator
+      (
+        match {
+          "foo" => 'Ok,
+          value if std.is_string value =>
+            'Error {
+              message = "expected \"foo\", got \"%{value}\"",
+            },
+          value =>
+            let typeof = value |> std.typeof |> std.to_string in
+            'Error {
+              message = "expected a String, got a %{typeof}",
+              notes = ["The value must be a string equal to \"foo\"."],
+            },
+        }
+      )
+
+> 1 | IsFoo
+error: contract broken by a value
+       expected a String, got a Number
+  ┌─ <repl-input-3>:1:1
+  │
+1 │ 1 | IsFoo
+  │ ^   ----- expected type
+  │ │    
+  │ applied to this expression
+  │
+  = The value must be a string equal to "foo".
+
+> "a" | IsFoo
+error: contract broken by a value
+       expected "foo", got "a"
+[...]
+
+> "foo" | IsFoo
+"foo"
+```
 
 ### With `custom`
 

From d481138e25da6ef03bfb12514bdec0b29e46161a Mon Sep 17 00:00:00 2001
From: Yann Hamdaoui <yann.hamdaoui@tweag.io>
Date: Thu, 20 Jun 2024 11:26:19 +0200
Subject: [PATCH 7/8] Fix manual snippets

---
 doc/manual/contracts.md | 35 ++++++++++++++++++-----------------
 1 file changed, 18 insertions(+), 17 deletions(-)

diff --git a/doc/manual/contracts.md b/doc/manual/contracts.md
index 50bd64c2e7..d8c4f56b89 100644
--- a/doc/manual/contracts.md
+++ b/doc/manual/contracts.md
@@ -85,7 +85,7 @@ that should be identical, typically because the deduplication optimization
 doesn't fire anymore. You must always ensure that you write idempotent
 contracts.
 
-### With `from_predicate`
+### Predicate
 
 The simplest way to write a custom contract is to use
 `std.contract.from_predicate`. This function takes a predicate, which is a
@@ -125,7 +125,7 @@ require a custom error message: as for primitive types, just seeing the name of
 the contract should be sufficient for other developers to understand what went
 wrong.
 
-### With `from_validator`
+### Validators
 
 Predicates are useful for simple contracts, but they have an important
 shortcoming: it's impossible to customize the reported error messages in case of
@@ -180,12 +180,12 @@ reporting:
 > 1 | IsFoo
 error: contract broken by a value
        expected a String, got a Number
-  ┌─ <repl-input-3>:1:1
+  ┌─ <repl-input-3>:1:2
   │
-1 │ 1 | IsFoo
-  │ ^   ----- expected type
-  │ │    
-  │ applied to this expression
+1 │  1 | IsFoo
+  │  ^   ----- expected type
+  │  │
+  │  applied to this expression
   │
   = The value must be a string equal to "foo".
 
@@ -198,7 +198,7 @@ error: contract broken by a value
 "foo"
 ```
 
-### With `custom`
+### Generic custom contracts
 
 In some situations, even validators aren't sufficient. For example, when writing
 [lazy contracts](#laziness) or [parametrized
@@ -570,14 +570,14 @@ example:
 
 > {data = "", must_be_very_secure = false} | Secure
 error: non mergeable terms
-  ┌─ <repl-input-15>:1:36
+  ┌─ <repl-input-19>:1:36
   │
 1 │  {data = "", must_be_very_secure = false} | Secure
   │                                    ^^^^^    ------ originally merged here
   │                                    │
   │                                    cannot merge this expression
   │
-  ┌─ <repl-input-13>:2:34
+  ┌─ <repl-input-17>:2:34
   │
 2 │     must_be_very_secure | Bool = true,
   │                                  ^^^^ with this expression
@@ -644,7 +644,7 @@ contract to each element:
 
 > [1000, 10001, 2] | Array VeryBig
 error: contract broken by a value
-  ┌─ <repl-input-21>:1:16
+  ┌─ <repl-input-25>:1:16
   │
 1 │  [1000, 10001, 2] | Array VeryBig
   │                ^          ------- expected array element type
@@ -712,7 +712,7 @@ functions as parameters. Here is an example:
 > let apply_fun | (Number -> Number) -> Number = fun f => f 0 in
   apply_fun (fun x => "a")
 error: contract broken by the caller
-  ┌─ <repl-input-24>:1:29
+  ┌─ <repl-input-28>:1:29
   │
 1 │  let apply_fun | (Number -> Number) -> Number = fun f => f 0 in
   │                             ------ expected return type of a function provided by the caller
@@ -743,11 +743,12 @@ strings and values satisfy `Contract`, for example:
 ## Laziness
 
 In the [section on writing a custom contract with
-`std.contract.custom`](#with-custom), we noted the strange fact that a general
-custom contract must return a value, instead of just returning e.g. a boolean to
-indicate success or failure. A custom contract could even theoretically always
-return `null`, as failure is handled separately by aborting, which is a bit
-unsettling (although there is no reasonable justification for doing that!).
+`std.contract.custom`](#generic-custom-contracts), we noted the strange fact
+that a general custom contract must return a value, instead of just returning
+e.g. a boolean to indicate success or failure. A custom contract could even
+theoretically always return `null`, as failure is handled separately by
+aborting, which is a bit unsettling (although there is no reasonable
+justification for doing that!).
 
 What's more, the contracts we have written so far always returned the original
 value unmodified upon success, which doesn't sound very useful: after all, the

From f348ded9268e54b214546510db72a1c59de03805 Mon Sep 17 00:00:00 2001
From: Yann Hamdaoui <yann.hamdaoui@tweag.io>
Date: Mon, 24 Jun 2024 12:07:16 +0200
Subject: [PATCH 8/8] Apply suggestions from code review

Co-authored-by: jneem <joeneeman@gmail.com>
---
 core/src/term/mod.rs            | 2 +-
 core/src/typecheck/operation.rs | 2 +-
 core/stdlib/std.ncl             | 4 ++--
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/core/src/term/mod.rs b/core/src/term/mod.rs
index 43ff9cfebd..505c9c6ba2 100644
--- a/core/src/term/mod.rs
+++ b/core/src/term/mod.rs
@@ -406,7 +406,7 @@ pub enum CustomContract {
     /// `Dyn -> Bool`.
     Predicate(RichTerm),
     /// A contract built from a validator. A validator is a function of type `Dyn -> [| 'Ok, 'Error
-    /// ReifiedLabel |}` where `ReifiedLabel` is a record with error reporting data (a message,
+    /// ReifiedLabel |]` where `ReifiedLabel` is a record with error reporting data (a message,
     /// notes, etc.)
     Validator(RichTerm),
     /// A generic custom contract, represented as a partial identity function of type `Label -> Dyn
diff --git a/core/src/typecheck/operation.rs b/core/src/typecheck/operation.rs
index b7ac3841a0..e481863d6e 100644
--- a/core/src/typecheck/operation.rs
+++ b/core/src/typecheck/operation.rs
@@ -574,7 +574,7 @@ pub fn get_nop_type(
 /// Also remember that custom contracts shouldn't appear directly in the source code of Nickel:
 /// they are built using `std.contract.from_xxx` and `std.contract.custom` functions. We implement
 /// typechecking for them mostly because we can (to avoid an `unimplemented!` or a `panic!`), but
-/// we don't expect this case to trigger at the moment, so it's of the utmost importance.
+/// we don't expect this case to trigger at the moment, so it isn't of the utmost importance.
 ///
 /// The result represents the type `Dyn -> [| 'Ok, 'Error { message: String, notes: Array
 /// String } |]`.
diff --git a/core/stdlib/std.ncl b/core/stdlib/std.ncl
index 694400a95c..022240ea0c 100644
--- a/core/stdlib/std.ncl
+++ b/core/stdlib/std.ncl
@@ -1107,7 +1107,7 @@
           display. A validator is similar to a predicate (see
           `std.contract.from_predicate`) as both are contract implementations
           that must decide right away if the value passes or fails (that is,
-          those contracts aren't lazy). But as opposed to predicates, but
+          those contracts aren't lazy). But as opposed to predicates,
           validators have the additional ability to customize the error
           reporting.
 
@@ -1115,7 +1115,7 @@
 
           Because Nickel doesn't currently have proper types for contracts, the
           return type of `from_validator` is simply `Dyn` in the type signature.
-          You should think of `from_validator` as some returning a value of some
+          You should think of `from_validator` as returning a value of some
           hypothetical type `Contract`.
 
           # Examples