From 163ebf0d4d4d0b5eb04926814df79c293704a157 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Wed, 7 Sep 2022 00:38:33 +0200 Subject: [PATCH 01/11] Extract Compose to its own file --- src/FSharpPlus/Data/Compose.fs | 56 +++++++++++++++++++++++++ src/FSharpPlus/Data/Monoids.fs | 50 ---------------------- src/FSharpPlus/Extensions/Extensions.fs | 27 ++++++++++++ src/FSharpPlus/FSharpPlus.fsproj | 1 + 4 files changed, 84 insertions(+), 50 deletions(-) create mode 100644 src/FSharpPlus/Data/Compose.fs diff --git a/src/FSharpPlus/Data/Compose.fs b/src/FSharpPlus/Data/Compose.fs new file mode 100644 index 000000000..9c480b509 --- /dev/null +++ b/src/FSharpPlus/Data/Compose.fs @@ -0,0 +1,56 @@ +namespace FSharpPlus.Data + +open System +open FSharpPlus +open FSharpPlus.Control + +#if !FABLE_COMPILER || FABLE_COMPILER_3 + +/// Right-to-left composition of functors. The composition of applicative functors is always applicative, but the composition of monads is not always a monad. +[] +type Compose<'``functorF<'functorG<'t>>``> = Compose of '``functorF<'functorG<'t>>`` with + + // Functor + static member inline Map (Compose (x: '``FunctorF<'FunctorG<'T>>``), f: 'T->'U) = Compose (map (map f: '``FunctorG<'T>`` -> '``FunctorG<'U>``) x : '``FunctorF<'FunctorG<'U>>``) + + /// Lifts a function into a Composed Applicative Functor. Same as map. + /// To be used in Applicative Style expressions, combined with <*> + /// + /// Functor + static member inline () (f: 'T->'U, x: '``FunctorF<'FunctorG<'T>>``) = Compose (map (map f: '``FunctorG<'T>`` -> '``FunctorG<'U>``) x : '``FunctorF<'FunctorG<'U>>``) + + // Applicative + static member inline Return (x: 'T) = Compose (result (result x: '``ApplicativeG<'T>``)) : Compose<'``ApplicativeF<'ApplicativeG<'T>``> + + static member inline (<*>) (Compose (f: '``ApplicativeF<'ApplicativeG<'T->'U>``), Compose (x: '``ApplicativeF<'ApplicativeG<'T>``)) = + Compose ((((<*>) : '``ApplicativeG<'T->'U>`` -> '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>``) f: '``ApplicativeF<'ApplicativeG<'T>->'ApplicativeG<'U>`` ) <*> x: '``ApplicativeF<'ApplicativeG<'U>``) + + /// + /// Sequences two composed applicatives left-to-right, discarding the value of the first argument. + /// + /// Applicative + static member inline ( *>) (x: '``FunctorF<'FunctorG<'T>>``, y: '``FunctorF<'FunctorG<'U>>``) : '``FunctorF<'FunctorG<'U>>`` = ((fun (_: 'T) (k: 'U) -> k) x : '``FunctorF<'FunctorG<'U->'U>>``) <*> y + + /// + /// Sequences two composed applicatives left-to-right, discarding the value of the second argument. + /// + /// Applicative + static member inline (<* ) (x: '``FunctorF<'FunctorG<'U>>``, y: '``FunctorF<'FunctorG<'T>>``): '``FunctorF<'FunctorG<'U>>`` = ((fun (k: 'U) (_: 'T) -> k ) x : '``FunctorF<'FunctorG<'T->'U>>``) <*> y + + static member inline Lift2 (f: 'T -> 'U -> 'V, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``)) = + Compose (Lift2.Invoke (Lift2.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>``) x y: '``ApplicativeF<'ApplicativeG<'V>``) + + static member inline Lift3 (f: 'T -> 'U -> 'V -> 'W, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``), Compose (z: '``ApplicativeF<'ApplicativeG<'V>``)) = + Compose (Lift3.Invoke (Lift3.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>`` -> '``ApplicativeG<'W>``) x y z: '``ApplicativeF<'ApplicativeG<'W>``) + + // Alternative + static member inline get_Empty () = Compose (getEmpty ()) : Compose<'``AlternativeF<'ApplicativeG<'T>``> + static member inline (<|>) (Compose x, Compose y) = Compose (x <|> y) : Compose<'``AlternativeF<'ApplicativeG<'T>``> + + +/// Basic operations on Compose +[] +module Compose = + let run (Compose t) = t + +#endif \ No newline at end of file diff --git a/src/FSharpPlus/Data/Monoids.fs b/src/FSharpPlus/Data/Monoids.fs index 8a92bd8de..aaa0acd78 100644 --- a/src/FSharpPlus/Data/Monoids.fs +++ b/src/FSharpPlus/Data/Monoids.fs @@ -137,54 +137,4 @@ type Mult<'a> = Mult of 'a with static member inline get_Zero () = Mult one static member inline (+) (Mult (x: 'n), Mult (y: 'n)) = Mult (x * y) - -open FSharpPlus.Control - -/// Right-to-left composition of functors. The composition of applicative functors is always applicative, but the composition of monads is not always a monad. -[] -type Compose<'``functorF<'functorG<'t>>``> = Compose of '``functorF<'functorG<'t>>`` with - - // Functor - static member inline Map (Compose (x: '``FunctorF<'FunctorG<'T>>``), f: 'T->'U) = Compose (map (map f: '``FunctorG<'T>`` -> '``FunctorG<'U>``) x : '``FunctorF<'FunctorG<'U>>``) - - /// Lifts a function into a Composed Applicative Functor. Same as map. - /// To be used in Applicative Style expressions, combined with <*> - /// - /// Functor - static member inline () (f: 'T->'U, x: '``FunctorF<'FunctorG<'T>>``) = Compose (map (map f: '``FunctorG<'T>`` -> '``FunctorG<'U>``) x : '``FunctorF<'FunctorG<'U>>``) - - // Applicative - static member inline Return (x: 'T) = Compose (result (result x: '``ApplicativeG<'T>``)) : Compose<'``ApplicativeF<'ApplicativeG<'T>``> - - static member inline (<*>) (Compose (f: '``ApplicativeF<'ApplicativeG<'T->'U>``), Compose (x: '``ApplicativeF<'ApplicativeG<'T>``)) = - Compose ((((<*>) : '``ApplicativeG<'T->'U>`` -> '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>``) f: '``ApplicativeF<'ApplicativeG<'T>->'ApplicativeG<'U>`` ) <*> x: '``ApplicativeF<'ApplicativeG<'U>``) - - /// - /// Sequences two composed applicatives left-to-right, discarding the value of the first argument. - /// - /// Applicative - static member inline ( *>) (x: '``FunctorF<'FunctorG<'T>>``, y: '``FunctorF<'FunctorG<'U>>``) : '``FunctorF<'FunctorG<'U>>`` = ((fun (_: 'T) (k: 'U) -> k) x : '``FunctorF<'FunctorG<'U->'U>>``) <*> y - - /// - /// Sequences two composed applicatives left-to-right, discarding the value of the second argument. - /// - /// Applicative - static member inline (<* ) (x: '``FunctorF<'FunctorG<'U>>``, y: '``FunctorF<'FunctorG<'T>>``): '``FunctorF<'FunctorG<'U>>`` = ((fun (k: 'U) (_: 'T) -> k ) x : '``FunctorF<'FunctorG<'T->'U>>``) <*> y - - static member inline Lift2 (f: 'T -> 'U -> 'V, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``)) = - Compose (Lift2.Invoke (Lift2.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>``) x y: '``ApplicativeF<'ApplicativeG<'V>``) - - static member inline Lift3 (f: 'T -> 'U -> 'V -> 'W, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``), Compose (z: '``ApplicativeF<'ApplicativeG<'V>``)) = - Compose (Lift3.Invoke (Lift3.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>`` -> '``ApplicativeG<'W>``) x y z: '``ApplicativeF<'ApplicativeG<'W>``) - - // Alternative - static member inline get_Empty () = Compose (getEmpty ()) : Compose<'``AlternativeF<'ApplicativeG<'T>``> - static member inline (<|>) (Compose x, Compose y) = Compose (x <|> y) : Compose<'``AlternativeF<'ApplicativeG<'T>``> - - -/// Basic operations on Compose -[] -module Compose = - let run (Compose t) = t - #endif diff --git a/src/FSharpPlus/Extensions/Extensions.fs b/src/FSharpPlus/Extensions/Extensions.fs index 7fc8b87d7..1e555bfb9 100644 --- a/src/FSharpPlus/Extensions/Extensions.fs +++ b/src/FSharpPlus/Extensions/Extensions.fs @@ -125,3 +125,30 @@ module Extensions = | Some v -> yield v | None -> ok <- false }) if ok then Some (Array.toSeq res) else None + + type Result<'t, 'tError> with + /// Returns the first Error if it contains an Error element, otherwise a list of all elements + static member Sequence (t: seq>) = + let mutable error = None + let res = Seq.toArray (seq { + use e = t.GetEnumerator () + while e.MoveNext () && error.IsNone do + match e.Current with + | Ok v -> yield v + | Error e -> error <- Some e }) + match error with + | None -> Ok (Array.toSeq res) + | Some e -> Error e + + /// Returns the first Error if it contains an Error element, otherwise a list of all elements + static member Sequence (t: list>) = + let mutable error = None + let res = Seq.toArray (seq { + use e = (t :> seq<_>).GetEnumerator () + while e.MoveNext () && error.IsNone do + match e.Current with + | Ok v -> yield v + | Error e -> error <- Some e }) + match error with + | None -> Ok (Array.toList res) + | Some e -> Error e \ No newline at end of file diff --git a/src/FSharpPlus/FSharpPlus.fsproj b/src/FSharpPlus/FSharpPlus.fsproj index ec8b41490..c28303e56 100644 --- a/src/FSharpPlus/FSharpPlus.fsproj +++ b/src/FSharpPlus/FSharpPlus.fsproj @@ -80,6 +80,7 @@ + From 5e87637ff39791a8e7358c7e62430430c3d7bd60 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Wed, 7 Sep 2022 00:38:56 +0200 Subject: [PATCH 02/11] + applicative and applicative2 CEs --- src/FSharpPlus/Builders.fs | 21 +++++++++++++++++++++ 1 file changed, 21 insertions(+) diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index 612135b83..17a115074 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -18,6 +18,7 @@ namespace FSharpPlus module GenericBuilders = open FSharpPlus.Operators + open FSharpPlus.Data // Idiom brackets type Ii = Ii @@ -178,10 +179,30 @@ module GenericBuilders = else this.strict.While (enum.MoveNext, fun () -> rest enum.Current)) + // Generic applicative CE builder. + type ApplicativeBuilder<'``Applicative<'T>``> () = + inherit Builder<'``Applicative<'T>``> () + member inline _.BindReturn(x, f) = map f x + + // Generic 2 layer applicative CE builder. + type ApplicativeBuilder2<'``Applicative1>``> () = + inherit Builder<'``Applicative1>``> () + member inline _.BindReturn (x, f) = map f x + member inline _.Source x = Compose x + member inline _.Run x = Compose.run x + + + /// Creates a (lazy) monadic computation expression with side-effects (see http://fsprojects.github.io/FSharpPlus/computation-expressions.html for more information) let monad<'``monad<'t>``> = new MonadFxBuilder<'``monad<'t>``> () /// Creates a strict monadic computation expression with side-effects (see http://fsprojects.github.io/FSharpPlus/computation-expressions.html for more information) let monad'<'``monad<'t>``> = new MonadFxStrictBuilder<'``monad<'t>``> () + /// Creates an applicative computation expression. + let applicative<'``Applicative<'T>``> = ApplicativeBuilder<'``Applicative<'T>``> () + + /// Creates an applicative computation expression which compose effects of two Applicatives. + let applicative2<'``Applicative1>``> = ApplicativeBuilder2<'``Applicative1>``> () + #endif From 61c3d11d879638f66e4f44329bf3d8053469d9b3 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Wed, 7 Sep 2022 08:02:20 +0200 Subject: [PATCH 03/11] Speed up type inference for applicative2 --- src/FSharpPlus/Builders.fs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index 17a115074..e5030dfdb 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -179,17 +179,17 @@ module GenericBuilders = else this.strict.While (enum.MoveNext, fun () -> rest enum.Current)) - // Generic applicative CE builder. + /// Generic applicative CE builder. type ApplicativeBuilder<'``Applicative<'T>``> () = inherit Builder<'``Applicative<'T>``> () member inline _.BindReturn(x, f) = map f x - // Generic 2 layer applicative CE builder. - type ApplicativeBuilder2<'``Applicative1>``> () = - inherit Builder<'``Applicative1>``> () - member inline _.BindReturn (x, f) = map f x - member inline _.Source x = Compose x - member inline _.Run x = Compose.run x + /// Generic 2 layer applicative CE builder. + type ApplicativeBuilder2<'``applicative1>``> () = + inherit Builder<'``applicative1>``> () + member inline _.BindReturn (x: Compose<_>, f: _ -> _) = Compose.Map (x, f) : Compose<_> + member inline _.Source x = Compose (x: '``Applicative1>``) + member inline _.Run x = Compose.run x : '``Applicative1>`` From 6def6738ac43153fcb59845d9efc249f6852386c Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Wed, 7 Sep 2022 08:32:20 +0200 Subject: [PATCH 04/11] Remove inheritance, copy only required methods --- src/FSharpPlus/Builders.fs | 21 +++++++++++++++------ 1 file changed, 15 insertions(+), 6 deletions(-) diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index e5030dfdb..d5b5d1cf9 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -179,15 +179,24 @@ module GenericBuilders = else this.strict.While (enum.MoveNext, fun () -> rest enum.Current)) - /// Generic applicative CE builder. - type ApplicativeBuilder<'``Applicative<'T>``> () = - inherit Builder<'``Applicative<'T>``> () - member inline _.BindReturn(x, f) = map f x + /// Generic Applicative CE builder. + type ApplicativeBuilder<'``applicative<'t>``> () = + member _.ReturnFrom (expr) = expr : '``applicative<'t>`` + member inline _.Return (x: 'T) = result x : '``Applicative<'T>`` + member inline _.Yield (x: 'T) = result x : '``Applicative<'T>`` + member inline _.BindReturn(x, f) = map f x : '``Applicative<'U>`` + member inline _.MergeSources (t1: '``Applicative<'T>``, t2: '``Applicative<'U>``) : '``Applicative<'T * 'U>`` = Lift2.Invoke tuple2 t1 t2 + member inline _.MergeSources3 (t1: '``Applicative<'T>``, t2: '``Applicative<'U>``, t3: '``Applicative<'V>``) : '``Applicative<'T * 'U * 'V>`` = Lift3.Invoke tuple3 t1 t2 t3 + member _.Run f = f : '``applicative<'t>`` - /// Generic 2 layer applicative CE builder. + /// Generic 2 layer Applicative CE builder. type ApplicativeBuilder2<'``applicative1>``> () = - inherit Builder<'``applicative1>``> () + member _.ReturnFrom (expr) = expr : '``applicative1>`` + member inline _.Return (x: 'T) = result x : Compose<_> + member inline _.Yield (x: 'T) = result x : Compose<_> member inline _.BindReturn (x: Compose<_>, f: _ -> _) = Compose.Map (x, f) : Compose<_> + member inline _.MergeSources (t1: Compose<_>, t2: Compose<_>) : Compose<_> = Compose.Lift2 (tuple2, t1, t2) + member inline _.MergeSources3 (t1: Compose<_>, t2: Compose<_>, t3: Compose<_>) : Compose<_> = Compose.Lift3 (tuple3, t1, t2, t3) member inline _.Source x = Compose (x: '``Applicative1>``) member inline _.Run x = Compose.run x : '``Applicative1>`` From 1ff60ba773110e61fd7c9b0357e4bce15a3fd7c8 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Wed, 7 Sep 2022 10:04:57 +0200 Subject: [PATCH 05/11] Run method should match CE signature --- src/FSharpPlus/Builders.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index d5b5d1cf9..ef80959f6 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -189,7 +189,7 @@ module GenericBuilders = member inline _.MergeSources3 (t1: '``Applicative<'T>``, t2: '``Applicative<'U>``, t3: '``Applicative<'V>``) : '``Applicative<'T * 'U * 'V>`` = Lift3.Invoke tuple3 t1 t2 t3 member _.Run f = f : '``applicative<'t>`` - /// Generic 2 layer Applicative CE builder. + /// Generic 2 layers Applicative CE builder. type ApplicativeBuilder2<'``applicative1>``> () = member _.ReturnFrom (expr) = expr : '``applicative1>`` member inline _.Return (x: 'T) = result x : Compose<_> @@ -197,8 +197,8 @@ module GenericBuilders = member inline _.BindReturn (x: Compose<_>, f: _ -> _) = Compose.Map (x, f) : Compose<_> member inline _.MergeSources (t1: Compose<_>, t2: Compose<_>) : Compose<_> = Compose.Lift2 (tuple2, t1, t2) member inline _.MergeSources3 (t1: Compose<_>, t2: Compose<_>, t3: Compose<_>) : Compose<_> = Compose.Lift3 (tuple3, t1, t2, t3) - member inline _.Source x = Compose (x: '``Applicative1>``) - member inline _.Run x = Compose.run x : '``Applicative1>`` + member _.Source x = Compose (x: '``Applicative1>``) + member _.Run x = Compose.run x : '``applicative1>`` From af2d49f9b1a972691fa034c9fa16da7f73ad5a82 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Wed, 7 Sep 2022 10:27:14 +0200 Subject: [PATCH 06/11] + test --- tests/FSharpPlus.Tests/ComputationExpressions.fs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/tests/FSharpPlus.Tests/ComputationExpressions.fs b/tests/FSharpPlus.Tests/ComputationExpressions.fs index 6d70eb99c..385c18651 100644 --- a/tests/FSharpPlus.Tests/ComputationExpressions.fs +++ b/tests/FSharpPlus.Tests/ComputationExpressions.fs @@ -13,6 +13,21 @@ module ComputationExpressions = let task<'t> = monad'> + [] + let twoLayersApplicatives () = + let id : Task> = Failure (Map.ofList ["Id", ["Negative number"]]) |> Task.FromResult + let firstName : Validation<_, string> = Failure (Map.ofList ["Name", ["Invalid chars"]]) + let lastName : Validation<_, string> = Failure (Map.ofList ["Name", ["Too long"]]) + let date : Task> = Failure (Map.ofList ["DoB" , ["Invalid date"]]) |> result + + let person = applicative2 { + let! i = id + and! f = result firstName + and! l = result lastName + and! d = date + return {| Id = i; Name = f + l; DateOfBirth = d |} } + () + [] let specializedCEs () = From b80f59796bd69f7876bce4eca57ccf4b41c889e9 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Wed, 7 Sep 2022 11:47:16 +0200 Subject: [PATCH 07/11] Don't use Compose --- src/FSharpPlus/Builders.fs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index ef80959f6..2c567fe08 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -191,14 +191,13 @@ module GenericBuilders = /// Generic 2 layers Applicative CE builder. type ApplicativeBuilder2<'``applicative1>``> () = - member _.ReturnFrom (expr) = expr : '``applicative1>`` - member inline _.Return (x: 'T) = result x : Compose<_> - member inline _.Yield (x: 'T) = result x : Compose<_> - member inline _.BindReturn (x: Compose<_>, f: _ -> _) = Compose.Map (x, f) : Compose<_> - member inline _.MergeSources (t1: Compose<_>, t2: Compose<_>) : Compose<_> = Compose.Lift2 (tuple2, t1, t2) - member inline _.MergeSources3 (t1: Compose<_>, t2: Compose<_>, t3: Compose<_>) : Compose<_> = Compose.Lift3 (tuple3, t1, t2, t3) - member _.Source x = Compose (x: '``Applicative1>``) - member _.Run x = Compose.run x : '``applicative1>`` + member _.ReturnFrom expr : '``applicative1>`` = expr + member inline _.Return (x: 'T) : '``Applicative1>`` = (result >> result) x + member inline _.Yield (x: 'T) : '``Applicative1>`` = (result >> result) x + member inline _.BindReturn (x: '``Applicative1>``, f: _ -> _) : '``Applicative1>`` = (map >> map) f x + member inline _.MergeSources (t1, t2) : '``Applicative1>`` = (lift2 >> lift2) tuple2 t1 t2 + member inline _.MergeSources3 (t1, t2, t3) : '``Applicative1>`` = (lift3 >> lift3) tuple3 t1 t2 t3 + member _.Run x : '``applicative1>`` = x From 6e8cf8bcc4d0ccd5b1cb1a21ec02fa1247befa45 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Wed, 7 Sep 2022 12:17:35 +0200 Subject: [PATCH 08/11] + applicative3 --- src/FSharpPlus/Builders.fs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/src/FSharpPlus/Builders.fs b/src/FSharpPlus/Builders.fs index 2c567fe08..46da802db 100644 --- a/src/FSharpPlus/Builders.fs +++ b/src/FSharpPlus/Builders.fs @@ -199,6 +199,16 @@ module GenericBuilders = member inline _.MergeSources3 (t1, t2, t3) : '``Applicative1>`` = (lift3 >> lift3) tuple3 t1 t2 t3 member _.Run x : '``applicative1>`` = x + /// Generic 3 layers Applicative CE builder. + type ApplicativeBuilder3<'``applicative1>>``> () = + member _.ReturnFrom expr : '``applicative1>>`` = expr + member inline _.Return (x: 'T) : '``Applicative1>>`` = (result >> result >> result) x + member inline _.Yield (x: 'T) : '``Applicative1>>`` = (result >> result >> result) x + member inline _.BindReturn (x: '``Applicative1>>``, f: _ -> _) : '``Applicative1>`` = (map >> map >> map) f x + member inline _.MergeSources (t1, t2) : '``Applicative1>>`` = (lift2 >> lift2 >> lift2) tuple2 t1 t2 + member inline _.MergeSources3 (t1, t2, t3) : '``Applicative1>>`` = (lift3 >> lift3 >> lift3) tuple3 t1 t2 t3 + member _.Run x : '``applicative1>>`` = x + /// Creates a (lazy) monadic computation expression with side-effects (see http://fsprojects.github.io/FSharpPlus/computation-expressions.html for more information) @@ -213,4 +223,7 @@ module GenericBuilders = /// Creates an applicative computation expression which compose effects of two Applicatives. let applicative2<'``Applicative1>``> = ApplicativeBuilder2<'``Applicative1>``> () + /// Creates an applicative computation expression which compose effects of three Applicatives. + let applicative3<'``Applicative1>>``> = ApplicativeBuilder3<'``Applicative1>>``> () + #endif From e60252365bfc4a16a9625afeee173bc820950446 Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Wed, 7 Sep 2022 14:08:45 +0200 Subject: [PATCH 09/11] +test --- .../FSharpPlus.Tests/ComputationExpressions.fs | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/tests/FSharpPlus.Tests/ComputationExpressions.fs b/tests/FSharpPlus.Tests/ComputationExpressions.fs index 385c18651..68963dec5 100644 --- a/tests/FSharpPlus.Tests/ComputationExpressions.fs +++ b/tests/FSharpPlus.Tests/ComputationExpressions.fs @@ -20,7 +20,7 @@ module ComputationExpressions = let lastName : Validation<_, string> = Failure (Map.ofList ["Name", ["Too long"]]) let date : Task> = Failure (Map.ofList ["DoB" , ["Invalid date"]]) |> result - let person = applicative2 { + let _person = applicative2 { let! i = id and! f = result firstName and! l = result lastName @@ -28,6 +28,21 @@ module ComputationExpressions = return {| Id = i; Name = f + l; DateOfBirth = d |} } () + [] + let threeLayersApplicatives () = + let id : Lazy, int>>> = lazy (Failure (Map.ofList ["Id", ["Negative number"]]) |> result) + let firstName : Task, string>> = Failure (Map.ofList ["Name", ["Invalid chars"]]) |> Task.FromResult + let lastName = "Smith" + let date : Lazy, DateTime>>> = lazy (Failure (Map.ofList ["DoB" , ["Invalid date"]]) |> result) + + let _person = applicative3 { + let! i = id + and! d = date + and! f = result firstName + let l = lastName + return {| Id = i; Name = f + l ; DateOfBirth = d |} } + () + [] let specializedCEs () = From 87449a946ac68db70a2cceb021fdf8ff9b1ea25a Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Sun, 11 Sep 2022 07:07:05 +0200 Subject: [PATCH 10/11] Revert "Extract Compose to its own file" This reverts commit 163ebf0d4d4d0b5eb04926814df79c293704a157. --- src/FSharpPlus/Data/Compose.fs | 56 ------------------------- src/FSharpPlus/Data/Monoids.fs | 50 ++++++++++++++++++++++ src/FSharpPlus/Extensions/Extensions.fs | 27 ------------ src/FSharpPlus/FSharpPlus.fsproj | 1 - 4 files changed, 50 insertions(+), 84 deletions(-) delete mode 100644 src/FSharpPlus/Data/Compose.fs diff --git a/src/FSharpPlus/Data/Compose.fs b/src/FSharpPlus/Data/Compose.fs deleted file mode 100644 index 9c480b509..000000000 --- a/src/FSharpPlus/Data/Compose.fs +++ /dev/null @@ -1,56 +0,0 @@ -namespace FSharpPlus.Data - -open System -open FSharpPlus -open FSharpPlus.Control - -#if !FABLE_COMPILER || FABLE_COMPILER_3 - -/// Right-to-left composition of functors. The composition of applicative functors is always applicative, but the composition of monads is not always a monad. -[] -type Compose<'``functorF<'functorG<'t>>``> = Compose of '``functorF<'functorG<'t>>`` with - - // Functor - static member inline Map (Compose (x: '``FunctorF<'FunctorG<'T>>``), f: 'T->'U) = Compose (map (map f: '``FunctorG<'T>`` -> '``FunctorG<'U>``) x : '``FunctorF<'FunctorG<'U>>``) - - /// Lifts a function into a Composed Applicative Functor. Same as map. - /// To be used in Applicative Style expressions, combined with <*> - /// - /// Functor - static member inline () (f: 'T->'U, x: '``FunctorF<'FunctorG<'T>>``) = Compose (map (map f: '``FunctorG<'T>`` -> '``FunctorG<'U>``) x : '``FunctorF<'FunctorG<'U>>``) - - // Applicative - static member inline Return (x: 'T) = Compose (result (result x: '``ApplicativeG<'T>``)) : Compose<'``ApplicativeF<'ApplicativeG<'T>``> - - static member inline (<*>) (Compose (f: '``ApplicativeF<'ApplicativeG<'T->'U>``), Compose (x: '``ApplicativeF<'ApplicativeG<'T>``)) = - Compose ((((<*>) : '``ApplicativeG<'T->'U>`` -> '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>``) f: '``ApplicativeF<'ApplicativeG<'T>->'ApplicativeG<'U>`` ) <*> x: '``ApplicativeF<'ApplicativeG<'U>``) - - /// - /// Sequences two composed applicatives left-to-right, discarding the value of the first argument. - /// - /// Applicative - static member inline ( *>) (x: '``FunctorF<'FunctorG<'T>>``, y: '``FunctorF<'FunctorG<'U>>``) : '``FunctorF<'FunctorG<'U>>`` = ((fun (_: 'T) (k: 'U) -> k) x : '``FunctorF<'FunctorG<'U->'U>>``) <*> y - - /// - /// Sequences two composed applicatives left-to-right, discarding the value of the second argument. - /// - /// Applicative - static member inline (<* ) (x: '``FunctorF<'FunctorG<'U>>``, y: '``FunctorF<'FunctorG<'T>>``): '``FunctorF<'FunctorG<'U>>`` = ((fun (k: 'U) (_: 'T) -> k ) x : '``FunctorF<'FunctorG<'T->'U>>``) <*> y - - static member inline Lift2 (f: 'T -> 'U -> 'V, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``)) = - Compose (Lift2.Invoke (Lift2.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>``) x y: '``ApplicativeF<'ApplicativeG<'V>``) - - static member inline Lift3 (f: 'T -> 'U -> 'V -> 'W, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``), Compose (z: '``ApplicativeF<'ApplicativeG<'V>``)) = - Compose (Lift3.Invoke (Lift3.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>`` -> '``ApplicativeG<'W>``) x y z: '``ApplicativeF<'ApplicativeG<'W>``) - - // Alternative - static member inline get_Empty () = Compose (getEmpty ()) : Compose<'``AlternativeF<'ApplicativeG<'T>``> - static member inline (<|>) (Compose x, Compose y) = Compose (x <|> y) : Compose<'``AlternativeF<'ApplicativeG<'T>``> - - -/// Basic operations on Compose -[] -module Compose = - let run (Compose t) = t - -#endif \ No newline at end of file diff --git a/src/FSharpPlus/Data/Monoids.fs b/src/FSharpPlus/Data/Monoids.fs index aaa0acd78..8a92bd8de 100644 --- a/src/FSharpPlus/Data/Monoids.fs +++ b/src/FSharpPlus/Data/Monoids.fs @@ -137,4 +137,54 @@ type Mult<'a> = Mult of 'a with static member inline get_Zero () = Mult one static member inline (+) (Mult (x: 'n), Mult (y: 'n)) = Mult (x * y) + +open FSharpPlus.Control + +/// Right-to-left composition of functors. The composition of applicative functors is always applicative, but the composition of monads is not always a monad. +[] +type Compose<'``functorF<'functorG<'t>>``> = Compose of '``functorF<'functorG<'t>>`` with + + // Functor + static member inline Map (Compose (x: '``FunctorF<'FunctorG<'T>>``), f: 'T->'U) = Compose (map (map f: '``FunctorG<'T>`` -> '``FunctorG<'U>``) x : '``FunctorF<'FunctorG<'U>>``) + + /// Lifts a function into a Composed Applicative Functor. Same as map. + /// To be used in Applicative Style expressions, combined with <*> + /// + /// Functor + static member inline () (f: 'T->'U, x: '``FunctorF<'FunctorG<'T>>``) = Compose (map (map f: '``FunctorG<'T>`` -> '``FunctorG<'U>``) x : '``FunctorF<'FunctorG<'U>>``) + + // Applicative + static member inline Return (x: 'T) = Compose (result (result x: '``ApplicativeG<'T>``)) : Compose<'``ApplicativeF<'ApplicativeG<'T>``> + + static member inline (<*>) (Compose (f: '``ApplicativeF<'ApplicativeG<'T->'U>``), Compose (x: '``ApplicativeF<'ApplicativeG<'T>``)) = + Compose ((((<*>) : '``ApplicativeG<'T->'U>`` -> '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>``) f: '``ApplicativeF<'ApplicativeG<'T>->'ApplicativeG<'U>`` ) <*> x: '``ApplicativeF<'ApplicativeG<'U>``) + + /// + /// Sequences two composed applicatives left-to-right, discarding the value of the first argument. + /// + /// Applicative + static member inline ( *>) (x: '``FunctorF<'FunctorG<'T>>``, y: '``FunctorF<'FunctorG<'U>>``) : '``FunctorF<'FunctorG<'U>>`` = ((fun (_: 'T) (k: 'U) -> k) x : '``FunctorF<'FunctorG<'U->'U>>``) <*> y + + /// + /// Sequences two composed applicatives left-to-right, discarding the value of the second argument. + /// + /// Applicative + static member inline (<* ) (x: '``FunctorF<'FunctorG<'U>>``, y: '``FunctorF<'FunctorG<'T>>``): '``FunctorF<'FunctorG<'U>>`` = ((fun (k: 'U) (_: 'T) -> k ) x : '``FunctorF<'FunctorG<'T->'U>>``) <*> y + + static member inline Lift2 (f: 'T -> 'U -> 'V, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``)) = + Compose (Lift2.Invoke (Lift2.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>``) x y: '``ApplicativeF<'ApplicativeG<'V>``) + + static member inline Lift3 (f: 'T -> 'U -> 'V -> 'W, Compose (x: '``ApplicativeF<'ApplicativeG<'T>``), Compose (y: '``ApplicativeF<'ApplicativeG<'U>``), Compose (z: '``ApplicativeF<'ApplicativeG<'V>``)) = + Compose (Lift3.Invoke (Lift3.Invoke f: '``ApplicativeG<'T>`` -> '``ApplicativeG<'U>`` -> '``ApplicativeG<'V>`` -> '``ApplicativeG<'W>``) x y z: '``ApplicativeF<'ApplicativeG<'W>``) + + // Alternative + static member inline get_Empty () = Compose (getEmpty ()) : Compose<'``AlternativeF<'ApplicativeG<'T>``> + static member inline (<|>) (Compose x, Compose y) = Compose (x <|> y) : Compose<'``AlternativeF<'ApplicativeG<'T>``> + + +/// Basic operations on Compose +[] +module Compose = + let run (Compose t) = t + #endif diff --git a/src/FSharpPlus/Extensions/Extensions.fs b/src/FSharpPlus/Extensions/Extensions.fs index 1e555bfb9..7fc8b87d7 100644 --- a/src/FSharpPlus/Extensions/Extensions.fs +++ b/src/FSharpPlus/Extensions/Extensions.fs @@ -125,30 +125,3 @@ module Extensions = | Some v -> yield v | None -> ok <- false }) if ok then Some (Array.toSeq res) else None - - type Result<'t, 'tError> with - /// Returns the first Error if it contains an Error element, otherwise a list of all elements - static member Sequence (t: seq>) = - let mutable error = None - let res = Seq.toArray (seq { - use e = t.GetEnumerator () - while e.MoveNext () && error.IsNone do - match e.Current with - | Ok v -> yield v - | Error e -> error <- Some e }) - match error with - | None -> Ok (Array.toSeq res) - | Some e -> Error e - - /// Returns the first Error if it contains an Error element, otherwise a list of all elements - static member Sequence (t: list>) = - let mutable error = None - let res = Seq.toArray (seq { - use e = (t :> seq<_>).GetEnumerator () - while e.MoveNext () && error.IsNone do - match e.Current with - | Ok v -> yield v - | Error e -> error <- Some e }) - match error with - | None -> Ok (Array.toList res) - | Some e -> Error e \ No newline at end of file diff --git a/src/FSharpPlus/FSharpPlus.fsproj b/src/FSharpPlus/FSharpPlus.fsproj index c28303e56..ec8b41490 100644 --- a/src/FSharpPlus/FSharpPlus.fsproj +++ b/src/FSharpPlus/FSharpPlus.fsproj @@ -80,7 +80,6 @@ - From 3d77ca4fee9d14f2da2443b54e0a9bc8d0bfb5ab Mon Sep 17 00:00:00 2001 From: Gusty <1261319+gusty@users.noreply.github.com> Date: Sun, 11 Sep 2022 08:44:42 +0200 Subject: [PATCH 11/11] Update docs --- docsrc/content/abstraction-applicative.fsx | 37 ++++++++++++++++++---- docsrc/content/computation-expressions.fsx | 19 ++--------- 2 files changed, 34 insertions(+), 22 deletions(-) diff --git a/docsrc/content/abstraction-applicative.fsx b/docsrc/content/abstraction-applicative.fsx index af4e4b6d6..cbfd6d6d5 100644 --- a/docsrc/content/abstraction-applicative.fsx +++ b/docsrc/content/abstraction-applicative.fsx @@ -92,7 +92,7 @@ From F#+ - [``ZipList<'T>``](type-ziplist.html) - [``ParallelArray<'T>``](type-parallelarray.html) - [``Const<'C,'T>``](type-const.html) - - [``Compose<'ApplicativeF<'ApplicativeG<'T>>>``](type-compose.html) + - [``Compose<'Applicative1<'Applicative2<'T>>>``](type-compose.html) - [``DList<'T>``](type-dlist.html) - [``Vector<'T,'Dimension>``](type-vector.html) - [``Matrix<'T,'Rows,'Columns>``](type-matrix.html) @@ -141,7 +141,7 @@ let resLazy22 : Lazy<_> = result 22 let (quot5 : Microsoft.FSharp.Quotations.Expr) = result 5 // Example -type Person = { name: string; age: int } with static member create n a = {name = n; age = a} +type Person = { Name: string; Age: int } with static member create n a = { Name = n; Age = a } let person1 = Person.create tryHead ["gus"] <*> tryParse "42" let person2 = Person.create tryHead ["gus"] <*> tryParse "fourty two" @@ -190,18 +190,43 @@ let optFalse = tryParse "30" .< 29 let m1m2m3 = -.[1;2;3] +// Using applicative computation expression +let getName s = tryHead s +let getAge s = tryParse s -// Composing applicatives +let person4 = applicative { + let! name = getName ["gus"] + and! age = getAge "42" + return { Name = name; Age = age } } + + +(** + +Composing applicatives +---------------------- + +Unlike monads, applicatives are always composable. + +The date type [``Compose<'Applicative1<'Applicative2<'T>>>``](type-compose.html) can be used to compose any 2 applicatives: +*) let res4 = (+) Compose [Some 3] <*> Compose [Some 1] -let getName s = async { return tryHead s } -let getAge s = async { return tryParse s } +let getNameAsync s = async { return tryHead s } +let getAgeAsync s = async { return tryParse s } -let person4 = Person.create Compose (getName ["gus"]) <*> Compose (getAge "42") +let person5 = Person.create Compose (getNameAsync ["gus"]) <*> Compose (getAgeAsync "42") +(** + +The computation expressions applicative2 and applicative3 can also be used to compose applicatives: +*) +let person6 = applicative2 { + let! name = printfn "aa"; getNameAsync ["gus"] + and! age = getAgeAsync "42" + return { Name = name; Age = age } } diff --git a/docsrc/content/computation-expressions.fsx b/docsrc/content/computation-expressions.fsx index 25d2ffc59..3e4314ed9 100644 --- a/docsrc/content/computation-expressions.fsx +++ b/docsrc/content/computation-expressions.fsx @@ -12,7 +12,9 @@ Computations Expressions This library allows to use some common computation expressions without writing any boiler plate code. -There is a single computation expression: ``monad`` but it comes in 4 flavours: +For applicatives there is single computation expression: ``applicative { .. }``. Additionally ``applicative2 { .. }`` and ``applicative3 { .. }`` exists for composed (aka layered) applicatives. + +For monadic code there is a single computation expression: ``monad { .. }`` but it comes in 4 flavours: - Delayed or strict @@ -55,21 +57,6 @@ let _ : OptionT> = monad { printfn "I'm strict" } (** -Applicatives -============ - -There are some F# issues preventing applicative required `BindReturn` to be included in `monad`, so for the moment the following snipped can be used to quickly create a generic applicative CE: - -*) - -type ApplicativeBuilder<'t> () = - inherit MonadFxStrictBuilder<'t> () - member inline _.BindReturn (x, f) = map f x - -let applicative<'t> = ApplicativeBuilder<'t> () - -(** - Examples ========