Merge branch 'master' into v4

src/Samples/SubModelSeq/Program.fs

@@ -6,6 +6,11 @@ open Serilog.Extensions.Logging
 open Elmish.WPF
 
 
+type InOutMsg<'InMsg, 'OutMsg> =
+  | InMsg of 'InMsg
+  | OutMsg of 'OutMsg
+
+
 module Option =
 
   let set a = Option.map (fun _ -> a)
@@ -168,6 +173,11 @@ module App =
     | MoveUp of Guid
     | MoveDown of Guid
 
+  type SubtreeOutMsg =
+    | OutRemove
+    | OutMoveUp
+    | OutMoveDown
+
   type Msg =
     | ToggleGlobalState
     | SubtreeMsg of RoseTreeMsg<Guid, SubtreeMsg>
@@ -217,6 +227,11 @@ module App =
     | ToggleGlobalState -> mapSomeGlobalState not
     | SubtreeMsg msg -> msg |> RoseTree.update hasId updateSubtree |> mapDummyRoot
 
+  let mapOutMsg = function
+    | OutRemove -> Remove
+    | OutMoveUp -> MoveUp
+    | OutMoveDown -> MoveDown
+
 
 module Bindings =
 
@@ -229,57 +244,56 @@ module Bindings =
   let moveUpMsg (_, { Parent = p; Self = s }) =
     match p.Children |> List.tryHead with
     | Some c when c.Data.Id <> s.Data.Id ->
-        s.Data.Id |> MoveUp |> Some
+        OutMoveUp |> OutMsg |> Some
     | _ -> None
 
   let moveDownMsg (_, { Parent = p; Self = s }) =
     match p.Children |> List.tryLast with
     | Some c when c.Data.Id <> s.Data.Id ->
-        s.Data.Id |> MoveDown |> Some
+        OutMoveDown |> OutMsg |> Some
     | _ -> None
-
-  let adjustMsgToParent msg =
-    match msg with
-    | BranchMsg (pId, LeafMsg (Remove   cId)) when pId = cId -> LeafMsg (Remove cId)
-    | BranchMsg (pId, LeafMsg (MoveUp   cId)) when pId = cId -> LeafMsg (MoveUp cId)
-    | BranchMsg (pId, LeafMsg (MoveDown cId)) when pId = cId -> LeafMsg (MoveDown cId)
-    | _ -> msg
-
-  let rec subtreeBindings () : Binding<Model * SelfWithParent<RoseTree<Identifiable<Counter>>>, RoseTreeMsg<Guid, SubtreeMsg>> list =
+
+  let rec subtreeBindings () : Binding<Model * SelfWithParent<RoseTree<Identifiable<Counter>>>, InOutMsg<RoseTreeMsg<Guid, SubtreeMsg>, SubtreeOutMsg>> list =
     let counterBindings =
       Counter.bindings ()
       |> Bindings.mapModel (fun (_, { Self = s }) -> s.Data.Value)
       |> Bindings.mapMsg (CounterMsg >> LeafMsg)
-    let newBindings =
-      [
-        "CounterIdText" |> Binding.oneWay(fun (_, { Self = s }) -> s.Data.Id)
-
-        "Remove" |> Binding.cmd(fun (_, { Self = s }) -> s.Data.Id |> Remove |> LeafMsg)
-
+
+    let inMsgBindings =
+      [ "CounterIdText" |> Binding.oneWay(fun (_, { Self = s }) -> s.Data.Id)
         "AddChild" |> Binding.cmd(AddChild |> LeafMsg)
-
-        "MoveUp" |> Binding.cmdIf(moveUpMsg |> FuncOption.map LeafMsg)
-        "MoveDown" |> Binding.cmdIf(moveDownMsg |> FuncOption.map LeafMsg)
-
         "GlobalState" |> Binding.oneWay(fun (m, _) -> m.SomeGlobalState)
-
         "ChildCounters" |> Binding.subModelSeq(
           (fun (_, { Self = p }) -> p.Children |> Seq.map (fun c -> { Self = c; Parent = p })),
           (fun ((m, _), selfAndParent) -> (m, selfAndParent)),
           (fun (_, { Self = c }) -> c.Data.Id),
-          BranchMsg >> adjustMsgToParent,
+          (fun (cId, inOutMsg) ->
+            match inOutMsg with
+            | InMsg msg -> (cId, msg) |> BranchMsg
+            | OutMsg msg -> cId |> mapOutMsg msg |> LeafMsg),
           subtreeBindings)
-      ]
-    [ counterBindings
-      newBindings ]
+      ] @ counterBindings
+      |> Bindings.mapMsg InMsg
+
+    let outMsgBindings =
+      [ "Remove" |> Binding.cmd(OutRemove |> OutMsg)
+        "MoveUp" |> Binding.cmdIf moveUpMsg
+        "MoveDown" |> Binding.cmdIf moveDownMsg ]
+
+    [ outMsgBindings
+      inMsgBindings ]
     |> List.concat
 
 
   let rootBindings () : Binding<Model, Msg> list = [
     "Counters" |> Binding.subModelSeq(
       (fun m -> m.DummyRoot.Children |> Seq.map (fun c -> { Self = c; Parent = m.DummyRoot })),
       (fun { Self = c } -> c.Data.Id),
-      BranchMsg >> adjustMsgToParent >> SubtreeMsg,
+      (fun (cId, inOutMsg) ->
+        match inOutMsg with
+        | InMsg msg -> (cId, msg) |> BranchMsg
+        | OutMsg msg -> cId |> mapOutMsg msg |> LeafMsg
+        |> SubtreeMsg),
       subtreeBindings)
 
     "ToggleGlobalState" |> Binding.cmd ToggleGlobalState