From b8ca19869925db7588c8be11034180400f7f1f6c Mon Sep 17 00:00:00 2001 From: Tiago Rodrigues Date: Mon, 14 Nov 2022 21:12:43 +0000 Subject: [PATCH 1/8] Added computation expression for validation and added some extensions methods --- build.proj | 2 +- src/FSharpPlus/Data/Validation.fs | 23 +++++++ src/FSharpPlus/Extensions/Validation.fs | 80 +++++++++++++++++++++++++ src/FSharpPlus/FSharpPlus.fsproj | 1 + tests/FSharpPlus.Tests/Validations.fs | 72 +++++++++++++++++++++- 5 files changed, 175 insertions(+), 3 deletions(-) create mode 100644 src/FSharpPlus/Extensions/Validation.fs diff --git a/build.proj b/build.proj index a3e35ed69..c9431fd53 100644 --- a/build.proj +++ b/build.proj @@ -33,7 +33,7 @@ - + S diff --git a/src/FSharpPlus/Data/Validation.fs b/src/FSharpPlus/Data/Validation.fs index 9813553fa..1ad5ae23d 100644 --- a/src/FSharpPlus/Data/Validation.fs +++ b/src/FSharpPlus/Data/Validation.fs @@ -243,6 +243,29 @@ module Validation = List.iter (function Success e -> coll1.Add e | Failure e -> coll2.Add e) source coll1.Close (), coll2.Close () #endif + + [] + module ComputationExpression = + type ValidationBuilder() = + member _.Bind(x, f) = + match x with + | Failure e -> Failure e + | Success a -> f a + + member _.MergeSources(left : Validation, _>, right : Validation, _>) = + match left, right with + | Success l, Success r -> Success (l, r) + | Failure l, Success _ -> Failure l + | Success _, Failure r -> Failure r + | Failure r, Failure l -> List.append r l |> Failure + + member _.Return(x) = + Success x + + member _.ReturnFrom(x) = + x + + let validator = ValidationBuilder() type Validation<'err,'a> with diff --git a/src/FSharpPlus/Extensions/Validation.fs b/src/FSharpPlus/Extensions/Validation.fs new file mode 100644 index 000000000..d82e4c8f9 --- /dev/null +++ b/src/FSharpPlus/Extensions/Validation.fs @@ -0,0 +1,80 @@ +namespace FSharpPlus + +[] +module Validations = + open System + open FSharpPlus.Data + + let inline validate errorMessage f v = + if f v then + Success v + else + Failure [ errorMessage ] + + let inline requireString propName = + let errorMessage = + sprintf "%s cannot be null, empty or whitespace." propName + + validate errorMessage (String.IsNullOrWhiteSpace >> not) + + let inline requireGreaterThan propName min = + let errorMessage = + sprintf "%s have to be greater or equal to '%d'." propName min + + validate errorMessage (flip (>) min) + + let inline requireGreaterOrEqualThan propName min = + let errorMessage = + sprintf "%s have to be greater or equal to '%d'." propName min + + validate errorMessage (flip (>=) min) + + let inline requireEmail propName = + let errorMessage = + sprintf "%s is not a valid email address." propName + + let check (v: string) = + try + let _ = Net.Mail.MailAddress(v) + true + with + | ex -> false + + validate errorMessage check + + let inline requireGuid propName = + validate (sprintf "%s is required" propName) (fun v -> v <> Guid.Empty) + + let inline requireObject propName = + let check value = box value <> null + validate (sprintf "%s is required" propName) check + + let inline requireWhenSome value checkWhenSome = + match value with + | Some v -> checkWhenSome v |> Validation.map Some + | _ -> Success None + + let inline requireArrayValues values check = + let validated : Validation<_,_> [] = + values + |> Array.map check + validated + |> sequence + |> Validation.map Seq.toArray + + let inline requireListValues values check = + let validated : List> = + values + |> List.map check + validated + |> sequence + |> Validation.map Seq.toArray + + let inline requireAtLeastOne propName = + let check values = + Seq.isEmpty values |> not + + let errorMessage = + sprintf "%s should have at least one element'." propName + + validate errorMessage check diff --git a/src/FSharpPlus/FSharpPlus.fsproj b/src/FSharpPlus/FSharpPlus.fsproj index 832af9215..b68866901 100644 --- a/src/FSharpPlus/FSharpPlus.fsproj +++ b/src/FSharpPlus/FSharpPlus.fsproj @@ -102,6 +102,7 @@ + diff --git a/tests/FSharpPlus.Tests/Validations.fs b/tests/FSharpPlus.Tests/Validations.fs index 34515a3f8..8b6925374 100644 --- a/tests/FSharpPlus.Tests/Validations.fs +++ b/tests/FSharpPlus.Tests/Validations.fs @@ -2,6 +2,8 @@ namespace FSharpPlus.Tests #nowarn "44" +open System.ComponentModel.DataAnnotations + module Validation = open System @@ -11,7 +13,27 @@ module Validation = open FSharpPlus.Data open Validation open FSharpPlus.Tests.Helpers - + + let private isSuccess = + function + | Success _ -> true + | Failure _ -> false + + let private isFailure = + function + | Success _ -> false + | Failure _ -> true + + let private getSuccess = + function + | Success s -> s + | Failure _ -> failwith "It's a failure" + + let private getFailure = + function + | Success _ -> failwith "It's a Success" + | Failure f -> f + let fsCheck s x = Check.One({Config.QuickThrowOnFailure with Name = s}, x) module FunctorP = [] @@ -337,4 +359,50 @@ module Validation = let v: Validation = Success (async {return 42}) let r = Validation.bisequence v let subject = Async.RunSynchronously r - areStEqual subject (Success 42) \ No newline at end of file + areStEqual subject (Success 42) + + [] + [] + [] + [] + [] + let testValidateRequireString (str, success) = + + let r = Validations.requireString "Str" str + areStEqual (isSuccess r) success + + if not success then + let failure = getFailure r + areStEqual failure.Length 1 + else + () + + [] + [] + [] + [] + let testValidateRequireGreaterThan (value, limit, success) = + + let r = Validations.requireGreaterThan "Int" limit value + areStEqual (isSuccess r) success + + if not success then + let failure = getFailure r + areStEqual failure.Length 1 + else + () + + [] + [] + [] + [] + let testValidateRequireGreaterOrEqualThan (value, limit, success) = + + let r = Validations.requireGreaterOrEqualThan "Int" limit value + areStEqual (isSuccess r) success + + if not success then + let failure = getFailure r + areStEqual failure.Length 1 + else + () \ No newline at end of file From 8ea0b269cd94016c0d58c98c043be6dbd3f8e906 Mon Sep 17 00:00:00 2001 From: Tiago Rodrigues Date: Mon, 14 Nov 2022 21:13:16 +0000 Subject: [PATCH 2/8] Revert change --- build.proj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/build.proj b/build.proj index c9431fd53..a3e35ed69 100644 --- a/build.proj +++ b/build.proj @@ -33,7 +33,7 @@ - S + From cedb1b20dd54db2cdeb0b005adfc8e9510305d7a Mon Sep 17 00:00:00 2001 From: Tiago Rodrigues Date: Mon, 14 Nov 2022 21:13:50 +0000 Subject: [PATCH 3/8] revert change --- tests/FSharpPlus.Tests/Validations.fs | 2 -- 1 file changed, 2 deletions(-) diff --git a/tests/FSharpPlus.Tests/Validations.fs b/tests/FSharpPlus.Tests/Validations.fs index 8b6925374..08569b385 100644 --- a/tests/FSharpPlus.Tests/Validations.fs +++ b/tests/FSharpPlus.Tests/Validations.fs @@ -2,8 +2,6 @@ namespace FSharpPlus.Tests #nowarn "44" -open System.ComponentModel.DataAnnotations - module Validation = open System From 3762d162fb296d5946558854b62ba860e9b879d3 Mon Sep 17 00:00:00 2001 From: Tiago Rodrigues Date: Tue, 15 Nov 2022 08:46:06 +0000 Subject: [PATCH 4/8] Pr suggestions --- src/FSharpPlus/Data/Validation.fs | 22 +----------- src/FSharpPlus/Extensions/Validation.fs | 47 +++++++++---------------- tests/FSharpPlus.Tests/Validations.fs | 15 ++++---- 3 files changed, 26 insertions(+), 58 deletions(-) diff --git a/src/FSharpPlus/Data/Validation.fs b/src/FSharpPlus/Data/Validation.fs index 1ad5ae23d..f5a21db84 100644 --- a/src/FSharpPlus/Data/Validation.fs +++ b/src/FSharpPlus/Data/Validation.fs @@ -246,27 +246,7 @@ module Validation = [] module ComputationExpression = - type ValidationBuilder() = - member _.Bind(x, f) = - match x with - | Failure e -> Failure e - | Success a -> f a - - member _.MergeSources(left : Validation, _>, right : Validation, _>) = - match left, right with - | Success l, Success r -> Success (l, r) - | Failure l, Success _ -> Failure l - | Success _, Failure r -> Failure r - | Failure r, Failure l -> List.append r l |> Failure - - member _.Return(x) = - Success x - - member _.ReturnFrom(x) = - x - - let validator = ValidationBuilder() - + let validator<'Error,'T> = applicative, 'T>> type Validation<'err,'a> with diff --git a/src/FSharpPlus/Extensions/Validation.fs b/src/FSharpPlus/Extensions/Validation.fs index d82e4c8f9..c06b42228 100644 --- a/src/FSharpPlus/Extensions/Validation.fs +++ b/src/FSharpPlus/Extensions/Validation.fs @@ -5,34 +5,22 @@ module Validations = open System open FSharpPlus.Data - let inline validate errorMessage f v = + let inline validate error f v = if f v then Success v else - Failure [ errorMessage ] + Failure [ error ] - let inline requireString propName = - let errorMessage = - sprintf "%s cannot be null, empty or whitespace." propName + let inline requireString error = + validate error (String.IsNullOrWhiteSpace >> not) - validate errorMessage (String.IsNullOrWhiteSpace >> not) - - let inline requireGreaterThan propName min = - let errorMessage = - sprintf "%s have to be greater or equal to '%d'." propName min - - validate errorMessage (flip (>) min) + let inline requireGreaterThan error min = + validate error (flip (>) min) - let inline requireGreaterOrEqualThan propName min = - let errorMessage = - sprintf "%s have to be greater or equal to '%d'." propName min - - validate errorMessage (flip (>=) min) - - let inline requireEmail propName = - let errorMessage = - sprintf "%s is not a valid email address." propName + let inline requireGreaterOrEqualThan error min = + validate error (flip (>=) min) + let inline requireEmail error = let check (v: string) = try let _ = Net.Mail.MailAddress(v) @@ -40,14 +28,14 @@ module Validations = with | ex -> false - validate errorMessage check + validate error check - let inline requireGuid propName = - validate (sprintf "%s is required" propName) (fun v -> v <> Guid.Empty) + let inline requireGuid error = + validate error (fun v -> v <> Guid.Empty) - let inline requireObject propName = + let inline requireObject error = let check value = box value <> null - validate (sprintf "%s is required" propName) check + validate error check let inline requireWhenSome value checkWhenSome = match value with @@ -70,11 +58,8 @@ module Validations = |> sequence |> Validation.map Seq.toArray - let inline requireAtLeastOne propName = + let inline requireAtLeastOne error = let check values = Seq.isEmpty values |> not - let errorMessage = - sprintf "%s should have at least one element'." propName - - validate errorMessage check + validate error check \ No newline at end of file diff --git a/tests/FSharpPlus.Tests/Validations.fs b/tests/FSharpPlus.Tests/Validations.fs index 08569b385..fe1a25633 100644 --- a/tests/FSharpPlus.Tests/Validations.fs +++ b/tests/FSharpPlus.Tests/Validations.fs @@ -365,13 +365,14 @@ module Validation = [] [] let testValidateRequireString (str, success) = - - let r = Validations.requireString "Str" str + let error = "Str" + let r = Validations.requireString error str areStEqual (isSuccess r) success if not success then let failure = getFailure r areStEqual failure.Length 1 + areStEqual failure.[0] error else () @@ -380,13 +381,14 @@ module Validation = [] [] let testValidateRequireGreaterThan (value, limit, success) = - - let r = Validations.requireGreaterThan "Int" limit value + let error = "Int" + let r = Validations.requireGreaterThan error limit value areStEqual (isSuccess r) success if not success then let failure = getFailure r areStEqual failure.Length 1 + areStEqual failure.[0] error else () @@ -395,12 +397,13 @@ module Validation = [] [] let testValidateRequireGreaterOrEqualThan (value, limit, success) = - - let r = Validations.requireGreaterOrEqualThan "Int" limit value + let error = "Int" + let r = Validations.requireGreaterOrEqualThan error limit value areStEqual (isSuccess r) success if not success then let failure = getFailure r areStEqual failure.Length 1 + areStEqual failure.[0] error else () \ No newline at end of file From d997501a273e61b3e9422d5f09347337a8b62a75 Mon Sep 17 00:00:00 2001 From: Tiago Rodrigues Date: Wed, 16 Nov 2022 10:36:19 +0000 Subject: [PATCH 5/8] added value to error --- .../{Validation.fs => Validators.fs} | 34 +++++++++---------- src/FSharpPlus/FSharpPlus.fsproj | 2 +- tests/FSharpPlus.Tests/Validations.fs | 18 +++++----- 3 files changed, 27 insertions(+), 27 deletions(-) rename src/FSharpPlus/Extensions/{Validation.fs => Validators.fs} (56%) diff --git a/src/FSharpPlus/Extensions/Validation.fs b/src/FSharpPlus/Extensions/Validators.fs similarity index 56% rename from src/FSharpPlus/Extensions/Validation.fs rename to src/FSharpPlus/Extensions/Validators.fs index c06b42228..ef105cb97 100644 --- a/src/FSharpPlus/Extensions/Validation.fs +++ b/src/FSharpPlus/Extensions/Validators.fs @@ -1,7 +1,7 @@ namespace FSharpPlus [] -module Validations = +module RequiredValidation = open System open FSharpPlus.Data @@ -11,16 +11,16 @@ module Validations = else Failure [ error ] - let inline requireString error = - validate error (String.IsNullOrWhiteSpace >> not) + let inline string error value = + validate (error value) (String.IsNullOrWhiteSpace >> not) value - let inline requireGreaterThan error min = - validate error (flip (>) min) + let inline greaterThan error min value = + validate (error value) (flip (>) min) value - let inline requireGreaterOrEqualThan error min = - validate error (flip (>=) min) + let inline greaterOrEqualThan error min value = + validate (error value) (flip (>=) min) value - let inline requireEmail error = + let inline email error value = let check (v: string) = try let _ = Net.Mail.MailAddress(v) @@ -28,21 +28,21 @@ module Validations = with | ex -> false - validate error check + validate (error value) check value - let inline requireGuid error = - validate error (fun v -> v <> Guid.Empty) + let inline guid error value = + validate (error value) (fun v -> v <> Guid.Empty) value - let inline requireObject error = + let inline object error value = let check value = box value <> null - validate error check + validate (error value) check - let inline requireWhenSome value checkWhenSome = + let inline whenSome value checkWhenSome = match value with | Some v -> checkWhenSome v |> Validation.map Some | _ -> Success None - let inline requireArrayValues values check = + let inline arrayValues values check = let validated : Validation<_,_> [] = values |> Array.map check @@ -50,7 +50,7 @@ module Validations = |> sequence |> Validation.map Seq.toArray - let inline requireListValues values check = + let inline listValues values check = let validated : List> = values |> List.map check @@ -58,7 +58,7 @@ module Validations = |> sequence |> Validation.map Seq.toArray - let inline requireAtLeastOne error = + let inline atLeastOne error = let check values = Seq.isEmpty values |> not diff --git a/src/FSharpPlus/FSharpPlus.fsproj b/src/FSharpPlus/FSharpPlus.fsproj index b68866901..55c73255b 100644 --- a/src/FSharpPlus/FSharpPlus.fsproj +++ b/src/FSharpPlus/FSharpPlus.fsproj @@ -102,7 +102,7 @@ - + diff --git a/tests/FSharpPlus.Tests/Validations.fs b/tests/FSharpPlus.Tests/Validations.fs index fe1a25633..99016e853 100644 --- a/tests/FSharpPlus.Tests/Validations.fs +++ b/tests/FSharpPlus.Tests/Validations.fs @@ -365,14 +365,14 @@ module Validation = [] [] let testValidateRequireString (str, success) = - let error = "Str" - let r = Validations.requireString error str + let error = konst "Str" + let r = RequiredValidation.string error str areStEqual (isSuccess r) success if not success then let failure = getFailure r areStEqual failure.Length 1 - areStEqual failure.[0] error + areStEqual failure.[0] (error "") else () @@ -381,14 +381,14 @@ module Validation = [] [] let testValidateRequireGreaterThan (value, limit, success) = - let error = "Int" - let r = Validations.requireGreaterThan error limit value + let error = konst "Int" + let r = RequiredValidation.greaterThan error limit value areStEqual (isSuccess r) success if not success then let failure = getFailure r areStEqual failure.Length 1 - areStEqual failure.[0] error + areStEqual failure.[0] (error 1) else () @@ -397,13 +397,13 @@ module Validation = [] [] let testValidateRequireGreaterOrEqualThan (value, limit, success) = - let error = "Int" - let r = Validations.requireGreaterOrEqualThan error limit value + let error = konst "Int" + let r = RequiredValidation.greaterOrEqualThan error limit value areStEqual (isSuccess r) success if not success then let failure = getFailure r areStEqual failure.Length 1 - areStEqual failure.[0] error + areStEqual failure.[0] (error 1) else () \ No newline at end of file From d6a9cecf286014ac56618a15e46e512441735dad Mon Sep 17 00:00:00 2001 From: Tiago Rodrigues Date: Wed, 16 Nov 2022 18:48:42 +0000 Subject: [PATCH 6/8] added new methods --- src/FSharpPlus/Extensions/Validators.fs | 12 +++++++++++- tests/FSharpPlus.Tests/Validations.fs | 16 +++------------- 2 files changed, 14 insertions(+), 14 deletions(-) diff --git a/src/FSharpPlus/Extensions/Validators.fs b/src/FSharpPlus/Extensions/Validators.fs index ef105cb97..2ddaf23b2 100644 --- a/src/FSharpPlus/Extensions/Validators.fs +++ b/src/FSharpPlus/Extensions/Validators.fs @@ -62,4 +62,14 @@ module RequiredValidation = let check values = Seq.isEmpty values |> not - validate error check \ No newline at end of file + validate error check + + let RequiredValidation.isSuccess = + function + | Success _ -> true + | Failure _ -> false + + let isFailure = + function + | Success _ -> false + | Failure _ -> true \ No newline at end of file diff --git a/tests/FSharpPlus.Tests/Validations.fs b/tests/FSharpPlus.Tests/Validations.fs index 99016e853..a03cf5f02 100644 --- a/tests/FSharpPlus.Tests/Validations.fs +++ b/tests/FSharpPlus.Tests/Validations.fs @@ -11,16 +11,6 @@ module Validation = open FSharpPlus.Data open Validation open FSharpPlus.Tests.Helpers - - let private isSuccess = - function - | Success _ -> true - | Failure _ -> false - - let private isFailure = - function - | Success _ -> false - | Failure _ -> true let private getSuccess = function @@ -367,7 +357,7 @@ module Validation = let testValidateRequireString (str, success) = let error = konst "Str" let r = RequiredValidation.string error str - areStEqual (isSuccess r) success + areStEqual (RequiredValidation.isSuccess r) success if not success then let failure = getFailure r @@ -383,7 +373,7 @@ module Validation = let testValidateRequireGreaterThan (value, limit, success) = let error = konst "Int" let r = RequiredValidation.greaterThan error limit value - areStEqual (isSuccess r) success + areStEqual (RequiredValidation.isSuccess r) success if not success then let failure = getFailure r @@ -399,7 +389,7 @@ module Validation = let testValidateRequireGreaterOrEqualThan (value, limit, success) = let error = konst "Int" let r = RequiredValidation.greaterOrEqualThan error limit value - areStEqual (isSuccess r) success + areStEqual (RequiredValidation.isSuccess r) success if not success then let failure = getFailure r From 0a69dc5ab367105dcecbb44c0c8a9ef0a33b1f92 Mon Sep 17 00:00:00 2001 From: Tiago Rodrigues Date: Wed, 16 Nov 2022 18:51:28 +0000 Subject: [PATCH 7/8] Removed computation expression --- src/FSharpPlus/Data/Validation.fs | 4 ---- src/FSharpPlus/Extensions/Validators.fs | 2 +- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/src/FSharpPlus/Data/Validation.fs b/src/FSharpPlus/Data/Validation.fs index f5a21db84..a341d6a3b 100644 --- a/src/FSharpPlus/Data/Validation.fs +++ b/src/FSharpPlus/Data/Validation.fs @@ -243,10 +243,6 @@ module Validation = List.iter (function Success e -> coll1.Add e | Failure e -> coll2.Add e) source coll1.Close (), coll2.Close () #endif - - [] - module ComputationExpression = - let validator<'Error,'T> = applicative, 'T>> type Validation<'err,'a> with diff --git a/src/FSharpPlus/Extensions/Validators.fs b/src/FSharpPlus/Extensions/Validators.fs index 2ddaf23b2..92427364b 100644 --- a/src/FSharpPlus/Extensions/Validators.fs +++ b/src/FSharpPlus/Extensions/Validators.fs @@ -64,7 +64,7 @@ module RequiredValidation = validate error check - let RequiredValidation.isSuccess = + let isSuccess = function | Success _ -> true | Failure _ -> false From 9868e744a5ee64d33a58153852b95acc5eefb94a Mon Sep 17 00:00:00 2001 From: Tiago Rodrigues Date: Wed, 23 Nov 2022 21:24:50 +0000 Subject: [PATCH 8/8] Rename some functions --- src/FSharpPlus/Extensions/Validators.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/FSharpPlus/Extensions/Validators.fs b/src/FSharpPlus/Extensions/Validators.fs index 92427364b..8b3ea60b4 100644 --- a/src/FSharpPlus/Extensions/Validators.fs +++ b/src/FSharpPlus/Extensions/Validators.fs @@ -5,13 +5,13 @@ module RequiredValidation = open System open FSharpPlus.Data - let inline validate error f v = + let inline private validate error f v = if f v then Success v else Failure [ error ] - let inline string error value = + let inline notNullOrWhiteSpace error value = validate (error value) (String.IsNullOrWhiteSpace >> not) value let inline greaterThan error min value = @@ -30,7 +30,7 @@ module RequiredValidation = validate (error value) check value - let inline guid error value = + let inline guidNotEmpty error value = validate (error value) (fun v -> v <> Guid.Empty) value let inline object error value =