Merge pull request #212 from bender2k14/add_Bindings.mapModel

Add Bindings.mapModel

Author: TysonMN

src/Elmish.WPF/Binding.fs

@@ -161,77 +161,141 @@ module internal BindingData =
       : Dispatch<'boxedMsg> -> Dispatch<'boxedMsg> =
     (unboxDispatch boxMsg) >> strongWrapDispatch >> (boxDispatch unboxMsg)
 
-  let boxBindingData
-      (unboxModel: 'boxedModel -> 'model)
+  let boxMsg
       (unboxMsg: 'boxedMsg -> 'msg)
       (boxMsg: 'msg -> 'boxedMsg)
-      : BindingData<'model, 'msg> -> BindingData<'boxedModel, 'boxedMsg> = function
-    | OneWayData d -> OneWayData {
-        Get = unboxModel >> d.Get
-      }
-    | OneWayLazyData d -> OneWayLazyData {
-        Get = unboxModel >> d.Get
-        Map = d.Map
-        Equals = d.Equals
-      }
-    | OneWaySeqLazyData d -> OneWaySeqLazyData {
-        Get = unboxModel >> d.Get
-        Map = d.Map
-        Equals = d.Equals
-        GetId = d.GetId
-        ItemEquals = d.ItemEquals
-      }
+      : BindingData<'model, 'msg> -> BindingData<'model, 'boxedMsg> = function
+    | OneWayData d -> d |> OneWayData
+    | OneWayLazyData d -> d |> OneWayLazyData
+    | OneWaySeqLazyData d -> d |> OneWaySeqLazyData
     | TwoWayData d -> TwoWayData {
-        Get = unboxModel >> d.Get
-        Set = fun v m -> d.Set v (unboxModel m) |> boxMsg
+        Get = d.Get
+        Set = fun v m -> d.Set v m |> boxMsg
         WrapDispatch = boxWrapDispatch unboxMsg boxMsg d.WrapDispatch
       }
     | TwoWayValidateData d -> TwoWayValidateData {
-        Get = unboxModel >> d.Get
-        Set = fun v m -> d.Set v (unboxModel m) |> boxMsg
+        Get = d.Get
+        Set = fun v m -> d.Set v m |> boxMsg
         Validate = unbox >> d.Validate
         WrapDispatch = boxWrapDispatch unboxMsg boxMsg d.WrapDispatch
       }
     | CmdData d -> CmdData {
-        Exec = unboxModel >> d.Exec >> ValueOption.map boxMsg
-        CanExec = unboxModel >> d.CanExec
+        Exec = d.Exec >> ValueOption.map boxMsg
+        CanExec = d.CanExec
         WrapDispatch = boxWrapDispatch unboxMsg boxMsg d.WrapDispatch
       }
     | CmdParamData d -> CmdParamData {
-        Exec = fun p m -> d.Exec p (unboxModel m) |> ValueOption.map boxMsg
-        CanExec = fun p m -> d.CanExec p (unboxModel m)
+        Exec = fun p m -> d.Exec p m |> ValueOption.map boxMsg
+        CanExec = fun p m -> d.CanExec p m
         AutoRequery = d.AutoRequery
         WrapDispatch = boxWrapDispatch unboxMsg boxMsg d.WrapDispatch
       }
     | SubModelData d -> SubModelData {
-        GetModel = unboxModel >> d.GetModel
+        GetModel = d.GetModel
         GetBindings = d.GetBindings
         ToMsg = d.ToMsg >> boxMsg
         Sticky = d.Sticky
       }
     | SubModelWinData d -> SubModelWinData {
-        GetState = unboxModel >> d.GetState
+        GetState = d.GetState
         GetBindings = d.GetBindings
         ToMsg = d.ToMsg >> boxMsg
         GetWindow =
-          fun m (disp: Dispatch<'boxedMsg>) -> d.GetWindow (unboxModel m) (unboxDispatch boxMsg disp)
+          fun m (disp: Dispatch<'boxedMsg>) -> d.GetWindow m (unboxDispatch boxMsg disp)
         IsModal = d.IsModal
         OnCloseRequested = d.OnCloseRequested |> ValueOption.map boxMsg
       }
     | SubModelSeqData d -> SubModelSeqData {
-        GetModels = unboxModel >> d.GetModels
+        GetModels = d.GetModels
         GetId = d.GetId
         GetBindings = d.GetBindings
         ToMsg = d.ToMsg >> boxMsg
       }
     | SubModelSelectedItemData d -> SubModelSelectedItemData {
-        Get = unboxModel >> d.Get
-        Set = fun v m -> d.Set v (unboxModel m) |> boxMsg
+        Get = d.Get
+        Set = fun v m -> d.Set v m |> boxMsg
         SubModelSeqBindingName = d.SubModelSeqBindingName
         WrapDispatch = boxWrapDispatch unboxMsg boxMsg d.WrapDispatch
       }
 
 
+module internal Binding =
+
+  let mapModel f binding =
+    let binaryHelper binary x m = (x, f m) ||> binary
+    let newData =
+      match binding.Data with
+      | OneWayData d ->
+          { Get = f >> d.Get
+          } |> OneWayData
+      | OneWayLazyData d ->
+          { Get = f >> d.Get
+            Map = d.Map;
+            Equals = d.Equals
+          } |> OneWayLazyData
+      | OneWaySeqLazyData d ->
+          { Get = f >> d.Get
+            Map = d.Map
+            Equals = d.Equals
+            GetId = d.GetId
+            ItemEquals = d.ItemEquals
+          } |> OneWaySeqLazyData
+      | TwoWayData d ->
+          { Get = f >> d.Get
+            Set = binaryHelper d.Set
+            WrapDispatch = d.WrapDispatch
+          } |> TwoWayData
+      | TwoWayValidateData d ->
+          { Get = f >> d.Get
+            Set = binaryHelper d.Set
+            Validate = f >> d.Validate
+            WrapDispatch = d.WrapDispatch
+          } |> TwoWayValidateData
+      | CmdData d ->
+          { Exec = f >> d.Exec
+            CanExec = f >> d.CanExec
+            WrapDispatch = d.WrapDispatch
+          } |> CmdData
+      | CmdParamData d ->
+          { Exec = binaryHelper d.Exec
+            CanExec = binaryHelper d.CanExec
+            AutoRequery = d.AutoRequery
+            WrapDispatch = d.WrapDispatch
+          } |> CmdParamData
+      | SubModelData d ->
+          { GetModel = f >> d.GetModel
+            GetBindings = d.GetBindings
+            ToMsg = d.ToMsg
+            Sticky = d.Sticky
+          } |> SubModelData
+      | SubModelWinData d ->
+          { GetState = f >> d.GetState
+            GetBindings = d.GetBindings
+            ToMsg = d.ToMsg
+            GetWindow = f >> d.GetWindow
+            IsModal = d.IsModal
+            OnCloseRequested = d.OnCloseRequested
+          } |> SubModelWinData
+      | SubModelSeqData d ->
+          { GetModels = f >> d.GetModels
+            GetId = d.GetId
+            GetBindings = d.GetBindings
+            ToMsg = d.ToMsg
+          } |> SubModelSeqData
+      | SubModelSelectedItemData d ->
+          { Get = f >> d.Get
+            Set = binaryHelper d.Set
+            SubModelSeqBindingName = d.SubModelSeqBindingName
+            WrapDispatch = d.WrapDispatch
+          } |> SubModelSelectedItemData
+    { Name = binding.Name; Data = newData }
+
+
+module internal Bindings =
+
+  let mapModel f bindings = bindings |> List.map (Binding.mapModel f)
+
+
 
 [<AutoOpen>]
 module internal Helpers =
@@ -240,9 +304,10 @@ module internal Helpers =
     { Name = name
       Data = data }
 
-  let boxBinding binding =
+  let boxBinding (binding: Binding<'a, 'b>) : Binding<obj, obj> =
     { Name = binding.Name
-      Data = BindingData.boxBindingData unbox unbox box binding.Data }
+      Data = BindingData.boxMsg unbox box binding.Data }
+    |> Binding.mapModel unbox