Elm Autocomplete

Autocomplete.scss

@use '_share/src/zindex' as zindex;
@use '_share/src/Platform2/colors' as P2Colors;
@use '_share/src/Platform2/Scrollbar/style' as Scrollbar;

@mixin autocomplete {
    &--search-icon {
        margin-left: -8px;
        margin-right: -4px;
        height: 32px;
    }

    &--container {
        position: relative;
        width: 100%;

        &--input-cont {
            display: flex;
            width: 100%;
            align-items: center;
            background: P2Colors.$grey1;
            border-radius: 2px;
            box-shadow: 0 0 0 1px P2Colors.$grey2;
            color: P2Colors.$grey5;
            flex-wrap: wrap;
            font-size: 14px;
            line-height: 1.5;
            min-height: 42px;
            padding: 4px 8px;
            text-transform: none;

            &:focus {
                border-color: P2Colors.$pink-dark;
                box-shadow: 1px 0 0 0 P2Colors.$pink-dark;
            }
        }

        &--input {
            background: P2Colors.$grey1;
            border: 0;
            color: P2Colors.$navy;
            flex-grow: 2;
            font-size: 14px;
            font-weight: 600;
            height: 21px;
            line-height: 1.5;
            margin: 4px;
            padding: 1px 1px 1px 0;
            outline: none;

            &::placeholder {
                font-weight: 400;
            }
        }

        &--selected-items {
            display: flex;
            flex: 1;
            height: auto;
            flex-wrap: wrap;

            &--item {
                position: relative;
                display: flex;
                padding: 4px 0 4px 8px;
                border-radius: 4px;
                background-color: P2Colors.$pink-dark;
                font-size: 14px;
                font-weight: 600;
                color: P2Colors.$white;
                height: 26px;
                align-items: center;
                margin: 4px 8px 4px 0;

                &--remove {
                    position: relative;
                    margin-left: 8px;
                    cursor: pointer;
                    color: inherit;
                    width: 29px;
                    height: 29px;
                    margin: 0;
                    padding: 0;
                    border: 0;
                }
            }
        }

        &--suggestions {
            @include zindex.layer('P2AutocompleteInputSuggestions');

            position: absolute;
            top: calc(100% + 4px);
            left: 0;
            width: 100%;
            max-height: 150px;
            overflow-y: auto;
            border-radius: 4px;
            box-shadow: 0 4px 19px 0 rgba(0, 0, 0, 0.25);
            background-color: P2Colors.$white;

            &--no-results {
                display: flex;
                width: 100%;
                height: 100%;
                justify-content: center;
                align-items: center;
                font-size: 16px;
                margin: 16px 0;
                color: P2Colors.$navy;
            }

            &--item {
                font-size: 14px;
                line-height: 1.5;
                color: P2Colors.$navy;
                cursor: pointer;
                padding: 10px 0 10px 10px;

                &:hover, &.selected {
                    background-color: P2Colors.$pink-bg;
                    line-height: 1.5;
                    letter-spacing: normal;
                    color: P2Colors.$pink-medium;
                }
            }
        }
    }
}

AutocompleteInput.elm

module Platform2.AutocompleteInput exposing (Config, Model, Msg, init, update, view)

import Browser.Dom
import Cmd.Extra as Cmd
import Debouncer.Basic as Debouncer exposing (Debouncer)
import Gwi.Html.Events as Events
import Gwi.Http exposing (Error, HttpCmd)
import Html exposing (Attribute, Html)
import Html.Attributes as Attrs
import Html.Attributes.Extra as Attrs
import Html.Events as Events
import Html.Events.Extra as Events
import Html.Extra as Html
import Icons exposing (IconData)
import Icons.Platform2 as P2Icons
import Json.Decode as Decode exposing (Decoder)
import List.Extra as List
import Maybe.Extra as Maybe
import Process
import Task
import WeakCss exposing (ClassName)


type alias Config item =
    -- @toLabel will be used to display information in the selected items
    { toLabel : item -> String

    -- @toOption will be used to display the suggestions inside the autocomplete options
    , toOption : item -> Int -> Html (Msg item)
    , moduleClass : ClassName
    , uniqueElementId : String
    , placeholder : String
    , icon : IconData
    }


type alias Model item =
    { inputDebouncer : Debouncer (Msg item) (Msg item)
    , searchTerm : String
    , selectedItems : List item
    , suggestions : Maybe (List item)
    , selectionIndex : Int
    }


type Msg item
    = NoOp
    | OnInput { elementId : String } String
    | OnEnter { elementId : String }
    | FetchSuggestions { applyIfMatch : Bool } { elementId : String } String
    | SuggestionsLoaded { applyIfMatch : Bool } { elementId : String } String (Result (Error Never) (List item))
    | InputDebouncerMsg (Debouncer.Msg (Msg item))
    | SelectSuggestion String item
    | RemoveItemFromSelected String item
    | FocusInput String
    | CloseSuggestions
    | InputBlur
    | ChangedIndex Int


