{- Copyright 2020 Eike K. & Contributors SPDX-License-Identifier: AGPL-3.0-or-later -} module Comp.SimpleTextInput exposing ( Config , Model , Msg , ValueChange(..) , defaultConfig , getValue , init , initDefault , onEnterOnly , setValue , update , view , viewMap ) import Html exposing (Attribute, Html, input) import Html.Attributes exposing (type_, value) import Html.Events exposing (onBlur, onInput) import Task import Throttle exposing (Throttle) import Time import Util.Html exposing (KeyCode, onKeyUpCode) import Util.Maybe type Model = Model InnerModel type alias Config = { delay : Float , setOnTyping : Bool , setOnEnter : Bool , setOnBlur : Bool } defaultConfig : Config defaultConfig = { delay = 1500 , setOnTyping = True , setOnEnter = True , setOnBlur = True } onEnterOnly : Config onEnterOnly = { defaultConfig | setOnTyping = False, setOnBlur = False } type alias InnerModel = { cfg : Config , throttle : Throttle Msg , value : Maybe String , lastPublished : Maybe String } init : Config -> Maybe String -> Model init cfg str = Model { cfg = cfg , throttle = Throttle.create 1 , value = str , lastPublished = str } initDefault : Maybe String -> Model initDefault str = init defaultConfig str getValue : Model -> Maybe String getValue (Model model) = model.lastPublished setValue : Model -> String -> ( Model, Sub Msg ) setValue (Model model) str = let v = Util.Maybe.fromString str inner = { model | value = v, lastPublished = v } in ( Model inner, makeSub inner inner.throttle ) type Msg = SetText String | DelayedSet | UpdateThrottle | KeyPressed (Maybe KeyCode) | FocusRemoved --- Update type ValueChange = ValueUpdated (Maybe String) | ValueUnchanged type alias Result = { model : Model , change : ValueChange , cmd : Cmd Msg , sub : Sub Msg } update : Msg -> Model -> Result update msg (Model model) = case msg of SetText str -> let maybeStr = Util.Maybe.fromString str cmd_ = Task.succeed () |> Task.perform (\_ -> DelayedSet) ( newThrottle, cmd ) = if model.cfg.setOnTyping then Throttle.try cmd_ model.throttle else ( model.throttle, Cmd.none ) in { model = Model { model | value = maybeStr, throttle = newThrottle } , change = ValueUnchanged , cmd = cmd , sub = makeSub model newThrottle } UpdateThrottle -> let ( newThrottle, cmd ) = Throttle.update model.throttle in { model = Model { model | throttle = newThrottle } , change = ValueUnchanged , cmd = cmd , sub = makeSub model newThrottle } DelayedSet -> if model.lastPublished == model.value then unit model else publishChange model FocusRemoved -> if model.cfg.setOnBlur then publishChange model else unit model KeyPressed (Just Util.Html.Enter) -> if model.cfg.setOnEnter then publishChange model else unit model KeyPressed _ -> unit model publishChange : InnerModel -> Result publishChange model = if model.lastPublished == model.value then unit model else Result (Model { model | lastPublished = model.value }) (ValueUpdated model.value) Cmd.none (makeSub model model.throttle) unit : InnerModel -> Result unit model = { model = Model model , change = ValueUnchanged , cmd = Cmd.none , sub = makeSub model model.throttle } makeSub : InnerModel -> Throttle Msg -> Sub Msg makeSub model newThrottle = if model.cfg.setOnTyping then Throttle.ifNeeded (Time.every model.cfg.delay (\_ -> UpdateThrottle)) newThrottle else Sub.none --- View inputAttrs : InnerModel -> List (Attribute Msg) inputAttrs model = List.filterMap identity [ type_ "text" |> Just , onInput SetText |> Just , if model.cfg.setOnEnter then Just (onKeyUpCode KeyPressed) else Nothing , onBlur FocusRemoved |> Just , value (Maybe.withDefault "" model.value) |> Just ] view : List (Attribute Msg) -> Model -> Html Msg view extra (Model model) = let attrs = inputAttrs model in input (attrs ++ extra) [] viewMap : (Msg -> msg) -> List (Attribute msg) -> Model -> Html msg viewMap f extra (Model model) = let attrs = inputAttrs model |> List.map (Html.Attributes.map f) in input (attrs ++ extra) []