Skip to content

Box BindingData output type separate from minor types #512

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
wants to merge 5 commits into from
Closed

Box BindingData output type separate from minor types #512

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
2af2c23
Remove minor type boxing on T and box at createBinding
marner2 Aug 6, 2022
fc313b0
Remove redundant boxes
marner2 Aug 6, 2022
404c358
Add type constraint for commands
marner2 Aug 6, 2022
091dd4e
Add unboxed Binding type
marner2 Dec 8, 2022
ce0a646
Add public box/unbox for Binding<> types
marner2 Dec 9, 2022
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 6 additions & 4 deletions src/Elmish.WPF/Binding.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,12 @@ module Binding =
{ Name = binding.Name
Data = binding.Data |> f }

/// Boxes the output parameter
let boxT (binding: Binding<'b, 'msg, 't>) = BindingData.boxT |> mapData <| binding

/// Unboxes the output parameter
let unboxT (binding: Binding<'b, 'msg>): Binding<'b, 'msg, 't> = BindingData.unboxT |> mapData <| binding

/// Maps the model of a binding via a contravariant mapping.
let mapModel (f: 'a -> 'b) (binding: Binding<'b, 'msg>) = f |> mapModel |> mapData <| binding

Expand Down Expand Up @@ -91,7 +97,6 @@ module Binding =
/// Elemental instance of a one-way binding.
let id<'a, 'msg> : string -> Binding<'a, 'msg> =
OneWay.id
|> BindingData.mapModel box
|> createBinding

/// Creates a one-way binding to an optional value. The binding
Expand All @@ -114,7 +119,6 @@ module Binding =
/// Elemental instance of a one-way-to-source binding.
let id<'model, 'a> : string -> Binding<'model, 'a> =
OneWayToSource.id
|> BindingData.mapMsg unbox
|> createBinding

/// Creates a one-way-to-source binding to an optional value. The binding
Expand All @@ -137,8 +141,6 @@ module Binding =
/// Elemental instance of a two-way binding.
let id<'a> : string -> Binding<'a, 'a> =
TwoWay.id
|> BindingData.mapModel box
|> BindingData.mapMsg unbox
|> createBinding

/// Creates a one-way-to-source binding to an optional value. The binding
Expand Down
121 changes: 101 additions & 20 deletions src/Elmish.WPF/BindingData.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@ module internal Elmish.WPF.BindingData

open System.Collections.ObjectModel
open System.Windows
open System.Windows.Input

open Elmish

Expand Down Expand Up @@ -159,6 +160,93 @@ and BindingData<'model, 'msg, 't> =

module BindingData =

module private MapT =

let baseCase (fOut: 't0 -> 't1) (fIn: 't1 -> 't0) =
function
| OneWayData d -> OneWayData {
Get = d.Get >> fOut
}
| OneWayToSourceData d -> OneWayToSourceData {
Set = fIn >> d.Set
}
| OneWaySeqData d -> OneWaySeqData {
Get = d.Get
CreateCollection = d.CreateCollection >> CollectionTarget.mapCollection fOut
GetId = d.GetId
ItemEquals = d.ItemEquals
}
| TwoWayData d -> TwoWayData {
Get = d.Get >> fOut
Set = fIn >> d.Set
}
| CmdData d -> CmdData {
Exec = d.Exec
CanExec = d.CanExec
AutoRequery = d.AutoRequery
}
| SubModelData d -> SubModelData {
GetModel = d.GetModel
CreateViewModel = d.CreateViewModel >> fOut
UpdateViewModel = (fun (vm,m) -> d.UpdateViewModel (fIn vm, m))
ToMsg = d.ToMsg
}
| SubModelWinData d -> SubModelWinData {
GetState = d.GetState
CreateViewModel = d.CreateViewModel >> fOut
UpdateViewModel = (fun (vm,m) -> d.UpdateViewModel (fIn vm, m))
ToMsg = d.ToMsg
GetWindow = d.GetWindow
IsModal = d.IsModal
OnCloseRequested = d.OnCloseRequested
}
| SubModelSeqUnkeyedData d -> SubModelSeqUnkeyedData {
GetModels = d.GetModels
CreateViewModel = d.CreateViewModel
CreateCollection = d.CreateCollection >> CollectionTarget.mapCollection fOut
UpdateViewModel = d.UpdateViewModel
ToMsg = d.ToMsg
}
| SubModelSeqKeyedData d -> SubModelSeqKeyedData {
GetSubModels = d.GetSubModels
CreateViewModel = d.CreateViewModel
CreateCollection = d.CreateCollection >> CollectionTarget.mapCollection fOut
UpdateViewModel = d.UpdateViewModel
ToMsg = d.ToMsg
VmToId = d.VmToId
BmToId = d.BmToId
}
| SubModelSelectedItemData d -> SubModelSelectedItemData {
Get = d.Get
Set = d.Set
SubModelSeqBindingName = d.SubModelSeqBindingName
}

let rec recursiveCase<'model, 'msg, 't0, 't1> (fOut: 't0 -> 't1) (fIn: 't1 -> 't0)
: BindingData<'model, 'msg, 't0> -> BindingData<'model, 'msg, 't1> =
function
| BaseBindingData d -> d |> baseCase fOut fIn |> BaseBindingData
| CachingData d -> d |> recursiveCase<'model, 'msg, 't0, 't1> fOut fIn |> CachingData
| ValidationData d -> ValidationData {
BindingData = recursiveCase<'model, 'msg, 't0, 't1> fOut fIn d.BindingData
Validate = d.Validate
}
| LazyData d -> LazyData {
Get = d.Get
Set = d.Set
BindingData = recursiveCase<obj, obj, 't0, 't1> fOut fIn d.BindingData
Equals = d.Equals
}
| AlterMsgStreamData d -> AlterMsgStreamData {
BindingData = recursiveCase<obj, obj, 't0, 't1> fOut fIn d.BindingData
AlterMsgStream = d.AlterMsgStream
Get = d.Get
Set = d.Set
}

let boxT b = MapT.recursiveCase box unbox b
let unboxT b = MapT.recursiveCase unbox box b

let mapModel f =
let binaryHelper binary x m = binary x (f m)
let baseCase = function
Expand Down Expand Up @@ -403,16 +491,15 @@ module BindingData =
let mapMinorTypes
(outMapA: 'a -> 'a0)
(outMapId: 'id -> 'id0)
(outMapACollection: 'aCollection -> 'aCollection0)
(inMapA: 'a0 -> 'a)
(d: OneWaySeqData<'model, 'a, 'aCollection, 'id>) = {
Get = d.Get >> Seq.map outMapA
CreateCollection = Seq.map inMapA >> d.CreateCollection >> CollectionTarget.map outMapA outMapACollection inMapA
CreateCollection = Seq.map inMapA >> d.CreateCollection >> CollectionTarget.mapA outMapA inMapA
GetId = inMapA >> d.GetId >> outMapId
ItemEquals = fun a1 a2 -> d.ItemEquals (inMapA a1) (inMapA a2)
}

let boxMinorTypes d = d |> mapMinorTypes box box box unbox
let boxMinorTypes d = d |> mapMinorTypes box box unbox

let create itemEquals getId =
{ Get = (fun x -> upcast x)
Expand Down Expand Up @@ -467,7 +554,7 @@ module BindingData =

module Cmd =

let createWithParam exec canExec autoRequery : BindingData<'model, 'msg, 't> =
let createWithParam exec canExec autoRequery : BindingData<'model, 'msg, ICommand> =
{ Exec = exec
CanExec = canExec
AutoRequery = autoRequery }
Expand Down Expand Up @@ -530,18 +617,16 @@ module BindingData =
let mapMinorTypes
(outMapBindingModel: 'bindingModel -> 'bindingModel0)
(outMapBindingMsg: 'bindingMsg -> 'bindingMsg0)
(outMapBindingViewModel: 'vm -> 'vm0)
(inMapBindingModel: 'bindingModel0 -> 'bindingModel)
(inMapBindingMsg: 'bindingMsg0 -> 'bindingMsg)
(inMapBindingViewModel: 'vm0 -> 'vm)
(d: SubModelData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm>) = {
GetModel = d.GetModel >> ValueOption.map outMapBindingModel
CreateViewModel = fun args -> d.CreateViewModel(args |> ViewModelArgs.map inMapBindingModel outMapBindingMsg) |> outMapBindingViewModel
UpdateViewModel = fun (vm, m) -> (inMapBindingViewModel vm, inMapBindingModel m) |> d.UpdateViewModel
CreateViewModel = fun args -> d.CreateViewModel(args |> ViewModelArgs.map inMapBindingModel outMapBindingMsg)
UpdateViewModel = fun (vm, m) -> (vm, inMapBindingModel m) |> d.UpdateViewModel
ToMsg = fun m bMsg -> d.ToMsg m (inMapBindingMsg bMsg)
}

let boxMinorTypes d = d |> mapMinorTypes box box box unbox unbox unbox
let boxMinorTypes d = d |> mapMinorTypes box box unbox unbox

let create createViewModel updateViewModel =
{ GetModel = id
Expand Down Expand Up @@ -577,21 +662,19 @@ module BindingData =
let mapMinorTypes
(outMapBindingModel: 'bindingModel -> 'bindingModel0)
(outMapBindingMsg: 'bindingMsg -> 'bindingMsg0)
(outMapBindingViewModel: 'vm -> 'vm0)
(inMapBindingModel: 'bindingModel0 -> 'bindingModel)
(inMapBindingMsg: 'bindingMsg0 -> 'bindingMsg)
(inMapBindingViewModel: 'vm0 -> 'vm)
(d: SubModelWinData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm>) = {
GetState = d.GetState >> WindowState.map outMapBindingModel
CreateViewModel = fun args -> d.CreateViewModel(args |> ViewModelArgs.map inMapBindingModel outMapBindingMsg) |> outMapBindingViewModel
UpdateViewModel = fun (vm, m) -> d.UpdateViewModel (inMapBindingViewModel vm, inMapBindingModel m)
CreateViewModel = fun args -> d.CreateViewModel(args |> ViewModelArgs.map inMapBindingModel outMapBindingMsg)
UpdateViewModel = fun (vm, m) -> d.UpdateViewModel (vm, inMapBindingModel m)
ToMsg = fun m bMsg -> d.ToMsg m (inMapBindingMsg bMsg)
GetWindow = d.GetWindow
IsModal = d.IsModal
OnCloseRequested = d.OnCloseRequested
}

let boxMinorTypes d = d |> mapMinorTypes box box box unbox unbox unbox
let boxMinorTypes d = d |> mapMinorTypes box box unbox unbox

let create getState createViewModel updateViewModel toMsg getWindow isModal onCloseRequested =
{ GetState = getState
Expand Down Expand Up @@ -636,19 +719,18 @@ module BindingData =
(outMapBindingModel: 'bindingModel -> 'bindingModel0)
(outMapBindingMsg: 'bindingMsg -> 'bindingMsg0)
(outMapBindingViewModel: 'vm -> 'vm0)
(outMapBindingVmCollection: 'vmCollection -> 'vmCollection0)
(inMapBindingModel: 'bindingModel0 -> 'bindingModel)
(inMapBindingMsg: 'bindingMsg0 -> 'bindingMsg)
(inMapBindingViewModel: 'vm0 -> 'vm)
(d: SubModelSeqUnkeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection>) = {
GetModels = d.GetModels >> Seq.map outMapBindingModel
CreateViewModel = fun args -> d.CreateViewModel(args |> ViewModelArgs.map inMapBindingModel outMapBindingMsg) |> outMapBindingViewModel
CreateCollection = Seq.map inMapBindingViewModel >> d.CreateCollection >> CollectionTarget.map outMapBindingViewModel outMapBindingVmCollection inMapBindingViewModel
CreateCollection = Seq.map inMapBindingViewModel >> d.CreateCollection >> CollectionTarget.mapA outMapBindingViewModel inMapBindingViewModel
UpdateViewModel = fun (vm, m) -> d.UpdateViewModel (inMapBindingViewModel vm, inMapBindingModel m)
ToMsg = fun m (idx, bMsg) -> d.ToMsg m (idx, (inMapBindingMsg bMsg))
}

let boxMinorTypes d = d |> mapMinorTypes box box box box unbox unbox unbox
let boxMinorTypes d = d |> mapMinorTypes box box box unbox unbox unbox

let create createViewModel updateViewModel =
{ GetModels = (fun x -> upcast x)
Expand Down Expand Up @@ -685,7 +767,6 @@ module BindingData =
(outMapBindingModel: 'bindingModel -> 'bindingModel0)
(outMapBindingMsg: 'bindingMsg -> 'bindingMsg0)
(outMapBindingViewModel: 'vm -> 'vm0)
(outMapBindingVmCollection: 'vmCollection -> 'vmCollection0)
(outMapId: 'id -> 'id0)
(inMapBindingModel: 'bindingModel0 -> 'bindingModel)
(inMapBindingMsg: 'bindingMsg0 -> 'bindingMsg)
Expand All @@ -694,14 +775,14 @@ module BindingData =
(d: SubModelSeqKeyedData<'model, 'msg, 'bindingModel, 'bindingMsg, 'vm, 'vmCollection, 'id>) = {
GetSubModels = d.GetSubModels >> Seq.map outMapBindingModel
CreateViewModel = fun args -> d.CreateViewModel(args |> ViewModelArgs.map inMapBindingModel outMapBindingMsg) |> outMapBindingViewModel
CreateCollection = Seq.map inMapBindingViewModel >> d.CreateCollection >> CollectionTarget.map outMapBindingViewModel outMapBindingVmCollection inMapBindingViewModel
CreateCollection = Seq.map inMapBindingViewModel >> d.CreateCollection >> CollectionTarget.mapA outMapBindingViewModel inMapBindingViewModel
UpdateViewModel = fun (vm, m) -> (inMapBindingViewModel vm, inMapBindingModel m) |> d.UpdateViewModel
ToMsg = fun m (id, bMsg) -> d.ToMsg m ((inMapId id), (inMapBindingMsg bMsg))
BmToId = inMapBindingModel >> d.BmToId >> outMapId
VmToId = fun vm -> vm |> inMapBindingViewModel |> d.VmToId |> outMapId
}

let boxMinorTypes d = d |> mapMinorTypes box box box box box unbox unbox unbox unbox
let boxMinorTypes d = d |> mapMinorTypes box box box box unbox unbox unbox unbox

let create createViewModel updateViewModel bmToId vmToId =
{ GetSubModels = (fun x -> upcast x)
Expand Down
10 changes: 8 additions & 2 deletions src/Elmish.WPF/DynamicViewModel.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,16 +9,22 @@ open Microsoft.Extensions.Logging
open BindingVmHelpers

/// Represents all necessary data used to create a binding.
type Binding<'model, 'msg> =
type Binding<'model, 'msg, 't> =
internal
{ Name: string
Data: BindingData<'model, 'msg, obj> }
Data: BindingData<'model, 'msg, 't> }

type Binding<'model, 'msg> = Binding<'model, 'msg, obj>


[<AutoOpen>]
module internal Helpers =

let createBinding data name =
{ Name = name
Data = data |> BindingData.boxT }

let createBindingT data name =
{ Name = name
Data = data }

Expand Down
8 changes: 2 additions & 6 deletions src/Elmish.WPF/Merge.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ module CollectionTarget =
Enumerate = fun () -> upcast oc
GetCollection = fun () -> oc }

let private mapA (fOut: 'a0 -> 'a1) (fIn: 'a1 -> 'a0) (ct: CollectionTarget<'a0, 'aCollection>) : CollectionTarget<'a1, 'aCollection> =
let mapA (fOut: 'a0 -> 'a1) (fIn: 'a1 -> 'a0) (ct: CollectionTarget<'a0, 'aCollection>) : CollectionTarget<'a1, 'aCollection> =
{ GetLength = ct.GetLength
GetAt = ct.GetAt >> fOut
Append = fIn >> ct.Append
Expand All @@ -54,7 +54,7 @@ module CollectionTarget =
Enumerate = ct.Enumerate >> Seq.map fOut
GetCollection = ct.GetCollection }

let private mapCollection (fOut: 'aCollection0 -> 'aCollection1) (ct: CollectionTarget<'a, 'aCollection0>) : CollectionTarget<'a, 'aCollection1> =
let mapCollection (fOut: 'aCollection0 -> 'aCollection1) (ct: CollectionTarget<'a, 'aCollection0>) : CollectionTarget<'a, 'aCollection1> =
{ GetLength = ct.GetLength
GetAt = ct.GetAt
Append = ct.Append
Expand All @@ -66,10 +66,6 @@ module CollectionTarget =
Enumerate = ct.Enumerate
GetCollection = ct.GetCollection >> fOut }

let map outMapA outMapCollection inMapA =
mapA outMapA inMapA
>> mapCollection outMapCollection

Comment on lines -69 to -72
Copy link
Contributor

@LyndonGingerich LyndonGingerich Sep 8, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

From #470 (comment):

I am not convinced that the changes in this file are needed yet. For example, BindingData.OneWaySeq.boxMinorTypes boxes 'a while Helpers.createBinding boxes 'aCollection. Can you change this PR so that aCollection is boxed in each binding type's boxMinorTypes function?

-- @TysonMN

When we add the 't type parameter to BindingData, we are promoting types like 'aCollection from a "minor" type to a major type. Subsequently (to maintain backwards compatibility) Helpers.createBinding boxes one of the major types of BindingData (ie, 't) so that we don't break existing code.

In one of the next PRs, we will be adding something like Helpers.createBindingT that doesn't box the major type, and then use it in the new StaticHelper class.

-- @marner2

Copy link
Member

@TysonMN TysonMN Sep 11, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is less efficient and convincingly correct for you static code, but what about (just to start) you unbox 't in the future PR instead of merging this PR?

Copy link
Collaborator Author

@marner2 marner2 Sep 12, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I think you mean just merging #511 first? I actually split them apart so you can merge that one first.

In the end though, we need this type passed all the way through, otherwise we'll be stuck putting type annotations on the view model properties.

Copy link
Collaborator Author

@marner2 marner2 Oct 3, 2022

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@TysonMN I am starting to do (approximately) this in #522.



module Merge =
Expand Down