Get rid of Typed refs so that this can be mapped / boxed

Author: marner2

src/Elmish.WPF/BindingVmHelpers.fs

@@ -106,14 +106,16 @@ type TwoWayBinding<'model, 'a> = {
 
 type SubModelBinding<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm> = {
   SubModelData: SubModelData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm>
-  Vm: 'vm voption ref
+  GetVm: unit -> 'vm voption
+  SetVm: 'vm voption -> unit
 }
 
 type SubModelWinBinding<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm> = {
   SubModelWinData: SubModelWinData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm>
   WinRef: WeakReference<Window>
   PreventClose: bool ref
-  VmWinState: WindowState<'vm> ref
+  GetVmWinState: unit -> WindowState<'vm>
+  SetVmWinState: WindowState<'vm> -> unit
 }
 
 type SubModelSeqUnkeyedBinding<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection> = {
@@ -162,7 +164,8 @@ type BaseVmBinding<'model, 'msg> =
 
 type CachedBinding<'model, 'msg, 'value> = {
   Binding: VmBinding<'model, 'msg>
-  Cache: 'value option ref
+  GetCache: unit -> 'value option
+  SetCache: 'value option -> unit
 }
 
 and ValidationBinding<'model, 'msg> = {
@@ -194,7 +197,7 @@ and VmBinding<'model, 'msg> =
 
   with
 
-    member this.AddCaching = Cached { Binding = this; Cache = ref None }
+    member this.AddCaching = let mutable cache = None in Cached { Binding = this; GetCache = (fun () -> cache); SetCache = fun c -> cache <- c }
     member this.AddValidation currentModel validate =
       { Binding = this
         Validate = validate
@@ -313,18 +316,20 @@ type Initialize
           d.GetModel initialModel
           |> ValueOption.map (fun m -> ViewModelArgs.create m (toMsg >> dispatch) chain loggingArgs)
           |> ValueOption.map d.CreateViewModel
-          |> (fun vm -> { SubModelData = d; Vm = ref vm })
+          |> (fun vm -> let mutable vm = vm in { SubModelData = d; GetVm = (fun () -> vm); SetVm = fun nvm -> vm <- nvm })
           |> SubModel
           |> Some
       | SubModelWinData d ->
           let d = d |> BindingData.SubModelWin.measureFunctions measure measure measure2
           let toMsg = fun msg -> d.ToMsg (getCurrentModel ()) msg
           match d.GetState initialModel with
           | WindowState.Closed ->
+              let mutable vmWinState = WindowState.Closed
               { SubModelWinData = d
                 WinRef = WeakReference<_>(null)
                 PreventClose = ref true
-                VmWinState = ref WindowState.Closed }
+                GetVmWinState = fun () -> vmWinState
+                SetVmWinState = fun vmState -> vmWinState <- vmState }
           | WindowState.Hidden m ->
               let chain = LoggingViewModelArgs.getNameChainFor nameChain name
               let args = ViewModelArgs.create m (toMsg >> dispatch) chain loggingArgs
@@ -333,10 +338,12 @@ type Initialize
               let preventClose = ref true
               log.LogTrace("[{BindingNameChain}] Creating hidden window", chain)
               Helpers2.showNewWindow winRef d.GetWindow d.IsModal d.OnCloseRequested preventClose vm Visibility.Hidden getCurrentModel dispatch
+              let mutable vmWinState = WindowState.Hidden vm
               { SubModelWinData = d
                 WinRef = winRef
                 PreventClose = preventClose
-                VmWinState = ref <| WindowState.Hidden vm }
+                GetVmWinState = fun () -> vmWinState
+                SetVmWinState = fun vm -> vmWinState <- vm }
           | WindowState.Visible m ->
               let chain = LoggingViewModelArgs.getNameChainFor nameChain name
               let args = ViewModelArgs.create m (toMsg >> dispatch) chain loggingArgs
@@ -345,10 +352,12 @@ type Initialize
               let preventClose = ref true
               log.LogTrace("[{BindingNameChain}] Creating visible window", chain)
               Helpers2.showNewWindow winRef d.GetWindow d.IsModal d.OnCloseRequested preventClose vm Visibility.Visible getCurrentModel dispatch
+              let mutable vmWinState = WindowState.Visible vm
               { SubModelWinData = d
                 WinRef = winRef
                 PreventClose = preventClose
-                VmWinState = ref <| WindowState.Visible vm }
+                GetVmWinState = fun () -> vmWinState
+                SetVmWinState = fun vm -> vmWinState <- vm  }
           |> SubModelWin
           |> Some
       | SubModelSeqUnkeyedData d ->
@@ -458,16 +467,16 @@ type Update
       | Cmd cmd -> cmd |> CanExecuteChanged |> List.singleton
       | SubModel b ->
         let d = b.SubModelData
-        match b.Vm.Value, d.GetModel newModel with
+        match b.GetVm (), d.GetModel newModel with
         | ValueNone, ValueNone -> []
         | ValueSome _, ValueNone ->