init :
    { debounceSeconds : Float
    , selectedItems : List item
    }
    -> Model item
init config =
    { inputDebouncer = Debouncer.toDebouncer <| Debouncer.debounce <| Debouncer.fromSeconds config.debounceSeconds
    , searchTerm = ""
    , selectedItems = config.selectedItems
    , suggestions = Nothing
    , selectionIndex = 0
    }


processSuggestionResult : Result (Error Never) (List item) -> Model item -> Model item
processSuggestionResult result model =
    case result of
        Ok items ->
            { model | suggestions = Just items }

        Err _ ->
            model


update :
    { fetchSuggestions : String -> HttpCmd Never (List item)
    , toName : item -> String
    , validate : String -> HttpCmd Never (Maybe item)
    }
    -> Msg item
    -> Model item
    -> ( Model item, Cmd (Msg item) )
update config msg model =
    let
        getSuggestionsMatch : String -> Maybe (List item) -> Maybe item
        getSuggestionsMatch requestedString suggestions =
            suggestions
                |> Maybe.withDefault []
                |> List.find (config.toName >> (==) requestedString)
    in
    case msg of
        NoOp ->
            ( model, Cmd.none )

        OnInput elementId string ->
            if model.searchTerm /= string then
                { model | searchTerm = string }
                    |> Cmd.withTrigger (InputDebouncerMsg <| Debouncer.provideInput <| FetchSuggestions { applyIfMatch = False } elementId string)

            else if String.isEmpty string then
                Cmd.pure { model | searchTerm = string, suggestions = Nothing }

            else
                Cmd.pure model

        OnEnter elementId ->
            case getSuggestionsMatch model.searchTerm model.suggestions of
                Just item ->
                    Cmd.withTrigger (SelectSuggestion elementId.elementId item) model

                Nothing ->
                    model
                        |> Cmd.with
                            (config.validate model.searchTerm
                                |> Cmd.map
                                    (Result.map (List.singleton >> Maybe.values)
                                        >> SuggestionsLoaded { applyIfMatch = True } elementId model.searchTerm
                                    )
                            )

        FetchSuggestions applyIfMatch elementId string ->
            model
                |> Cmd.with (config.fetchSuggestions string |> Cmd.map (SuggestionsLoaded applyIfMatch elementId string))

        SuggestionsLoaded { applyIfMatch } { elementId } requestedString result ->
            let
                selectItemIfMatch : Model item -> ( Model item, Cmd (Msg item) )
                selectItemIfMatch m =
                    if applyIfMatch then
                        getSuggestionsMatch requestedString m.suggestions
                            |> Maybe.unwrap (Cmd.pure m)
                                (\item ->
                                    m
                                        |> Cmd.withTrigger (SelectSuggestion elementId item)
                                )

                    else
                        Cmd.pure m
            in
            processSuggestionResult result model
                |> selectItemIfMatch

        InputDebouncerMsg subMsg ->
            let
                ( newDebouncer, debouncerCmd, emittedMsg ) =
                    Debouncer.update subMsg model.inputDebouncer

                command =
                    Cmd.map InputDebouncerMsg debouncerCmd

                newModel =
                    { model | inputDebouncer = newDebouncer }
            in
            case emittedMsg of
                Just emitted ->
                    update config emitted newModel |> Cmd.add command

                Nothing ->
                    ( newModel, command )

        SelectSuggestion elementId suggestion ->
            ( { model
                | selectedItems = model.selectedItems ++ [ suggestion ] |> List.unique
                , suggestions = Nothing
                , searchTerm = ""
              }
            , Task.attempt (always NoOp) <| Browser.Dom.focus elementId
            )

        RemoveItemFromSelected elementId item ->
            ( { model | selectedItems = List.filter ((/=) item) model.selectedItems }
            , Task.attempt (always NoOp) <| Browser.Dom.focus elementId
            )

        FocusInput elementId ->
            ( model, Task.attempt (always NoOp) <| Browser.Dom.focus elementId )

        InputBlur ->
            ( model, Process.sleep 500 |> Task.perform (always CloseSuggestions) )

        CloseSuggestions ->
            Cmd.pure
                { model
                    | suggestions = Nothing
                    , selectionIndex = 0
                    , inputDebouncer = Debouncer.cancel model.inputDebouncer
                }

        ChangedIndex newIndex ->
            Cmd.pure { model | selectionIndex = newIndex }


inputElementId : String
inputElementId =
    "autocomplete-input-module-input-element-id"


