minimal (rather ugly) fix for #87

Author: krauthaufen

src/FSharp.Data.Adaptive/AdaptiveValue/AdaptiveValue.fs

@@ -1,6 +1,7 @@
 namespace FSharp.Data.Adaptive
 
 open System
+#nowarn "7331"
 
 type IAdaptiveValue =
     inherit IAdaptiveObject
@@ -108,7 +109,13 @@ module AVal =
     [<StructuredFormatDisplay("{AsString}")>]
     type MapNonAdaptiveVal<'a, 'b>(mapping : 'a -> 'b, input : aval<'a>) =
 
-        override x.ToString() = input.ToString()
+        override x.ToString() = 
+            if input.OutOfDate then 
+                "aval*"
+            else 
+                let v = input.GetValue AdaptiveToken.Top
+                sprintf "aval(%A)" (mapping v)
+
         member x.AsString = x.ToString()
 
         member x.Mapping = mapping
@@ -150,8 +157,19 @@ module AVal =
                 #else
                 typeof<'b>
                 #endif
-            member x.GetValueUntyped(t) = input.GetValue(t) |> mapping :> obj
-            member x.GetValue(t) = input.GetValue(t) |> mapping
+            member x.GetValueUntyped(t) = 
+                if Unchecked.isNull t.caller then
+                    input.GetValue t |> mapping :> obj
+                else
+                    let c = DecoratedObject.Create(t.caller, x)
+                    input.GetValue(t.WithCaller c) |> mapping :> obj
+
+            member x.GetValue(t) =  
+                if Unchecked.isNull t.caller then
+                    input.GetValue t |> mapping
+                else
+                    let c = DecoratedObject.Create(t.caller, x)
+                    input.GetValue(t.WithCaller c) |> mapping
 
     type Caster<'a, 'b> private() =
         static let cast =

src/FSharp.Data.Adaptive/Core/Transaction.fs

@@ -3,6 +3,8 @@
 open System
 open System.Threading
 
+#nowarn "7331"
+
 [<AutoOpen>]
 module internal LockingExtensions =
     type IAdaptiveObject with
@@ -29,6 +31,50 @@ exception LevelChangedException of
     /// The new level for the top-level object.
     newLevel : int
 
+/// internal type used for properly handling of decorator objects (as introduced in AVal.mapNonAdaptive)
+/// Note that it should never be necessary to use this in user-code.
+[<CompilerMessage("internal", 7331)>]
+type internal DecoratedObject private(real : IAdaptiveObject, decorator : IAdaptiveObject) =
+    let mutable weak : WeakReference<IAdaptiveObject> = null
+
+    interface IAdaptiveObject with
+        member x.Tag
+            with get() = null
+            and set _ = ()
+
+        member x.IsConstant = false
+        member x.Weak = 
+            // Note that we accept the race conditon here since locking the object
+            // would potentially cause deadlocks and the worst case is, that we
+            // create two different WeakReferences for the same object
+            let w = weak
+            if isNull w then
+                let w = WeakReference<_>(x :> IAdaptiveObject)
+                weak <- w
+                w
+            else
+                w
+        member x.Outputs = Unchecked.defaultof<_>
+        member x.Mark() = false
+        member x.AllInputsProcessed(_) = ()
+        member x.InputChanged(_, _) = ()
+
+        member x.OutOfDate
+            with get() = false
+            and set o = ()
+
+        member x.Level
+            with get() = real.Level
+            and set l = real.Level <- l
+
+    member x.Real = real
+    member x.Decorator = decorator
+
+    static member Create(real : IAdaptiveObject, decorator : IAdaptiveObject) =
+        match real with
+        | :? DecoratedObject as r -> r
+        | _ -> DecoratedObject(real, decorator)
+
 
 /// Holds a set of adaptive objects which have been changed and shall
 /// therefore be marked as outOfDate. Committing the transaction propagates
@@ -180,8 +226,13 @@ type Transaction() =
                 for i in 0 .. outputCount - 1 do
                     let o = outputs.[i]
                     outputs.[i] <- Unchecked.defaultof<_>
-                    o.InputChanged(x, e)
-                    x.Enqueue o
+                    match o with
+                    | :? DecoratedObject as o ->
+                        o.Real.InputChanged(x, o.Decorator)
+                        x.Enqueue o.Real
+                    | _ ->
+                        o.InputChanged(x, e)
+                        x.Enqueue o
 
             current <- Unchecked.defaultof<_>
 

src/Test/FSharp.Data.Adaptive.Tests/AVal.fs

@@ -235,4 +235,28 @@ let ``[AVal] ChangeableLazyVal working``() =
     test.OutOfDate |> should be False
     ()
 
+[<Test>]
+let ``[AVal] map non-adaptive and bind``() =
+    let v = AVal.init true
+    let a = AVal.constant 0
+    let b = AVal.constant 1
+
+    let output = v |> AVal.map id |> AVal.mapNonAdaptive id |> AVal.bind (fun flag -> if flag then a else b)
+
+    output |> AVal.force |> should equal 0
+
+    transact (fun () -> v.Value <- false)
+    output |> AVal.force |> should equal 1
+
+[<Test>]
+let ``[AVal] multi map non-adaptive and bind``() =
+    let v = AVal.init true
+    let a = AVal.constant 0
+    let b = AVal.constant 1
+
+    let output = v |> AVal.map id |> AVal.mapNonAdaptive id |> AVal.mapNonAdaptive id |> AVal.bind (fun flag -> if flag then a else b)
+
+    output |> AVal.force |> should equal 0
 
+    transact (fun () -> v.Value <- false)
+    output |> AVal.force |> should equal 1