-            b.Vm.Value <- ValueNone
+            b.SetVm ValueNone
             [ PropertyChanged name ]
         | ValueNone, ValueSome m ->
             let toMsg = fun msg -> d.ToMsg (getCurrentModel ()) msg
             let chain = LoggingViewModelArgs.getNameChainFor nameChain name
             let args = ViewModelArgs.create m (toMsg >> dispatch) chain loggingArgs
-            b.Vm.Value <- ValueSome <| d.CreateViewModel(args)
+            b.SetVm (ValueSome <| d.CreateViewModel(args))
             [ PropertyChanged name ]
         | ValueSome vm, ValueSome m ->
             d.UpdateViewModel (vm, m)
@@ -518,7 +527,7 @@ type Update
             let args = ViewModelArgs.create model (toMsg >> dispatch) chain loggingArgs
             d.CreateViewModel args
 
-          match b.VmWinState.Value, d.GetState newModel with
+          match b.GetVmWinState(), d.GetState newModel with
           | WindowState.Closed, WindowState.Closed ->
               []
           | WindowState.Hidden vm, WindowState.Hidden m
@@ -528,29 +537,29 @@ type Update
           | WindowState.Hidden _, WindowState.Closed
           | WindowState.Visible _, WindowState.Closed ->
               close ()
-              b.VmWinState.Value <- WindowState.Closed
+              b.SetVmWinState WindowState.Closed
               [ PropertyChanged name ]
           | WindowState.Visible vm, WindowState.Hidden m ->
               hide ()
               d.UpdateViewModel (vm, m)
-              b.VmWinState.Value <- WindowState.Hidden vm
+              b.SetVmWinState (WindowState.Hidden vm)
               []
           | WindowState.Hidden vm, WindowState.Visible m ->
               d.UpdateViewModel (vm, m)
               showHidden ()
-              b.VmWinState.Value <- WindowState.Visible vm
+              b.SetVmWinState (WindowState.Visible vm)
               []
           | WindowState.Closed, WindowState.Hidden m ->
               let vm = newVm m
               log.LogTrace("[{BindingNameChain}] Creating hidden window", winPropChain)
               showNew vm Visibility.Hidden getCurrentModel dispatch
-              b.VmWinState.Value <- WindowState.Hidden vm
+              b.SetVmWinState (WindowState.Hidden vm)
               [ PropertyChanged name ]
           | WindowState.Closed, WindowState.Visible m ->
               let vm = newVm m
               log.LogTrace("[{BindingNameChain}] Creating visible window", winPropChain)
               showNew vm Visibility.Visible getCurrentModel dispatch
-              b.VmWinState.Value <- WindowState.Visible vm
+              b.SetVmWinState (WindowState.Visible vm)
               [ PropertyChanged name ]
       | SubModelSeqUnkeyed b ->
           let d = b.SubModelSeqUnkeyedData
@@ -592,7 +601,7 @@ type Update
           let updates = this.Recursive(currentModel, getCurrentModel, newModel, dispatch, b.Binding)
           updates
           |> List.filter UpdateData.isPropertyChanged
-          |> List.iter (fun _ -> b.Cache.Value <- None)
+          |> List.iter (fun _ -> b.SetCache None)
           updates
       | Validatation b ->
           let updates = this.Recursive(currentModel, getCurrentModel, newModel, dispatch, b.Binding)
@@ -622,13 +631,8 @@ type Get(nameChain: string) =
     | OneWayToSource _ -> GetError.OneWayToSource |> Error
     | OneWaySeq { Values = vals } -> vals.GetCollection () |> Ok
     | Cmd cmd -> cmd |> box |> Ok
-    | SubModel { Vm = vm } -> vm.Value |> ValueOption.toObj |> box |> Ok
-    | SubModelWin { VmWinState = vm } ->
-        vm.Value
-        |> WindowState.toVOption
-        |> ValueOption.map box
-        |> ValueOption.toObj
-        |> Ok
+    | SubModel { GetVm = getvm } -> getvm() |> ValueOption.toObj |> box |> Ok
+    | SubModelWin { GetVmWinState = getvm } -> getvm() |> WindowState.toVOption |> ValueOption.map box |> ValueOption.toObj |> Ok
     | SubModelSeqUnkeyed { Vms = vms }
     | SubModelSeqKeyed { Vms = vms } -> vms.GetCollection () |> Ok
     | SubModelSelectedItem b ->
@@ -653,11 +657,11 @@ type Get(nameChain: string) =
     match binding with
     | BaseVmBinding b -> this.Base(model, b)
     | Cached b ->
-        match b.Cache.Value with
+        match b.GetCache() with
         | Some v -> v |> Ok
         | None ->
             let x = this.Recursive(model, b.Binding)
-            x |> Result.iter (fun v -> b.Cache.Value <- Some v)
+            x |> Result.iter (fun v -> b.SetCache (Some v))
             x
     | Validatation b -> this.Recursive(model, b.Binding)
     | Lazy b -> this.Recursive(b.Get model, b.Binding)