Applicative Computation Expressions (#498)

Author: gusty

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<int>) = 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 } }
 
 
 

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<seq<unit option>> = 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
 ========

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,51 @@ module GenericBuilders =
                 else this.strict.While (enum.MoveNext, fun () -> rest enum.Current))
 
 
+    /// 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 layers Applicative CE builder.
+    type ApplicativeBuilder2<'``applicative1<applicative2<'t>>``> () =
+        member        _.ReturnFrom expr : '``applicative1<applicative2<'t>>`` = expr
+        member inline _.Return (x: 'T) : '``Applicative1<Applicative2<'T>>`` = (result >> result) x
+        member inline _.Yield  (x: 'T) : '``Applicative1<Applicative2<'T>>`` = (result >> result) x
+        member inline _.BindReturn (x: '``Applicative1<Applicative2<'T>>``, f: _ -> _) : '``Applicative1<Applicative2<'U>>`` = (map >> map) f x
+        member inline _.MergeSources  (t1, t2)     : '``Applicative1<Applicative2<'T>>`` = (lift2 >> lift2) tuple2 t1 t2
+        member inline _.MergeSources3 (t1, t2, t3) : '``Applicative1<Applicative2<'T>>`` = (lift3 >> lift3) tuple3 t1 t2 t3
+        member        _.Run x : '``applicative1<applicative2<'t>>`` = x
+    
+    /// Generic 3 layers Applicative CE builder.
+    type ApplicativeBuilder3<'``applicative1<applicative2<applicative3<'t>>>``> () =
+        member        _.ReturnFrom expr : '``applicative1<applicative2<applicative3<'t>>>`` = expr
+        member inline _.Return (x: 'T) : '``Applicative1<Applicative2<Applicative3<'T>>>`` = (result >> result >> result) x
+        member inline _.Yield  (x: 'T) : '``Applicative1<Applicative2<Applicative3<'T>>>`` = (result >> result >> result) x
+        member inline _.BindReturn (x: '``Applicative1<Applicative2<Applicative3<'T>>>``, f: _ -> _) : '``Applicative1<Applicative2<'U>>`` = (map >> map >> map) f x
+        member inline _.MergeSources  (t1, t2)     : '``Applicative1<Applicative2<Applicative3<'T>>>`` = (lift2 >> lift2 >> lift2) tuple2 t1 t2
+        member inline _.MergeSources3 (t1, t2, t3) : '``Applicative1<Applicative2<Applicative3<'T>>>`` = (lift3 >> lift3 >> lift3) tuple3 t1 t2 t3
+        member        _.Run x : '``applicative1<applicative2<applicative3<'t>>>`` = 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<Applicative2<'T>>``> = ApplicativeBuilder2<'``Applicative1<Applicative2<'T>>``> ()
+
+    /// Creates an applicative computation expression which compose effects of three Applicatives.
+    let applicative3<'``Applicative1<Applicative2<Applicative3<'T>>>``> = ApplicativeBuilder3<'``Applicative1<Applicative2<Applicative3<'T>>>``> ()
+
 #endif

tests/FSharpPlus.Tests/ComputationExpressions.fs

@@ -13,6 +13,36 @@ module ComputationExpressions =
 
     let task<'t> = monad'<Task<'t>>
 
+    [<Test>]
+    let twoLayersApplicatives () =
+        let id   : Task<Validation<_, string>>   = 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<Validation<_, DateTime>> = 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 |} }
+        ()
+
+    [<Test>]
+    let threeLayersApplicatives () =
+        let id        : Lazy<Task<Validation<Map<string, string list>, int>>>      = lazy (Failure (Map.ofList ["Id",   ["Negative number"]]) |> result)
+        let firstName :      Task<Validation<Map<string, string list>, string>>    =       Failure (Map.ofList ["Name", ["Invalid chars"]]) |> Task.FromResult
+        let lastName                                                               = "Smith"
+        let date      : Lazy<Task<Validation<Map<string, string list>, 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 |} }
+        ()
+
     [<Test>]
     let specializedCEs () =