Create custom "onInput" for module's custom element

Learn
1

Hey,

I’ve made my own number input element in Elm, because I’m not happy with the default HTML number input. Now, I would like to use this element in a form and where it would fire a message whenever the value is changed, just like with a normal input, but I’m having a tough time wrapping my head around the issue, as I’m not able to figure out how to do a similar scheme like onInput from the Html.Events module.

How I currently have it all hooked up:

module Page exposing (..)


import Html exposing
  ( form
  )
import Elements.IntInput as IntInput -- My custom element.


type Msg
  = GotIntInputMsg IntInput.Msg


type alias Model
  { intInputModel : IntInput.Model
  }


view : Model -> Html Msg
view m = 
  form
    []
    [ ( Html.map GotIntInputMsg ) ( IntInput.view m.intInputModel )
    ]

Where I feed the current model of the input, as stored in the page’s model (m). I’m mapping the internal messages of the IntInput module to the GotIntInputMsg, in order for the element to work properly (otherwise, its internal model wouldn’t update, etc etc).

And what I’d like to be able to do, is something like:

type Msg
  = GotIntInputMsg IntInput.Msg
  | InputChanged Int

view : Model -> Html Msg
view m = 
  form
    []
    [ ( Html.map GotIntInputMsg ) ( IntInput.view m.intInputModel [ onInput InputChanged ] )
    ]

reminiscent of the well known

input
  [ onInput InputChanged
  ]
  []

I have tried working around this using an OutMsg scheme, but sadly that will only work if I give each instance of this element a unique ID or something (as a String or Int, as a Type won’t work I figured), and then check against the passed ID along with the OutMsg, making it vulnerable to typos.

So, is this possible? Or should I accept fate and perform a dodgy OutMsg scheme as described above.

1 Like
2

Traditionally, custom events aren’t done with a nested TEA. Instead you’d do something like:

onIntInput : (Int -> msg) -> Html.Attributes msg
onIntInput tagger =
  Html.Events.on "input" (Decode.map tagger intTargetValue)

intTargetValue : Decoder Int
intTargetValue =
  Decode.at ["target", "value"] Decode.int

You can use this in your views just like you would one of the core event handlers:

input [ onIntInput InputChanged] []

If you want to dig deeper into how this works, here are some useful links:

  1. An introduction to building DOM event handlers in Elm.
  2. Event handlers ignore events for which their associated decoder fails (in the example above, if the input is not an integer). Learn how to use this to only listen to a sub-set of events
  3. Because event handlers can fail silently when their decoder fails, here are some debugging tips when developing such an event handler
  4. Here an example from one of my projects where I created an onIntInput event to use with a range slider
  5. Be aware there are pitfalls to always trying to prevent users from entering bad values. This is especially true if they need to enter an intermediate bad value (such as 1. for a float field) as part of entering a valid input. This twitter thread digs into some of the edge cases.
2 Likes
3

From what I understand, this is just creating the event in the same module, am I correct? If not, I do not understand your answer :frowning:

What I want is:

  • I have a custom defined element in the module IntInput.
  • I import the module into another module, Page, because I use this custom element in multiple places.
  • Then, when the value of the IntInput element changes, I want to catch that change with something like how you’d normally do it with an <input> element.

As in the example, the IntInput module has its own model and messages etc, as it is a proper module, and those are all neatly mapped to a special GotIntInputMsg message in Page. Theses messages, however, are opaque, and the only way to directly communicate between IntInput and Page is via an OutMsg scheme. However, if I have multiple IntInput elements on the same page, I cannot simply use a OutMsg.IntInputChange, as I would have no way to discriminate between the elements, so I either need to give each instance an ID or, what this question is about, I could use some sort of event listener on this module, if that is possible at all.

So it is not so much about creating a special event listener using the Html.Event.on function, but how to use an “event listener” on a module. I thought of using a ghost <input> element, but then I’d ran another problem, where I would have a Page.Msg inside of the IntInput module.

I suppose it isn’t possible then?

For context, here is a screenshot of the cute custom element that is causing me the headache :stuck_out_tongue:
image

4

You should be able to use a custom type for the ID, what problem are you having? Although if you went down this route, you would still be open to the possibility of giving two or more IntInput’s the same ID.