view : Config item -> Model item -> Html (Msg item)
view { toLabel, toOption, moduleClass, uniqueElementId, placeholder, icon } model =
    let
        uniqueInputElementId =
            uniqueElementId ++ inputElementId

        suggestionsView suggestions =
            if List.isEmpty suggestions then
                Html.div [ WeakCss.nestMany [ "container", "suggestions" ] moduleClass ]
                    [ Html.div [ WeakCss.nestMany [ "container", "suggestions", "no-results" ] moduleClass ]
                        [ Html.text "No results found" ]
                    ]

            else
                suggestions
                    |> List.indexedMap
                        (\index suggestion ->
                            Html.div
                                [ Events.onClickStopPropagation <| SelectSuggestion uniqueInputElementId suggestion
                                , WeakCss.addMany [ "container", "suggestions", "item" ] moduleClass
                                    |> WeakCss.withStates [ ( "selected", index == model.selectionIndex ) ]
                                ]
                                [ toOption suggestion index ]
                        )
                    |> Html.div [ WeakCss.nestMany [ "container", "suggestions" ] moduleClass ]

        isEmpty : Bool
        isEmpty =
            List.isEmpty model.selectedItems

        msgs : { changedIndex : Int -> Msg item, changedSelection : item -> Msg item }
        msgs =
            { changedIndex = ChangedIndex
            , changedSelection = \item -> SelectSuggestion (toLabel item) item
            }

        enterDcoder : msg -> Decoder msg
        enterDcoder msg =
            Decode.field "key" Decode.string
                |> Decode.andThen
                    (\key ->
                        case key of
                            "Enter" ->
                                Decode.succeed msg

                            _ ->
                                Decode.fail "Not the key we're interested in"
                    )

        selectedAndInputView =
            ((model.selectedItems
                |> List.map
                    (\item ->
                        Html.div [ WeakCss.nestMany [ "container", "selected-items", "item" ] moduleClass ]
                            [ Html.text <| toLabel item
                            , Html.button
                                [ WeakCss.nestMany [ "container", "selected-items", "item", "remove" ] moduleClass
                                , Events.onClickStopPropagation <| RemoveItemFromSelected uniqueInputElementId item
                                ]
                                [ Icons.icon [ Icons.width 29 ] P2Icons.cross
                                ]
                            ]
                    )
             )
                ++ [ Html.input
                        [ WeakCss.nestMany [ "container", "input" ] moduleClass
                        , Attrs.attribute "autocomplete" "off"
                        , Events.onInput (OnInput { elementId = uniqueInputElementId })
                        , Attrs.attributeIf (String.isEmpty model.searchTerm)
                            (List.last model.selectedItems
                                |> Attrs.attributeMaybe
                                    (Events.onBackspace << RemoveItemFromSelected uniqueInputElementId)
                            )
                        , Events.onBlur InputBlur
                        , Attrs.id uniqueInputElementId
                        , Attrs.value model.searchTerm
                        , Attrs.attributeIf isEmpty <| Attrs.placeholder placeholder
                        , Events.on "keyup" (enterDcoder <| OnEnter { elementId = uniqueInputElementId })
                        , onKeyDown msgs model.selectionIndex (Maybe.withDefault [] model.suggestions)
                        ]
                        []
                   ]
            )
                |> Html.div [ WeakCss.nestMany [ "container", "selected-items" ] moduleClass ]
    in
    Html.div [ WeakCss.nest "container" moduleClass ]
        [ Html.div
            [ WeakCss.nestMany [ "container", "input-cont" ] moduleClass
            , Events.onClick <| FocusInput uniqueInputElementId
            ]
            [ Html.span
                [ WeakCss.nest "search-icon" moduleClass ]
                [ Icons.icon [] icon ]
            , selectedAndInputView
            ]
        , Html.viewMaybe suggestionsView model.suggestions
        ]


onKeyDown :
    { r | changedIndex : Int -> msg, changedSelection : item -> msg }
    -> Int
    -> List item
    -> Attribute msg
onKeyDown msgs selectionIndex options =
    let
        newIndex operator =
            modBy (List.length options) (operator selectionIndex 1)
                |> msgs.changedIndex
                |> Decode.succeed

        isArrowKey keyName =
            case keyName of
                "ArrowDown" ->
                    newIndex (+)

                "ArrowUp" ->
                    newIndex (-)

                "Enter" ->
                    options
                        |> List.drop selectionIndex
                        |> List.head
                        |> Maybe.map (msgs.changedSelection >> Decode.succeed)
                        |> Maybe.withDefault (Decode.fail "invalid index")

                _ ->
                    Decode.fail "key not handled"
    in
    Decode.field "key" Decode.string
        |> Decode.andThen isArrowKey
        |> Events.on "keydown"