diff --git a/src/Fabulous/Builders.fs b/src/Fabulous/Builders.fs index 936861bf0..3739bc354 100644 --- a/src/Fabulous/Builders.fs +++ b/src/Fabulous/Builders.fs @@ -1,6 +1,7 @@ namespace Fabulous open System.ComponentModel +open Fabulous.WidgetAttributeDefinitions open Fabulous.WidgetCollectionAttributeDefinitions open Fabulous.StackAllocatedCollections open Fabulous.StackAllocatedCollections.StackList @@ -217,3 +218,51 @@ type AttributeCollectionBuilder<'msg, 'marker, 'itemMarker> = res end + +type SingleChildBuilderStep<'msg, 'marker> = delegate of unit -> WidgetBuilder<'msg, 'marker> + +[] +type SingleChildBuilder<'msg, 'marker, 'childMarker> = + val WidgetKey: WidgetKey + val Attr: WidgetAttributeDefinition + val AttributesBundle: AttributesBundle + + new(widgetKey: WidgetKey, attr: WidgetAttributeDefinition) = + { WidgetKey = widgetKey + Attr = attr + AttributesBundle = AttributesBundle(StackList.empty(), ValueNone, ValueNone) } + + new(widgetKey: WidgetKey, attr: WidgetAttributeDefinition, attributesBundle: AttributesBundle) = + { WidgetKey = widgetKey + Attr = attr + AttributesBundle = attributesBundle } + + member inline this.Yield(widget: WidgetBuilder<'msg, 'childMarker>) = + SingleChildBuilderStep(fun () -> widget) + + member inline this.Combine + ( + [] a: SingleChildBuilderStep<'msg, 'childMarker>, + [] _b: SingleChildBuilderStep<'msg, 'childMarker> + ) = + SingleChildBuilderStep(fun () -> + // We only want one child, so we ignore the second one + a.Invoke()) + + member inline this.Delay([] fn: unit -> SingleChildBuilderStep<'msg, 'childMarker>) = + SingleChildBuilderStep(fun () -> fn().Invoke()) + + member inline this.Run([] result: SingleChildBuilderStep<'msg, 'childMarker>) = + let childAttr = this.Attr.WithValue(result.Invoke().Compile()) + let struct (scalars, widgets, widgetCollections) = this.AttributesBundle + + WidgetBuilder<'msg, 'marker>( + this.WidgetKey, + AttributesBundle( + scalars, + (match widgets with + | ValueNone -> ValueSome [| childAttr |] + | ValueSome widgets -> ValueSome(Array.appendOne childAttr widgets)), + widgetCollections + ) + ) diff --git a/src/Fabulous/Component/Binding.fs b/src/Fabulous/Component/Binding.fs index c684e51b2..60d1046d8 100644 --- a/src/Fabulous/Component/Binding.fs +++ b/src/Fabulous/Component/Binding.fs @@ -54,7 +54,7 @@ type BindingExtensions = ( _: ComponentBuilder, [] request: Binding<'T>, - [] continuation: BindingValue<'T> -> ComponentBodyBuilder<'msg, 'marker> + [] continuation: BindingValue<'T> -> ComponentBodyBuilder<'marker> ) = // Despite its name, ComponentBinding actual value is not stored in this component, but in the source component // So, we do not need to increment the number of bindings here diff --git a/src/Fabulous/Component/Builder.fs b/src/Fabulous/Component/Builder.fs index c52382c20..f7ba82edd 100644 --- a/src/Fabulous/Component/Builder.fs +++ b/src/Fabulous/Component/Builder.fs @@ -2,15 +2,14 @@ namespace Fabulous /// Delegate used by the ComponentBuilder to compose a component body /// It will be aggressively inlined by the compiler leaving no overhead, only a pure function that returns a WidgetBuilder -type ComponentBodyBuilder<'msg, 'marker> = - delegate of bindings: int * context: ComponentContext -> struct (int * WidgetBuilder<'msg, 'marker>) +type ComponentBodyBuilder<'marker> = delegate of bindings: int * context: ComponentContext -> struct (int * WidgetBuilder) type ComponentBuilder() = - member inline this.Yield(widgetBuilder: WidgetBuilder<'msg, 'marker>) = - ComponentBodyBuilder<'msg, 'marker>(fun bindings ctx -> struct (bindings, widgetBuilder)) + member inline this.Yield(widgetBuilder: WidgetBuilder) = + ComponentBodyBuilder<'marker>(fun bindings ctx -> struct (bindings, widgetBuilder)) - member inline this.Combine([] a: ComponentBodyBuilder<'msg, 'marker>, [] b: ComponentBodyBuilder<'msg, 'marker>) = - ComponentBodyBuilder<'msg, 'marker>(fun bindings ctx -> + member inline this.Combine([] a: ComponentBodyBuilder<'marker>, [] b: ComponentBodyBuilder<'marker>) = + ComponentBodyBuilder<'marker>(fun bindings ctx -> let struct (bindingsA, _) = a.Invoke(bindings, ctx) // discard the previous widget in the chain but we still need to count the bindings let struct (bindingsB, resultB) = b.Invoke(bindings, ctx) @@ -19,15 +18,15 @@ type ComponentBuilder() = struct (resultBindings, resultB)) - member inline this.Delay([] fn: unit -> ComponentBodyBuilder<'msg, 'marker>) = - ComponentBodyBuilder<'msg, 'marker>(fun bindings ctx -> + member inline this.Delay([] fn: unit -> ComponentBodyBuilder<'marker>) = + ComponentBodyBuilder<'marker>(fun bindings ctx -> let sub = fn() sub.Invoke(bindings, ctx)) - member inline this.Run([] body: ComponentBodyBuilder<'msg, 'marker>) = + member inline this.Run([] body: ComponentBodyBuilder<'marker>) = let compiledBody = ComponentBody(fun ctx -> let struct (_, result) = body.Invoke(0, ctx) struct (ctx, result.Compile())) - WidgetBuilder<'msg, 'marker>(Component.WidgetKey, Component.Body.WithValue(compiledBody)) + WidgetBuilder(ComponentWidget.WidgetKey, Component.Body.WithValue(compiledBody)) diff --git a/src/Fabulous/Component/Component.fs b/src/Fabulous/Component/Component.fs index a93a932c3..7f1e0dad8 100644 --- a/src/Fabulous/Component/Component.fs +++ b/src/Fabulous/Component/Component.fs @@ -205,37 +205,67 @@ avatar1.Background <- Blue type ComponentBody = delegate of ComponentContext -> struct (ComponentContext * Widget) -type Component(treeContext: ViewTreeContext, body: ComponentBody, context: ComponentContext) = - let mutable _body = body - let mutable _context = context - let mutable _widget = Unchecked.defaultof<_> - let mutable _view = null - let mutable _contextSubscription: IDisposable = null +type IBaseComponent = + inherit IDisposable +type IComponent = + inherit IBaseComponent + abstract member SetBody: ComponentBody -> unit + abstract member SetContext: ComponentContext -> unit + +module Component = // TODO: This is a big code smell. We should not do this but I can't think of a better way to do it right now. // The implementation of this method is set by the consuming project: Fabulous.XamarinForms, Fabulous.Maui, Fabulous.Avalonia - static let mutable _setAttachedComponent: obj -> Component -> unit = + let mutable setAttachedComponent: obj -> IBaseComponent -> unit = fun _ _ -> failwith "Please call Component.SetComponentFunctions() before using Component" - static let mutable _getAttachedComponent: obj -> Component = + let mutable getAttachedComponent: obj -> IBaseComponent = fun _ -> failwith "Please call Component.SetComponentFunctions() before using Component" - static member SetComponentFunctions(get: obj -> Component, set: obj -> Component -> unit) = - _getAttachedComponent <- get - _setAttachedComponent <- set + let setComponentFunctions (get: obj -> IBaseComponent, set: obj -> IBaseComponent -> unit) = + getAttachedComponent <- get + setAttachedComponent <- set - static member GetAttachedComponent(view: obj) = _getAttachedComponent view - static member SetAttachedComponent(view: obj, comp: Component) = _setAttachedComponent view comp + /// TODO: This is actually broken. On every call of the parent, the body will be reassigned to the Component triggering a re-render because of the noCompare. + /// This is not what was expected. The body should actually be invalidated based on its context. + let Body = + Attributes.defineSimpleScalar "Component_Body" ScalarAttributeComparers.noCompare (fun _ currOpt node -> + let target = getAttachedComponent(node.Target) :?> IComponent - member this.SetBody(body: ComponentBody) = - _body <- body - this.Render() + match currOpt with + | ValueNone -> failwith "Component widget must have a body" + | ValueSome body -> target.SetBody(body)) - member this.SetContext(context: ComponentContext) = - _contextSubscription.Dispose() - _contextSubscription <- context.RenderNeeded.Subscribe(this.Render) - _context <- context - this.Render() + let Context = + Attributes.defineSimpleScalar "Component_Context" ScalarAttributeComparers.equalityCompare (fun _ currOpt node -> + let target = getAttachedComponent(node.Target) :?> IComponent + + match currOpt with + | ValueNone -> target.SetContext(ComponentContext()) + | ValueSome context -> target.SetContext(context)) + +type Component(treeContext: ViewTreeContext, body: ComponentBody, context: ComponentContext) = + let mutable _body = body + let mutable _context = context + let mutable _widget = Unchecked.defaultof<_> + let mutable _view = null + let mutable _contextSubscription: IDisposable = null + + interface IComponent with + member this.SetBody(body: ComponentBody) = + _body <- body + this.Render() + + member this.SetContext(context: ComponentContext) = + _contextSubscription.Dispose() + _contextSubscription <- context.RenderNeeded.Subscribe(this.Render) + _context <- context + this.Render() + + member this.Dispose() = + if _contextSubscription <> null then + _contextSubscription.Dispose() + _contextSubscription <- null member this.CreateView(componentWidget: Widget) = let struct (context, rootWidget) = _body.Invoke(_context) @@ -246,7 +276,8 @@ type Component(treeContext: ViewTreeContext, body: ComponentBody, context: Compo let scalars = match componentWidget.ScalarAttributes with | ValueNone -> ValueNone - | ValueSome attrs -> ValueSome(Array.skip 2 attrs) // Skip the Component_Body and Component_Context attributes + | ValueSome attrs -> + ValueSome(Array.filter (fun (attr: ScalarAttribute) -> attr.Key <> Component.Body.Key && attr.Key <> Component.Context.Key) attrs) let rootWidget: Widget = { Key = rootWidget.Key @@ -277,7 +308,7 @@ type Component(treeContext: ViewTreeContext, body: ComponentBody, context: Compo let struct (node, view) = widgetDef.CreateView(rootWidget, treeContext, ValueNone) _view <- view - Component.SetAttachedComponent(view, this) + Component.setAttachedComponent view this _contextSubscription <- _context.RenderNeeded.Subscribe(this.Render) @@ -298,31 +329,7 @@ type Component(treeContext: ViewTreeContext, body: ComponentBody, context: Compo Reconciler.update treeContext.CanReuseView (ValueSome prevRootWidget) currRootWidget viewNode - interface IDisposable with - member this.Dispose() = - if _contextSubscription <> null then - _contextSubscription.Dispose() - _contextSubscription <- null - -module Component = - /// TODO: This is actually broken. On every call of the parent, the body will be reassigned to the Component triggering a re-render because of the noCompare. - /// This is not what was expected. The body should actually be invalidated based on its context. - let Body = - Attributes.defineSimpleScalar "Component_Body" ScalarAttributeComparers.noCompare (fun _ currOpt node -> - let target = Component.GetAttachedComponent(node.Target) - - match currOpt with - | ValueNone -> failwith "Component widget must have a body" - | ValueSome body -> target.SetBody(body)) - - let Context = - Attributes.defineSimpleScalar "Component_Context" ScalarAttributeComparers.equalityCompare (fun _ currOpt node -> - let target = Component.GetAttachedComponent(node.Target) - - match currOpt with - | ValueNone -> target.SetContext(ComponentContext()) - | ValueSome context -> target.SetContext(context)) - +module ComponentWidget = let WidgetKey = let key = WidgetDefinitionStore.getNextKey() @@ -334,17 +341,17 @@ module Component = CreateView = fun (widget, treeContext, _) -> match widget.ScalarAttributes with - | ValueNone -> failwith "Component widget must have a body" + | ValueNone -> failwith "Component widget must have a body and a context" | ValueSome attrs -> let body = - match Array.tryFind (fun (attr: ScalarAttribute) -> attr.Key = Body.Key) attrs with + match Array.tryFind (fun (attr: ScalarAttribute) -> attr.Key = Component.Body.Key) attrs with | Some attr -> attr.Value :?> ComponentBody | None -> failwith "Component widget must have a body" let context = - match Array.tryFind (fun (attr: ScalarAttribute) -> attr.Key = Context.Key) attrs with + match Array.tryFind (fun (attr: ScalarAttribute) -> attr.Key = Component.Context.Key) attrs with | Some attr -> attr.Value :?> ComponentContext - | None -> failwith "Component widget must have a context" + | None -> ComponentContext() let comp = new Component(treeContext, body, context) let struct (node, view) = comp.CreateView(widget) diff --git a/src/Fabulous/Component/Context.fs b/src/Fabulous/Component/Context.fs index 6e524dffa..2c2f52a3e 100644 --- a/src/Fabulous/Component/Context.fs +++ b/src/Fabulous/Component/Context.fs @@ -1,5 +1,7 @@ namespace Fabulous +open System.ComponentModel + (* ARCHITECTURE NOTES: @@ -20,11 +22,14 @@ type binding /// /// Holds the values for the various states of a component. /// -type ComponentContext() = - // We assume that most components will have few values, so initialize it with a small array - let mutable values = Array.zeroCreate 3 +type ComponentContext(initialSize: int) = + let mutable values = Array.zeroCreate initialSize let renderNeeded = Event() + + // We assume that most components will have few values, so initialize it with a small array + new() = ComponentContext(3) + member this.RenderNeeded = renderNeeded.Publish member this.NeedsRender() = renderNeeded.Trigger() @@ -48,7 +53,8 @@ type ComponentContext() = else ValueSome(unbox<'T> value) - member internal this.SetValueInternal(key: int, value: 'T) = values[key] <- box value + [] + member this.SetValueInternal(key: int, value: 'T) = values[key] <- box value member this.SetValue(key: int, value: 'T) = values[key] <- box value diff --git a/src/Fabulous/Component/MvuComponent.fs b/src/Fabulous/Component/MvuComponent.fs new file mode 100644 index 000000000..68f0ad73e --- /dev/null +++ b/src/Fabulous/Component/MvuComponent.fs @@ -0,0 +1,180 @@ +namespace Fabulous + +open Fabulous.Runners +open Fabulous.ScalarAttributeDefinitions + +type Init<'msg, 'model> = unit -> 'model * Cmd<'msg> +type Update<'msg, 'model> = 'msg -> 'model -> 'model * Cmd<'msg> + +// This MvuComponent is a proxy widget just like Component +// but its specificity is to override the ViewTreeContext.Dispatch +// with its own mvu.Dispatch to allow implicit dispatching in its children just like with Fabulous 2 DSL +type MvuComponentBodyStep<'msg, 'model, 'marker> = delegate of 'model -> WidgetBuilder<'msg, 'marker> +type MvuComponentBody = delegate of obj -> Widget + +[] +type MvuComponentData = + { Program: Program + Arg: obj + Body: MvuComponentBody } + +type IMvuComponent = + inherit IBaseComponent + abstract member SetData: MvuComponentData -> unit + +type MvuComponent(treeContext: ViewTreeContext, data: MvuComponentData, context: ComponentContext) as this = + let mutable _body = data.Body + let mutable _arg = data.Arg + + let mutable _runner = + Runner(0, this.GetModel, this.SetModel, data.Program) + + let mutable _context = context + let mutable _widget = Unchecked.defaultof + let mutable _view = null + let mutable _contextSubscription = null + + interface IMvuComponent with + member this.SetData(data: MvuComponentData) = + _body <- data.Body + _arg <- data.Arg + // TODO: We should probably reset the runner here + this.Render() + + member this.Dispose() = + if _contextSubscription <> null then + _contextSubscription.Dispose() + _contextSubscription <- null + + member private this.GetModel(key: StateKey) = + match _context.TryGetValue(key) with + | ValueSome model -> model + | ValueNone -> + let initialModel, cmd = _runner.Program.Init _arg + _context.SetValueInternal(0, initialModel) + + for sub in cmd do + _runner.Dispatch(sub) + + initialModel + + member private this.SetModel (key: StateKey) (model: obj) = _context.SetValue(key, model) + + member this.Dispatch(msg: obj) = _runner.Dispatch(msg) + + member this.CreateView() = + let widget = _body.Invoke(this.GetModel(0)) + _widget <- widget + + // Replace the global dispatch with the one from the MvuComponent + // so the child widgets can dispatch implicitly + let treeContext = + { treeContext with + Dispatch = this.Dispatch } + + // Create the actual view + let widgetDef = WidgetDefinitionStore.get widget.Key + let struct (node, view) = widgetDef.CreateView(widget, treeContext, ValueNone) + _view <- view + + _contextSubscription <- _context.RenderNeeded.Subscribe(this.Render) + + struct (node, view) + + member this.Render() = + let prevWidget = _widget + let widget = _body.Invoke(this.GetModel(0)) + _widget <- widget + + let viewNode = treeContext.GetViewNode _view + + Reconciler.update treeContext.CanReuseView (ValueSome prevWidget) widget viewNode + + +module MvuComponent = + let Data: SimpleScalarAttributeDefinition = + Attributes.defineSimpleScalar "MvuComponent_Data" ScalarAttributeComparers.noCompare (fun _ currOpt node -> + let comp = Component.getAttachedComponent(node.Target) :?> IMvuComponent + + match currOpt with + | ValueNone -> failwith "MvuComponent widget must have an associated MvuComponentData" + | ValueSome data -> comp.SetData data) + + let WidgetKey = + let key = WidgetDefinitionStore.getNextKey() + + let definition = + { Key = key + Name = "MvuContext" + TargetType = typeof + AttachView = fun _ -> failwith "MvuComponent widget cannot be attached" + CreateView = + (fun (widget, treeContext, _parentNode) -> + let data = + match widget.ScalarAttributes with + | ValueNone -> failwith "MvuComponent widget must have an associated MvuComponentData" + | ValueSome attrs -> + match Array.tryFind (fun (attr: ScalarAttribute) -> attr.Key = Data.Key) attrs with + | None -> failwith "MvuComponent widget must have an associated MvuComponentData" + | Some attr -> attr.Value :?> MvuComponentData + + let comp = new MvuComponent(treeContext, data, ComponentContext(1)) + let struct (node, view) = comp.CreateView() + struct (node, view)) } + + WidgetDefinitionStore.set key definition + + key + +[] +type MvuStateRequest = | MvuStateRequest + +type Mvu = + static member inline State = MvuStateRequest + +/// This is a builder that allows to build a MvuContext widget +/// It is almost identical to SingleChildBuilder, except the resulting WidgetBuilder will have a 'msg type of unit +/// because the MvuContext widget will handle its own dispatching internally +[] +type MvuComponentBuilder<'arg, 'msg, 'model, 'marker> = + val public Program: Program + val public Arg: obj + + new(program: Program<'arg, 'model, 'msg>, arg: 'arg) = + let program: Program = + { Init = fun arg -> let model, cmd = program.Init(unbox arg) in (box model, Cmd.map box cmd) + Update = fun (msg, model) -> let model, cmd = program.Update(unbox msg, unbox model) in (box model, Cmd.map box cmd) + Subscribe = fun model -> Cmd.map box (program.Subscribe(unbox model)) + Logger = program.Logger + ExceptionHandler = program.ExceptionHandler } + + { Program = program; Arg = arg } + + member inline this.Bind(_value: MvuStateRequest, [] continuation: 'model -> MvuComponentBodyStep<'msg, 'model, 'marker>) = + MvuComponentBodyStep(fun model -> (continuation model).Invoke(model)) + + member inline this.Yield(widget: WidgetBuilder<'msg, 'marker>) = + MvuComponentBodyStep(fun model -> widget) + + member inline this.Combine + ( + [] a: MvuComponentBodyStep<'msg, 'model, 'marker>, + [] _b: MvuComponentBodyStep<'msg, 'model, 'marker> + ) = + MvuComponentBodyStep(fun model -> + // We only want one child, so we ignore the second one + a.Invoke(model)) + + member inline this.Delay([] fn: unit -> MvuComponentBodyStep<'msg, 'model, 'marker>) = + MvuComponentBodyStep(fun model -> fn().Invoke(model)) + + member this.Run(result: MvuComponentBodyStep<'msg, 'model, 'marker>) = + let body = + MvuComponentBody(fun model -> result.Invoke(unbox<'model> model).Compile()) + + let data = + { Program = this.Program + Arg = this.Arg + Body = body } + + WidgetBuilder(MvuComponent.WidgetKey, MvuComponent.Data.WithValue(data)) diff --git a/src/Fabulous/Component/State.fs b/src/Fabulous/Component/State.fs index f6357ee11..bf8de6d1f 100644 --- a/src/Fabulous/Component/State.fs +++ b/src/Fabulous/Component/State.fs @@ -70,9 +70,9 @@ type StateExtensions = ( _: ComponentBuilder, [] fn: State<'T>, - [] continuation: StateValue<'T> -> ComponentBodyBuilder<'msg, 'marker> + [] continuation: StateValue<'T> -> ComponentBodyBuilder<'marker> ) = - ComponentBodyBuilder<'msg, 'marker>(fun bindings ctx -> + ComponentBodyBuilder<'marker>(fun bindings ctx -> let key = int bindings let value = diff --git a/src/Fabulous/Fabulous.fsproj b/src/Fabulous/Fabulous.fsproj index 615134e71..a688d8bfa 100644 --- a/src/Fabulous/Fabulous.fsproj +++ b/src/Fabulous/Fabulous.fsproj @@ -35,6 +35,7 @@ + @@ -47,6 +48,7 @@ +