Reusable typed select widget

SelectWidget.elm

module SelectWidget exposing (Model, init, update, view, Msg(..), selected)

import Html exposing (Html, div, text, option)
import Html.Attributes as HA
import Html.Events as HE
import Maybe exposing (withDefault)
import String exposing (toInt)


type alias Model a =
    { id : String
    , allOptionLabel : Maybe String
    , htmlFunc : a -> Html (Msg a)
    , data : List ( Int, a )
    , selectedIndex : Maybe Int
    }


type Msg a
    = Select (Maybe Int)
    | SelectionChanged String
    | SetData (List a)


init : String -> Maybe String -> (a -> Html (Msg a)) -> Model a
init id allLabel htmlFunc =
    Model id allLabel htmlFunc [] Nothing


update : Msg a -> Model a -> Model a
update act model =
    case act of
        SetData list ->
            { model | data = List.indexedMap (,) list }

        Select mbItem ->
            { model | selectedIndex = mbItem }

        SelectionChanged str ->
            (update (Select (Result.toMaybe (String.toInt str))) model)


data : Model a -> List a
data m =
    List.map snd m.data


map : (a -> a) -> Model a -> Model a
map f m =
    update (SetData <| List.map (\( id, obj ) -> f obj) m.data) m


selected : Model a -> List a
selected m =
    case m.selectedIndex of
        Nothing ->
            List.map snd m.data

        Just idx ->
            List.map snd <| List.filter (\( i, _ ) -> i == idx) m.data


toOption : Model a -> ( Int, a ) -> Html (Msg a)
toOption m ( id, e ) =
    option [ HA.value <| toString id ] [ m.htmlFunc e ]


options : Model a -> List (Html (Msg a))
options m =
    let
        allOption =
            case m.allOptionLabel of
                Nothing ->
                    []

                Just label ->
                    [ option [ HA.value "*" ] [ text label ] ]
    in
        allOption ++ (List.map (toOption m) m.data)


view : Model a -> Html (Msg a)
view m =
    let
        idx =
            Maybe.map toString m.selectedIndex
    in
        Html.select
            [ HE.onInput SelectionChanged
            , HA.value (withDefault "*" idx)
            ]
            (options m)