Fabulous wrapper for alexrainman/CarouselView

CarouselViewExtension.fs

(*
The MIT License
CarouselViewExtension - Fabulous wrapper for alexrainman/CarouselView
Copyright(c) 2019 cannorin, Peano System Inc.
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
*)

// see https://github.com/alexrainman/CarouselView/blob/master/README.md for details

namespace Fabulous.DynamicViews

type CarouselViewControl     = CarouselView.FormsPlugin.Abstractions.CarouselViewControl
type CarouselViewOrientation = CarouselView.FormsPlugin.Abstractions.CarouselViewOrientation
type ScrollDirection         = CarouselView.FormsPlugin.Abstractions.ScrollDirection
type IndicatorsShape         = CarouselView.FormsPlugin.Abstractions.IndicatorsShape

[<AutoOpen>]
module CarouselViewExtension =
  open System
  open Xamarin.Forms
  open Fabulous.DynamicViews
  open CarouselView.FormsPlugin.Abstractions

  [<RequireQualifiedAccess>]
  module private AttrKeys =
    let inline private create name = AttributeKey (sprintf "CarouselViewControl_%s" name)
    let ItemsSource = create "ItemsSource"
    let Position    = create "Position"
    let Orientation = create "Orientation"
    let InterPageSpacing = create "InterPageSpacing"
    let IsSwipeEnabled = create "IsSwipeEnabled"
    let IndicatorsTintColor = create "IndicatorsTintColor"
    let CurrentPageIndicatorTintColor = create "CurrentPageIndicatorTintColor"
    let IndicatorsShape = create "IndicatorsShape"
    let AnimateTransition = create "AnimateTransition"
    let ShowArrows = create "ShowArrows"
    let ArrowsBackgroundColor = create "ArrowBackgroundColor"
    let ArrowsTintColor = create "ArrowsTintColor"
    let ArrowsTransparency = create "ArrowsTransparency"
    let PositionSelected = create "PositionSelected"
    let Scrolled = create "Scrolled"

  type Fabulous.DynamicViews.View with
    static member CarouselViewControl
      ( ?itemsSource: ViewElement list, ?position: int, ?orientation: CarouselViewOrientation, ?interPageSpacing: int,
        ?isSwipeEnabled: bool, ?indicatorsTintColor: Color, ?currentPageIndicatorTintColor: Color, ?indicatorsShape: IndicatorsShape,
        ?animateTransition: bool, ?showArrows: bool, ?arrowsBackgroundColor: Color, ?arrowsTintColor: Color, ?arrowsTransparency: float32,
        ?positionSelected: _ -> unit, ?scrolled: _ -> unit,
        // inherited attributes common to all views
        ?horizontalOptions, ?verticalOptions, ?margin, ?gestureRecognizers, ?anchorX, ?anchorY, ?backgroundColor, 
        ?heightRequest, ?inputTransparent, ?isEnabled, ?isVisible, ?minimumHeightRequest, ?minimumWidthRequest, ?opacity,
        ?rotation, ?rotationX, ?rotationY, ?scale, ?style, ?translationX, ?translationY, ?widthRequest,
        ?resources, ?styles, ?styleSheets, ?classId, ?styleId, ?automationId, ?created, ?styleClass) =
      let attribCount =
        let inline count vo = match vo with Some _ -> 1 | None -> 0
        count itemsSource + count position + count orientation + count interPageSpacing
        + count isSwipeEnabled + count indicatorsTintColor + count currentPageIndicatorTintColor + count indicatorsShape
        + count animateTransition + count showArrows + count arrowsBackgroundColor + count arrowsTintColor + count arrowsTransparency
        + count positionSelected + count scrolled

      let attribs =
        let created =
          created |> Option.map (fun f (x: obj) ->
            match x with :? CarouselViewControl as x -> f x | _ -> ())
        ViewBuilders.BuildView(attribCount, ?horizontalOptions=horizontalOptions, ?verticalOptions=verticalOptions,
                       ?margin=margin, ?gestureRecognizers=gestureRecognizers, ?anchorX=anchorX, ?anchorY=anchorY,
                       ?backgroundColor=backgroundColor, ?heightRequest=heightRequest, ?inputTransparent=inputTransparent,
                       ?isEnabled=isEnabled, ?isVisible=isVisible, ?minimumHeightRequest=minimumHeightRequest,
                       ?minimumWidthRequest=minimumWidthRequest, ?opacity=opacity, ?rotation=rotation,
                       ?rotationX=rotationX, ?rotationY=rotationY, ?scale=scale, ?style=style,
                       ?translationX=translationX, ?translationY=translationY, ?widthRequest=widthRequest,
                       ?resources=resources, ?styles=styles, ?styleSheets=styleSheets, ?classId=classId, ?styleId=styleId, 
                       ?automationId=automationId, ?created=created, ?styleClass=styleClass)

      do
        // add carousel-specific parameters to the attributes
        let inline add key vo = match vo with None -> () | Some v -> attribs.Add(key, v)
        add AttrKeys.ItemsSource itemsSource
        add AttrKeys.Position position
        add AttrKeys.Orientation orientation
        add AttrKeys.InterPageSpacing interPageSpacing
        add AttrKeys.IsSwipeEnabled isSwipeEnabled
        add AttrKeys.IndicatorsTintColor indicatorsTintColor
        add AttrKeys.CurrentPageIndicatorTintColor currentPageIndicatorTintColor
        add AttrKeys.IndicatorsShape indicatorsShape
        add AttrKeys.AnimateTransition animateTransition
        add AttrKeys.ShowArrows showArrows
        add AttrKeys.ArrowsBackgroundColor arrowsBackgroundColor
        add AttrKeys.ArrowsTintColor arrowsTintColor
        add AttrKeys.ArrowsTransparency arrowsTransparency
        let inline addEvent key vo =
          match vo with
            | None -> ()
            | Some v -> attribs.Add(key, EventHandler<_>(fun _ arg -> v arg))
        addEvent AttrKeys.PositionSelected positionSelected
        addEvent AttrKeys.Scrolled scrolled

      // The create method
      let create () =
        let cvc = CarouselViewControl()
        cvc

      // The update method
      let update (prevOpt: ViewElement voption) (source: ViewElement) (target: CarouselViewControl) =
        ViewBuilders.UpdateView(prevOpt, source, target)
        let inline updatePrim key updater =
          source.UpdatePrimitive(prevOpt, target, key, updater)
        updatePrim AttrKeys.Position (fun t v -> t.Position <- v)
        updatePrim AttrKeys.Orientation (fun t v -> t.Orientation <- v)
        updatePrim AttrKeys.InterPageSpacing (fun t v -> t.InterPageSpacing <- v)
        updatePrim AttrKeys.IsSwipeEnabled (fun t v -> t.IsSwipeEnabled <- v)
        updatePrim AttrKeys.IndicatorsTintColor (fun t v -> t.IndicatorsTintColor <- v)
        updatePrim AttrKeys.CurrentPageIndicatorTintColor (fun t v -> t.CurrentPageIndicatorTintColor <- v)
        updatePrim AttrKeys.IndicatorsShape (fun t v -> t.IndicatorsShape <- v)
        updatePrim AttrKeys.AnimateTransition (fun t v -> t.AnimateTransition <- v)
        updatePrim AttrKeys.ShowArrows (fun t v -> t.ShowArrows <- v)
        updatePrim AttrKeys.ArrowsBackgroundColor (fun t v -> t.ArrowsBackgroundColor <- v)
        updatePrim AttrKeys.ArrowsTintColor (fun t v -> t.ArrowsTintColor <- v)
        updatePrim AttrKeys.ArrowsTransparency (fun t v -> t.ArrowsTransparency <- v)
        source.UpdateEvent(prevOpt, AttrKeys.PositionSelected, target.PositionSelected)
        source.UpdateEvent(prevOpt, AttrKeys.Scrolled, target.Scrolled) 
        // update the itemsSource manually (source.UpdateElementCollection is not suitable here)
        do
          let prevViewsOpt =
            prevOpt |> ValueOption.bind (fun prev -> prev.TryGetAttributeKeyed<_> AttrKeys.ItemsSource)
          // retrive a SCG.List<XF.View> from the carousel, or create if null
          let views =
            if isNull target.ItemsSource then new Collections.Generic.List<obj>()
            else target.ItemsSource.GetList()
          // update views using Fabulous's helper functions
          updateCollectionGeneric
            (prevViewsOpt |> ValueOption.map List.toArray)
            (source.TryGetAttributeKeyed<_> AttrKeys.ItemsSource |> ValueOption.map List.toArray)
            views
            // making sure items are all derived from View
            (fun ve -> ve.Create() :?> Xamarin.Forms.View |> box)
            (fun _ _ _ -> ())
            canReuseChild updateChild
          // apply the result
          target.ItemsSource <- views

          // workaround for carouselview not respecting size requests of child views.
          let sizes =
            // collect size requests from children
            views
            |> Seq.map (fun view ->
              (view :?> Xamarin.Forms.View).Measure(Double.PositiveInfinity, Double.PositiveInfinity))
            |> Seq.toArray
          // optimized version of xs |> Array.map f |> Array.max
          let inline mapMax f xs = xs |> Array.fold (fun state x -> max (f x) state) 0.0
          // apply the maximum values to the carousel
          target.MinimumWidthRequest <- sizes |> mapMax (fun s -> s.Minimum.Width)
          target.WidthRequest <- sizes |> mapMax (fun s -> s.Request.Width)
          target.MinimumHeightRequest <- sizes |> mapMax (fun s -> s.Minimum.Height)
          target.HeightRequest <- sizes |> mapMax (fun s -> s.Request.Height)
      
      ViewElement.Create<CarouselViewControl>(create, update, attribs)