React mask input

maskedinput.fs

// Copyright Luiz Stangarlin 2019

module Client.Components.MaskInput

open System.Text.RegularExpressions

open FSharp.Core
open Fable.Core
open Fable.Core.JsInterop

open Fable.React
open Fable.React.Props

open Fable.MaterialUI.Props

open Client.FableUtil
open Client.ReactUtil

[<RequireQualifiedAccess; SuppressMessage("NameConventions", "*")>]
module Internal =

    // ts2fable, imported definitions

    type ITextMaskConfig =
        abstract inputElement: ReactElement with get, set
        abstract mask: MaskType with get, set
        abstract guide: bool option with get, set
        abstract value: U2<string, float> option with get, set
        abstract pipe: IPipe option with get, set
        abstract placeholderChar: string option with get, set
        abstract keepCharPositions: bool option with get, set
        abstract showMask: bool option with get, set

    and MaskType =
        U3<U2<Regex, string> [],
           IMaskFunc,
           bool>

    and IMaskFunc = System.Func<string, IMaskState, U2<bool, string>>

    and IMaskState =
        abstract currentCaretPosition: int option with get, set
        abstract previousConformedValue: string option with get, set
        abstract placeholderChar: string option with get, set

    and IPipe = (string -> ITextMaskConfigRaw -> U2<bool, string>)

    and ITextMaskConfigRaw =
        inherit ITextMaskConfig
        abstract rawValue: string option with get, set

    and IMaskUpdater = (string -> ITextMaskConfig -> unit)

    and IMaskCreator =
        abstract state: IMaskState with get, set
        abstract update: IMaskUpdater with get, set

    let createTextMaskInputElement (props: ITextMaskConfig) : IMaskCreator =
        !!(import "createTextMaskInputElement" "text-mask-core") (props)

module Prop =

    // Exported interface

    type MaskExType = U2<string, Internal.IMaskFunc>
    type OnInputValueChangeType = string -> unit

    [<RequireQualifiedAccess>]
    type MaskedInputProp =
        // ITextMaskConfig props.
        | MaskEx of MaskExType
        | Guide of bool
        | Value of U2<string, float>
        | Pipe of Internal.IPipe
        | PlaceholderChar of string
        | KeepCharPositions of bool
        | ShowMask of bool
        // ITextMaskFieldProp extra props.
        | OnValueChange of OnInputValueChangeType
        // Fable binding.
        interface IHTMLProp

    let inline Mask ( mask: string ) =
        MaskedInputProp.MaskEx !^ mask

    let inline AddOn fn props =
        MaskedInputProp.MaskEx !^ ( fn props )

    let inline OnChange ev =
        MaskedInputProp.OnValueChange ev

[<RequireQualifiedAccess; SuppressMessage("NameConventions", "*")>]
module Impl =

    open Prop

    /// This should be kept in sync with `Prop.MaskedInputProp`.
    type ITextMaskFieldProp =
        inherit Internal.ITextMaskConfig
        inherit Client.MaterialUtil.IMuiInputApi
        inherit IHtmlInputApi
        abstract maskEx: MaskExType with get, set
        abstract onValueChange: OnInputValueChangeType with get, set

    /// Extract inherited properties from ITextMaskConfig
    /// and pass additional needed state.
    let private mapProps ( props: ITextMaskFieldProp ) el =
        let newProps : Internal.ITextMaskConfig = jsClone [| props |]
        match props.maskEx with
        | U2.Case1 str ->
            let mask : U2<Regex, string> [] =
                str
                |> Seq.map (
                    fun c ->
                        // The RegExp constructor should be called every time.
                        // JS regex have global mutable state, what the ...
                        match c with
                        | '9' -> !^ JS.Constructors.RegExp.Create(@"\d")
                        | p -> !^ (string p) )
                |> Array.ofSeq
            newProps.mask <- !^ mask
        | U2.Case2 fn ->
            newProps.mask <- !^ fn
        newProps.inputElement <- el
        newProps

    let private createMask props el =
        let newProps = mapProps props el
        newProps, Internal.createTextMaskInputElement newProps

    /// This is the High Order React Component.
    let maskedInputTypeHoc =

        let fn = forwardRef <| fun ( props: ITextMaskFieldProp ) ref ->
            // text-mask-core only provides behavior.
            // Here we wire it up directly to the change event.
            // We also wire to the hook so we can restart the text-mask-core state.
            // This way we avoid that pesky React controlled component
            // problem of losing sync on smartphones when the CPU is being heavily loaded.
            // (that is, the user either sees double characters or missing typed characters)

            let ref = Hooks.useRef Unchecked.defaultof<_>
            let (readMaskState, setMaskState) = useState None
            let (readInputValue, setInputValue) = useState ""

            /// Please note that this is a composed object returned for MaterialUI library
            /// so it also contains the props that should be used to construct the input,
            /// but we need to remove from React our own properties.
            let htmlInput: IHtmlInputApi =
                jsClone [| props |]
                |> jsDelete "maskEx"
                |> jsDelete "onValueChange"
                |> jsDelete "inputRef"

            let effect value =
                let virtEl = ref.current
                if not <| isNull virtEl && virtEl?value <> value then
                    virtEl?value <- value
                setMaskState <| Some ( createMask props virtEl )
                setInputValue <| virtEl?value
                props.inputRef virtEl

            Hooks.useEffect ( fun () ->
                props.value |> effect
            , [| props.value |] )

            Hooks.useEffect ( fun () ->
                readInputValue () |> effect
            , [| ref |] )

            htmlInput.ref <- ref

            htmlInput.onChange <-
                fun ev ->
                    match readMaskState () with
                    | Some state ->
                        let ( maskProps, maskCreator ) = state
                        maskCreator.update <| ev.Value <| maskProps
                    | _ -> ()
                    setInputValue ev.Value
                    props.onValueChange ev.Value

            htmlInput.onBlur <-
                props.onBlur

            htmlInput.value <- readInputValue ()

            ReactElementType.create
                <| ReactElementType.ofHtmlElement "input"
                <| htmlInput <| []

        fn?displayName <- "maskedInput"
        !!fn |> ReactElementType.memoWith equalsButFunctions
        :> ReactElementType

open Client.MaterialUtil

type MaskTextFieldType = | MaskTextFieldType of string
let extend o = TextFieldType.Extend ( MaskTextFieldType o )

type [<Erase>] Mask = | Mask of string
let ofMask = function | Mask m -> m

let maskTextField mask id label placeHolder inputValue onInputChange required error =
    let mask = ofMask mask
    let fieldId = ofFieldId id
    let key = string fieldId
    let inputValue = ofValue inputValue
    let inputChange = onInputChange fieldId
    let attr : IHTMLProp [] = [|
        Prop.Key <| key
        ChildrenProp.InputProps [
            /// Properties applied to the Input component
            ///   inside the TextField.
            InputProp.InputComponent Impl.maskedInputTypeHoc
        ]
        MaterialProp.InputProps [
            /// Attributes applied to the input element.
            ///   maskedInputTypeHoc in this case, instead of html input.
            Prop.Mask mask
            Prop.OnChange inputChange
        ]
    |]
    customTextFieldCoreMemo
        <| key
        <| ( extend mask, attr, key,
             ofLabel label, ofPlaceHolder placeHolder,
             ofRequired required, ofError fieldId error,
             inputValue )