If you haven’t already considered it, you could create separate Msg’s for each instance, so if you were using your IntInput to select dates, such as Day, Month & Year, then you could do this:

type Msg
    = GotDayMsg IntInput.Msg
    | GotMonthMsg IntInput.Msg 
    | GotYearMsg IntInput.Msg

And your view could be:

view : Model -> Html Msg
view m = 
    form
        []
        [ IntInput.view m.dayInputModel
            |> Html.map GotDayMsg
        , IntInput.view m.monthInputModel
            |> Html.map GotMonthMsg 
        , IntInput.view m.yearInputModel 
            |> Htm.map GotYearMsg
        ]

And then you simply handle each Msg in your update function.

If you want to lose the Html.map calls altogether then you can pass the Msg into IntInput.view as so:

view : Model -> Html Msg
view m = 
    form
        []
        [ IntInput.view m.dayInputModel GotDayMsg
        , IntInput.view m.monthInputModel GotMonthMsg 
        , IntInput.view m.yearInputModel GotYearMsg
        ]

And then your IntInput.view function would be:

view : Model -> (Msg -> msg) -> Html msg 
view model toMsg =
    -- wrap your local Msg's with toMsg like so:
    -- toMsg InputChanged

HTH

1 Like
5

Maybe you will find this helpful.

I use this pattern every now and then when I want to build components with encapsulated state and side effects. It feels a bit verbose for this example but I find it nice since it is common to add things later, eg. debounce, animation timeouts, autocomplete etc.

The basic idea is to “send” events as plain messages to the parent component using the Task module.

Int Input Element module

Note that the update and view has msg with lower case m in their return type.


module Elements.IntInput exposing (..)

import Html exposing (Html)
import Html.Attributes
import Html.Events
import Task


type alias Model =
    { value : String
    }


type Msg
    = GotInput String


type alias Args =
    { value : Int
    }


type alias Dispatch msg =
    { toSelf : Msg -> msg
    , onChange : Int -> msg
    }


init : Args -> ( Model, Cmd msg )
init args =
    ( { value = String.fromInt args.value }
    , Cmd.none
    )


update : Dispatch msg -> Msg -> Model -> ( Model, Cmd msg )
update dispatch msg model =
    case msg of
        GotInput str ->
            ( { model | value = str }
            , case String.toInt str of
                Just n ->
                    dispatch.onChange n
                        |> Task.succeed
                        |> Task.perform identity

                Nothing ->
                    Cmd.none
            )


view : Dispatch msg -> Model -> Html msg
view dispatch model =
    Html.input
        [ Html.Attributes.value model.value
        , Html.Events.onInput (dispatch.toSelf << GotInput)
        ]
        []

In the Form module

type alias Model =
    { intInputModel : IntInput.Model
    }


type Msg
    = GotIntInputMsg IntInput.Msg
    | InputChanged Int


intInputDispatch : IntInput.Dispatch Msg
intInputDispatch =
    { toSelf = GotIntInputMsg
    , onChange = InputChanged
    }


update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
    case msg of
        GotIntInputMsg intMsg ->
            IntInput.update
                intInputDispatch
                intMsg
                model.intInputModel
                |> Tuple.mapFirst (\intInputModel -> { model | intInputModel = intInputModel })

        InputChanged value ->
            ( model, Cmd.none )


view : Model -> Html Msg
view model =
    Html.form
        []
        [ IntInput.view intInputDispatch model.intInputModel
        ]
6

If all you need in the ‘internal’ model for your custom input is this:

type alias Model =
    { value : String
    }

I would not bother to make it a component-like thing with its own update function and internal messages. This so-called “nested TEA” pattern is rarely the best way to do things in Elm, and should only be considered after simpler alternatives. Its nice to know how to do it, and to pass messages between modules, but it is likely overkill for what you are trying to do.

Following @joelq’s suggestion here is a simpler way to do what you want:

module FancyInput exposing (input)

import Html exposing (Html)
import Html.Attributes

