AutocompleteIDList.elm

module AutocompleteIDList exposing (..)

{- 
  Adapted from  https://github.com/thebritican/elm-autocomplete/blob/master/examples/src/AccessibleExample.elm
  
  **Work in Progress**

  Note that the underlying items must be `List (id,item)` 
  and `selectedItem` is `Maybe id` .
  
-}


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


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


type alias Config id item =
    { items: List (id, item)
    , queryItems : String -> List (id, item) -> List (id, item)
    , toString : item -> String
    , idToString : id -> String
    , idFromString : String -> id
    , domMenuClass : String
    , domMenuId : String
    , domInputClass : String
    , domInputId : String
    }

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


init : Maybe id -> Model id
init selected =
    { autoState = Autocomplete.empty
    , howManyToShow = 5
    , query = ""
    , selectedItem = selected
    , showMenu = False
    }


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


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

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

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

                    Just updateMsg ->
                        update config updateMsg newModel
                        
        HandleEscape ->
            let
                validOptions =
                    not <| List.isEmpty (config.queryItems model.query config.items)

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

                escapedModel =
                    model.selectedItem
                        |> (flip Maybe.andThen) (\id -> getItemAtId id config.items)
                        |> Maybe.map config.toString
                        |> Maybe.map (\name -> if model.query == name then model |> resetInput else handleEscape )
                        |> Maybe.withDefault handleEscape
            in
                escapedModel ! []

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

                Nothing ->
                    let matchedItems = config.queryItems model.query config.items
                    in
                        if toTop then
                            { model
                                | autoState = Autocomplete.resetToLastItem (updateConfig config) matchedItems model.howManyToShow model.autoState
                                , selectedItem = Maybe.map fst <| List.head <| List.reverse <| List.take model.howManyToShow <| matchedItems
                            }
                                ! []
                        else
                            { model
                                | autoState = Autocomplete.resetToFirstItem (updateConfig config) matchedItems model.howManyToShow model.autoState
                                , selectedItem = Maybe.map fst <| List.head <| List.take model.howManyToShow <| matchedItems
                            }
                                ! []

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

        SelectItemKeyboard sid ->
            let
                newModel =
                    setQuery config model (config.idFromString sid)
                        |> resetMenu
            in
                newModel ! []

        SelectItemMouse sid ->
            let
                newModel =
                    setQuery config model (config.idFromString sid)
                        |> resetMenu
            in
                ( newModel, Task.perform (\err -> NoOp) (\_ -> NoOp) (Dom.focus config.domInputId) )

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

        OnFocus ->
            model ! []

        NoOp ->
            model ! []

resetInput : Model id -> Model id
resetInput model =
    { model | query = "" }
        |> removeSelection
        |> resetMenu


removeSelection : Model id -> Model id
removeSelection model =
    { model | selectedItem = Nothing }


getItemAtId : id -> List (id,item) -> Maybe item
getItemAtId id items =
    find (\(id_,_) -> id == id_) items |> Maybe.map snd

setQuery : Config id item -> Model id -> id -> Model id
setQuery config model id =
    { model
        | query = getItemAtId id config.items 
            |> Maybe.map config.toString
            |> Maybe.withDefault model.query
            
        , selectedItem = Just id
    }

resetMenu : Model id -> Model id    
resetMenu model =
    { model
        | autoState = Autocomplete.empty
        , showMenu = False
    }


view : Config id item -> Model id -> Html Msg
view config 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 config model ]
            else
                []

        query =
            model.selectedItem
                |> (flip Maybe.andThen) (\id -> getItemAtId id config.items)
                |> Maybe.map config.toString
                |> Maybe.withDefault model.query

        activeDescendant attributes =
            model.selectedItem
                |> (flip Maybe.andThen) (\id -> getItemAtId id config.items)
                |> Maybe.map config.toString
                |> Maybe.map (\name -> (attribute "aria-activedescendant" name) :: attributes )
                |> Maybe.withDefault attributes

    in
        div []
            (List.append
                [ input
                    (activeDescendant
                        [ onInput SetQuery
                        , onFocus OnFocus
                        , onWithOptions "keydown" options dec
                        , value query
                        , id config.domInputId
                        , class config.domInputClass
                        , autocomplete False
                        , attribute "aria-owns" config.domMenuId
                        , 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 : Config id item -> Model id -> Html Msg
viewMenu config model =
    div [ id config.domMenuId, class config.domMenuClass ]
        [ Html.map SetAutoState (Autocomplete.view (viewConfig config) model.howManyToShow model.autoState (config.queryItems model.query config.items)) ]


updateConfig : Config id item -> Autocomplete.UpdateConfig Msg (id,item)
updateConfig config =
    Autocomplete.updateConfig
        { toId = (\(id,item) -> config.idToString id)
        , 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 id item -> Autocomplete.ViewConfig (id,item)
viewConfig config =
    let
        customizedLi keySelected mouseSelected (id_,item) =
            { attributes =
                [ classList [ ( "autocomplete-item", True ), ( "key-selected", keySelected || mouseSelected ) ]
                , id (config.idToString id_)
                ]
            , children = [ Html.text (config.toString item) ]
            }
    in
        Autocomplete.viewConfig
            { toId = (fst >> config.idToString)
            , ul = [ class "autocomplete-list" ]
            , li = customizedLi
            }

    
    
-- copied from list-extra            
find : (a -> Bool) -> List a -> Maybe a
find predicate list =
    case list of
        [] ->
            Nothing

        first::rest ->
            if predicate first then
                Just first
            else
                find predicate rest