GenericAutocomp.elm

module GenericAutocomp exposing (..)

import Autocomplete
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (..)
import Html.App as Html
import String
import Json.Decode as Json
import Dom
import Task


subscriptions : Model a -> Sub Msg
subscriptions model =
    Sub.map SetAutoState Autocomplete.subscription


type alias Config a =
    { allItems : List a
    , itemToId : a -> String
    , searchItems : String -> List a
    , getById : String -> a
    , itemToText : a -> String
    }


type alias Model a =
    { config : Config a
    , autoState : Autocomplete.State
    , howManyToShow : Int
    , query : String
    , selectedItem : Maybe a
    , showMenu : Bool
    }


init config =
    { config = config
    , autoState = Autocomplete.empty
    , howManyToShow = 7
    , query = ""
    , selectedItem = Nothing
    , showMenu = False
    }


type Msg
    = SetQuery String
    | SetAutoState Autocomplete.Msg
    | Wrap Bool
    | Reset
    | HandleEscape
    | SelectItemKeyboard String
    | SelectItemMouse String
    | PreviewItem String
    | OnFocus
    | NoOp


update : Msg -> Model a -> ( Model a, Cmd Msg )
update msg model =
    case msg of
        SetQuery newQuery ->
            let
                showMenu =
                    not << List.isEmpty <| (model.config.searchItems newQuery)
            in
                { model | query = newQuery, showMenu = showMenu, selectedItem = Nothing } ! []

        SetAutoState autoMsg ->
            let
                ( newState, maybeMsg ) =
                    Autocomplete.update (updateConfig model.config) autoMsg model.howManyToShow model.autoState (model.config.searchItems model.query)

                newModel =
                    { model | autoState = newState }
            in
                case maybeMsg of
                    Nothing ->
                        newModel ! []

                    Just updateMsg ->
                        update updateMsg newModel

        HandleEscape ->
            let
                validOptions =
                    not <| List.isEmpty (model.config.searchItems model.query)

                handleEscape =
                    if validOptions then
                        model
                            |> removeSelection
                            |> resetMenu
                    else
                        { model | query = "" }
                            |> removeSelection
                            |> resetMenu

                escapedModel =
                    case model.selectedItem of
                        Just item ->
                            if model.query == (model.config.itemToText item) then
                                model
                                    |> resetInput
                            else
                                handleEscape

                        Nothing ->
                            handleEscape
            in
                escapedModel ! []

        Wrap toTop ->
            case model.selectedItem of
                Just item ->
                    update Reset model

                Nothing ->
                    if toTop then
                        { model
                            | autoState = Autocomplete.resetToLastItem (updateConfig model.config) (model.config.searchItems model.query) model.howManyToShow model.autoState
                            , selectedItem = List.head <| List.reverse <| List.take model.howManyToShow <| (model.config.searchItems model.query)
                        }
                            ! []
                    else
                        { model
                            | autoState = Autocomplete.resetToFirstItem (updateConfig model.config) (model.config.searchItems model.query) model.howManyToShow model.autoState
                            , selectedItem = List.head <| List.take model.howManyToShow <| (model.config.searchItems model.query)
                        }
                            ! []

        Reset ->
            { model | autoState = Autocomplete.reset (updateConfig model.config) model.autoState, selectedItem = Nothing } ! []

        SelectItemKeyboard id ->
            let
                newModel =
                    setQuery model id
                        |> resetMenu
            in
                newModel ! []

        SelectItemMouse id ->
            let
                newModel =
                    setQuery model id
                        |> resetMenu
            in
                ( newModel, Task.perform (\err -> NoOp) (\_ -> NoOp) (Dom.focus "president-input") )

        PreviewItem id ->
            { model | selectedItem = Just <| model.config.getById id } ! []

        OnFocus ->
            model ! []

        NoOp ->
            model ! []


resetInput model =
    { model | query = "" }
        |> removeSelection
        |> resetMenu


removeSelection model =
    { model | selectedItem = Nothing }


setQuery model id =
    { model
        | query = model.config.itemToText <| model.config.getById id
        , selectedItem = Just <| model.config.getById id
    }