input : String -> (String -> msg) -> Html msg
input val tagger =
    Html.div
        [ onIntInput tagger
        , -- ... some more fancy styling to make the input look good etc.
        ]
        [ -- ... Html to render this fancy looking input control.
          -- ... Will use the 'val' somewhere in this HTML too.
        ]

onIntInput : (String -> msg) -> Html.Attributes msg
onIntInput tagger =
  Html.Events.on "input" (Decode.map tagger targetValue)

targetValue : Decoder String
targetValue =
  Decode.at ["target", "value"] Decode.string

Then in the code that uses this instantiate it with something like:

input currentValue InputChanged

So the input is purely view code with no internal state - that is the simplest version anyway. So the question is, what internal state and events does your fancy input element need?

7

This does not compile, the tagger needs an Int but a Decoder String is used.

onIntInput : (Int -> msg) -> Html.Attributes msg
onIntInput tagger =
  Html.Events.on "input" (Decode.map tagger targetValue)

targetValue : Decoder String
targetValue =
  Decode.at ["target", "value"] Decode.string

One way to fix this is to only succeed when the value can be decoded to an Int

targetValue : Decoder Int
targetValue =
  Decode.at ["target", "value"] Decode.string
    |> Decode.andThen 
        (\str ->
            case String.toInt str of
                Just n ->
                    Decode.succeed n

                Nothing ->
                    Decode.fail ""
        )
8

Thanks fixed it. I just used String instead of Int to allow for incorrect input, but various ways that can be handled.

9

Hey all, thanks for the suggestions, really appreciate it!

Great tip, already got the separate Msgs, but had the bright idea to create a separate import for each of them, didn’t know I could only one import, thanks!

Really like this, will give it a shot! Massive thanks :slight_smile:

Agree, this gets messy quickly, alas I cannot achieve what I want with just CSS, otherwise I would have definitely gone that route.

10

You are not restricted to just CSS, you can make a function to generate whatever HTML you need, as much of it as you need, there is no restiction on how complex this view function gets. Are you able to share the code for your custom input?

11

Yes, agree and very true, a lot more can be done than just styling. The issue is, I don’t want to use the default HTML number input, it is not possible to customise it with CSS and therefore I need to write my own logic for it. I could create a function that accepts multiple messages, but then I’d still need to do the logic in the module it’s in, which would also become messy.

Regarding the code, it is a lot more than just styling or moving around HTML parts, as to get a proper number input, a lot of checks need to be done. I don’t want to implement all this logic into every module and it is a lot cleaner to just use a nested TEA approach imo.

The HTML generating part

view : StyleSheet -> Model -> Html Msg
view s m = styled div
  [ property "display" "grid"
  , property "grid-template-columns" "1fr minmax(10rem, auto) 1fr"
  , property "gap" "5rem"
  , property "height" "max-content"
  , borderRadius defaultBorderRadius
  , overflow hidden
  ]
  [ Attr.fromUnstyled <| onWheel Wheel
  ]
  [ arrowButton s m Down arrowLeftDense_
  , styled input
      ( inpDefault s 
        ++
        [ border <| rem 0
        , padding2 ( rem 4 ) ( rem 0 )
        , width <| rem <| calcInputWidth m.value 
        ]
      )
      [ Attr.value <| String.fromInt m.value
      , onInput UpdateValue
      , onKeyDown KeyDown
      ]
      []
  , arrowButton s m Up arrowRightDense_
  ]


arrowButton : StyleSheet -> Model -> Direction -> ( Color -> Html Msg ) -> Html Msg
arrowButton s m d i = styled div
  [ displayFlex
  , padding2 ( rem 6 )  ( rem 2 )
  , opacity
      <|  Css.num
      <|  case d of
            Down ->
              case m.range of
                Just range ->
                  if ( m.value - 1 < 0 && not m.allowNegative )
                      || m.value - 1 < range.min then
                    0.5
                  else
                    1

                Nothing ->
                  if ( m.value - 1 < 0 && not m.allowNegative ) then
                    0.5
                  else
                    1

            Up ->
              case m.range of
                Just range ->
                  if m.value + 1 > range.max then
                    0.5
                  else
                    1

                Nothing ->
                  1
  , cursor pointer
  , borderRadius defaultBorderRadius
  , backgroundColor inherit
  , hover
      [ backgroundColor s.icon.backgroundHover
      ]
  , transition
      [ defaultTransition CssT.backgroundColor3
      , defaultTransition CssT.opacity3
      ]
  ]
  [ onMouseDown <| MouseDown d
  , onMouseUp MouseUp
  , onMouseLeave MouseUp
  ]
  [ i s.icon.fill
  ]

