From 83405db41c2da62d0ad3281962be6b5d0d124cce Mon Sep 17 00:00:00 2001
From: Radu Popovici <oncicaradupopovici@gmail.com>
Date: Fri, 13 Mar 2020 17:39:34 +0200
Subject: [PATCH] evented operators and traversal (#68)

Co-authored-by: Radu Popovici <rpopovici@totalsoft.ro>
---
 src/Core/NBB.Core.Effects.FSharp/Effects.fs   | 13 ------
 src/Core/NBB.Core.Evented.FSharp/Evented.fs   | 40 ++++++++++++-------
 .../NBB.Core.Evented.FSharp.Tests/Tests.fs    | 34 ++++++++++++++++
 3 files changed, 59 insertions(+), 28 deletions(-)

diff --git a/src/Core/NBB.Core.Effects.FSharp/Effects.fs b/src/Core/NBB.Core.Effects.FSharp/Effects.fs
index 19a40de7..9a6e86ba 100644
--- a/src/Core/NBB.Core.Effects.FSharp/Effects.fs
+++ b/src/Core/NBB.Core.Effects.FSharp/Effects.fs
@@ -34,19 +34,6 @@ type Effect<'T> with
     static member (>>=) (x,f) = Effect.bind f x
     static member (<*>) (f,x) = Effect.apply f x
 
-//module Effect = 
-//    let bind func eff = Effect.Bind(eff, Func<'a, IEffect<'b>>(func))
-//    let map func eff = Effect.Map(Func<'a, 'b>(func), eff)
-//    let apply (func: IEffect<'a->'b>) eff = Effect.Apply(map (fun fn -> Func<'a,'b>(fn)) func, eff)
-//    let pure' x = Effect.Pure x
-//    let return' = pure'
-//    let ignore eff = map (fun _ -> ()) eff
-
-//    let composeK f g x = bind g (f x)
-//    let lift2 f = map f >> apply
-
-//    let interpret<'a> (interpreter:IInterpreter) eff = interpreter.Interpret<'a>(eff) |> Async.AwaitTask
-
 module EffectBuilder =
     type EffectBuilder() =
         member _.Bind(eff, func) = Effect.bind func eff
diff --git a/src/Core/NBB.Core.Evented.FSharp/Evented.fs b/src/Core/NBB.Core.Evented.FSharp/Evented.fs
index 07396702..fe473530 100644
--- a/src/Core/NBB.Core.Evented.FSharp/Evented.fs
+++ b/src/Core/NBB.Core.Evented.FSharp/Evented.fs
@@ -13,9 +13,9 @@ module Evented =
     let pure' value = Evented(value, [])
     let return' = pure'
 
-    //let composeK f g x = bind g (f x)
+    let composeK f g x = bind g (f x)
 
-    //let lift2 f = map f >> apply
+    let lift2 f = map f >> apply
 
 type Evented<'a, 'e> with
     static member Map (x, f) = Evented.map  f x
@@ -35,16 +35,26 @@ module EventedBuilder =
 module Events =
     let evented = new EventedBuilder.EventedBuilder()
 
-    //let (<!>) = Evented.map
-    //let (<*>) = Evented.apply
-    //let (>>=) evented func = Evented.bind func evented
-    //let (>=>) = Evented.composeK
-
-//module List =
-//    let traverseEvented f list =
-//        let cons head tail = head :: tail  
-//        let initState = Evented.pure' []
-//        let folder head tail = Evented.pure' cons <*> (f head) <*> tail
-//        List.foldBack folder list initState
-
-//    let sequenceEvented list = traverseEvented id list
\ No newline at end of file
+    let (<!>) = Evented.map
+    let (<*>) = Evented.apply
+    let (>>=) evented func = Evented.bind func evented
+    let (>=>) = Evented.composeK
+
+[<RequireQualifiedAccess>]
+module List =
+    let traverseEvented f list =
+        let cons head tail = head :: tail      
+        let initState = Evented.pure' []
+        let folder head tail = Evented.pure' cons <*> (f head) <*> tail
+        List.foldBack folder list initState
+
+    let sequenceEvented list = traverseEvented id list
+
+[<RequireQualifiedAccess>]
+module Result = 
+    let traverseEvented f result = 
+        match result with
+            | Error err -> Evented.pure' (Error err)
+            | Ok v -> Evented.map Ok (f v)
+
+    let sequenceEvented result = traverseEvented id result
\ No newline at end of file
diff --git a/test/UnitTests/Core/NBB.Core.Evented.FSharp.Tests/Tests.fs b/test/UnitTests/Core/NBB.Core.Evented.FSharp.Tests/Tests.fs
index 78743bf9..7c584fd7 100644
--- a/test/UnitTests/Core/NBB.Core.Evented.FSharp.Tests/Tests.fs
+++ b/test/UnitTests/Core/NBB.Core.Evented.FSharp.Tests/Tests.fs
@@ -24,4 +24,38 @@ let ``Evented workflow test`` () =
     
     entity|> should equal (AggRoot 2)
     events|> should equal [Added; Updated]
+
+
+[<Fact>]
+let ``Pure evented values should contain no events`` () =
+    let (Evented(_, events)) = 
+        evented {
+            return 1
+        }
+    
+    events|> should equal []
+
+[<Fact>]
+let ``List traverse evented should accumulate events`` () =
+    let xs = [1;2]
+    let fn = fun i ->
+        match i with
+        |1 -> Evented (1,[Added])
+        |_ -> Evented (2,[Updated])
+
+    let (Evented(_, events)) = xs |> List.traverseEvented fn
+
+    events|> should equal [Added;Updated]
+
+[<Fact>]
+let ``List sequence evented should accumulate events`` () =
+    let fn = fun i ->
+        match i with
+        |1 -> Evented (1,[Added])
+        |_ -> Evented (2,[Updated])
+    let xs = [1;2] |> List.map fn
+
+    let (Evented(_, events)) = xs |> List.sequenceEvented
+
+    events|> should equal [Added;Updated]