resetMenu model =
    { model
        | autoState = Autocomplete.empty
        , showMenu = False
    }


view : Model a -> Html Msg
view model =
    let
        options =
            { preventDefault = True, stopPropagation = False }

        dec =
            (Json.customDecoder keyCode
                (\code ->
                    if code == 38 || code == 40 then
                        Ok NoOp
                    else if code == 27 then
                        Ok HandleEscape
                    else
                        Err "not handling that key"
                )
            )

        menu =
            if model.showMenu then
                [ viewMenu model ]
            else
                []

        query =
            case model.selectedItem of
                Just item ->
                    (model.config.itemToText item)

                Nothing ->
                    model.query

        activeDescendant attributes =
            case model.selectedItem of
                Just item ->
                    (attribute "aria-activedescendant"
                        (model.config.itemToText item)
                    )
                        :: attributes

                Nothing ->
                    attributes
    in
        div []
            (List.append
                [ input
                    (activeDescendant
                        [ onInput SetQuery
                        , onFocus OnFocus
                        , onWithOptions "keydown" options dec
                        , value query
                        , id "term-input"
                        , class "autocomplete-input"
                        , autocomplete False
                        , attribute "aria-owns" "list-of-presidents"
                        , attribute "aria-expanded" <| String.toLower <| toString model.showMenu
                        , attribute "aria-haspopup" <| String.toLower <| toString model.showMenu
                        , attribute "role" "combobox"
                        , attribute "aria-autocomplete" "list"
                        ]
                    )
                    []
                ]
                menu
            )


viewMenu : Model a -> Html Msg
viewMenu model =
    div [ class "autocomplete-menu" ]
        [ Html.map SetAutoState (Autocomplete.view (viewConfig model.config) model.howManyToShow model.autoState (model.config.searchItems model.query)) ]


updateConfig : Config a -> Autocomplete.UpdateConfig Msg a
updateConfig config =
    Autocomplete.updateConfig
        { toId = config.itemToId
        , onKeyDown =
            \code maybeId ->
                if code == 38 || code == 40 then
                    Maybe.map PreviewItem maybeId
                else if code == 13 then
                    Maybe.map SelectItemKeyboard maybeId
                else
                    Just <| Reset
        , onTooLow = Just <| Wrap False
        , onTooHigh = Just <| Wrap True
        , onMouseEnter = \id -> Just <| PreviewItem id
        , onMouseLeave = \_ -> Nothing
        , onMouseClick = \id -> Just <| SelectItemMouse id
        , separateSelections = False
        }


viewConfig : Config a -> Autocomplete.ViewConfig a
viewConfig config =
    let
        customizedLi keySelected mouseSelected item =
            { attributes =
                [ classList [ ( "autocomplete-item", True ), ( "key-selected", keySelected || mouseSelected ) ]
                , id (config.itemToId item)
                ]
            , children = [ Html.text (config.itemToText item) ]
            }
    in
        Autocomplete.viewConfig
            { toId = config.itemToId
            , ul = [ class "autocomplete-list" ]
            , li = customizedLi
            }

StringAutocomp.elm

module StringAutocomp exposing (..)

import String
import GenericAutocomp


type alias Model =
    GenericAutocomp.Model String


type alias Msg =
    GenericAutocomp.Msg


init : Model
init =
    GenericAutocomp.init curConfig


subscriptions =
    GenericAutocomp.subscriptions


update =
    GenericAutocomp.update


view =
    GenericAutocomp.view


curConfig =
    GenericAutocomp.Config [] identity (\x -> acceptableItems x []) identity identity


acceptableItems : String -> List String -> List String
acceptableItems query items =
    let
        lowerQuery =
            String.toLower query
    in
        List.filter (String.contains lowerQuery << String.toLower) items


setItems : Model -> List String -> Model
setItems model items =
    let
        config =
            model.config

        newconfig =
            { config | allItems = items, searchItems = (\x -> acceptableItems x items) }
    in
        { model | config = newconfig }

Thanks for extracting this. I noticed that you can probably drop allItems entirely from the GenericAutocomp state - no? Since it's captured/filtered in the searchItems closure.