The update function and Msg type

type Msg
  = Decoy
  | Decrement
  | Increment
  | IsMouseDown Posix
  | KeyDown Key
  | MouseDown Direction
  | MouseUp
  | SetMouseDownTimestamp Posix
  | SetValue Int
  | UpdateValue String
  | Wheel Event


update : Msg -> Model -> ( Model, Cmd Msg, Maybe Out )
update msg model = case msg of
  Decoy ->
    ( model
    , Cmd.none
    , Nothing
    )

  Decrement ->
    let
      newValue = case model.range of
          Just range ->
            if ( not model.allowNegative && model.value < 1 )
                || model.value - 1 < range.min then
              model.value
            else
              model.value - 1
          
          Nothing ->
            if not model.allowNegative && model.value < 1 then
              model.value
            else
              model.value - 1
    in
      ( { model
        | value = newValue
        }
      , Cmd.none
      , if model.activeReport then
          Just <| IntInputChange model.id newValue
        else
          Nothing
      )
  
  Increment ->
    let
      newValue = case model.range of
          Just range ->
            if model.value + 1 > range.max then
              model.value
            else
              model.value + 1
          
          Nothing ->
            model.value + 1
    in
    ( { model
      | value = newValue
      }
    , Cmd.none
    , if model.activeReport then
        Just <| IntInputChange model.id newValue
      else
        Nothing
    )
  
  IsMouseDown posix ->
    if model.mouseDown && model.mouseDownTimestamp == posix then
      ( model
      , Cmd.batch
          [ changeValue model.direction
          , Process.sleep 50 |> Task.perform ( \ _ -> IsMouseDown posix )
          ]
      , Nothing
      )
    else
      ( model
      , Cmd.none
      , Nothing
      )
  
  KeyDown key ->
    update 
      ( case key of 
          Control "ArrowUp" ->
            Increment

          Control "ArrowDown" ->
            Decrement

          _ ->
            Decoy
      )
      model
  
  MouseDown direction ->
    ( { model
      | direction = direction
      , mouseDown = True
      }
    , Cmd.batch
        [ changeValue direction
        , Time.now |> Task.perform SetMouseDownTimestamp
        ]
    , Nothing
    )
    
  MouseUp ->
    ( { model
      | mouseDown = False
      }
    , Cmd.none
    , Nothing
    )
  
  SetMouseDownTimestamp posix ->
    ( { model
      | mouseDownTimestamp = posix
      }
    , Process.sleep 500 |> Task.perform ( \ _ -> IsMouseDown posix )
    , Nothing
    )
  
  SetValue val ->
    ( { model
      | value = val
      }
    , Cmd.none
    , Nothing
    )

  UpdateValue newValue ->
    ( { model
      | value = case String.toFloat newValue of
          Just properValue ->
            let
              v = truncate properValue
            in
              case model.range of
                Just range ->
                  if v > range.max then
                    range.max
                  else if not model.allowNegative && v < 0 then
                    0
                  else if v < range.min then
                    range.min
                  else
                    v
                
                Nothing ->
                  if not model.allowNegative && v < 0 then
                    0
                  else
                    v
          
          Nothing ->
            if String.length newValue == 0 || newValue == "-" then
              case model.range of
                Just range ->
                  if range.min > 0 then
                    range.min
                  else
                    0
                
                Nothing ->
                  0
            else
              model.value
      }
    , Cmd.none
    , Nothing
    )
  
  Wheel e ->
    if model.mouseDown then
      ( model
      , Cmd.none
      , Nothing
      )
    else
      if e.deltaY < 0 then
        update Increment model
      else
        update Decrement model
12

This approach works like charm!

Thanks to all of you, really appreciate the loads of suggestions, feedback and discussion <3

13

This topic was automatically closed 10 days after the last reply. New replies are no longer allowed.