docspell/modules/webapp/src/main/elm/Comp/Dropdown.elm

module Comp.Dropdown exposing ( Model
                              , Option
                              , makeModel
                              , makeSingle
                              , makeSingleList
                              , makeMultiple
                              , update
                              , isDropdownChangeMsg
                              , view
                              , getSelected
                              , Msg(..))

import Http
import Task
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onInput, onClick, onFocus, onBlur)
import Json.Decode as Decode
import Simple.Fuzzy
import Util.Html exposing (onKeyUp)
import Util.List

type alias Option =
    { value: String
    , text: String
    }

type alias Item a =
    { value: a
    , option: Option
    , visible: Bool
    , selected: Bool
    , active: Bool
    }

makeItem: Model a -> a -> Item a
makeItem model val =
    { value = val
    , option = model.makeOption val
    , visible = True
    , selected = False
    , active = False
    }

type alias Model a =
    { multiple: Bool
    , selected: List (Item a)
    , available: List (Item a)
    , makeOption: a -> Option
    , menuOpen: Bool
    , filterString: String
    , labelColor: a -> String
    , searchable: Int -> Bool
    , placeholder: String
    }

makeModel:
    { multiple: Bool
    , searchable: Int -> Bool
    , makeOption: a -> Option
    , labelColor: a -> String
    , placeholder: String
    } ->  Model a
makeModel input =
    { multiple = input.multiple
    , searchable = input.searchable
    , selected = []
    , available = []
    , makeOption = input.makeOption
    , menuOpen = False
    , filterString = ""
    , labelColor = input.labelColor
    , placeholder = input.placeholder
    }

makeSingle:
    { makeOption: a -> Option
    , placeholder: String
    } -> Model a
makeSingle opts =
    makeModel
        { multiple = False
        , searchable = \n -> n > 8
        , makeOption = opts.makeOption
        , labelColor = \_ -> ""
        , placeholder = opts.placeholder
        }

makeSingleList:
    { makeOption: a -> Option
    , placeholder: String
    , options: List a
    , selected: Maybe a
    } -> Model a
makeSingleList opts =
    let
        m = makeSingle {makeOption = opts.makeOption, placeholder = opts.placeholder}
        m2 = {m | available = List.map (makeItem m) opts.options}
        m3 = Maybe.map (makeItem m2) opts.selected
             |> Maybe.map (selectItem m2)
             |> Maybe.withDefault m2
    in
        m3

makeMultiple:
    { makeOption: a -> Option
    , labelColor: a -> String
    } -> Model a
makeMultiple opts =
    makeModel
        { multiple = True
        , searchable = \n -> n > 8
        , makeOption = opts.makeOption
        , labelColor = opts.labelColor
        , placeholder = ""
        }

getSelected: Model a -> List a
getSelected model =
    List.map .value model.selected

type Msg a
    = SetOptions (List a)
    | SetSelection (List a)
    | ToggleMenu
    | AddItem (Item a)
    | RemoveItem (Item a)
    | Filter String
    | ShowMenu Bool
    | KeyPress Int

getOptions: Model a -> List (Item a)
getOptions model =
    if not model.multiple && isSearchable model && model.menuOpen
    then List.filter .visible model.available
    else List.filter (\e -> e.visible && (not e.selected)) model.available

isSearchable: Model a -> Bool
isSearchable model =
    List.length model.available |> model.searchable

-- Update

deselectItem: Model a -> Item a -> Model a
deselectItem model item =
    let
        value = item.option.value
        sel = if model.multiple then List.filter (\e -> e.option.value /= value) model.selected
              else []

        show e = if e.option.value == value then {e | selected = False } else e
        avail = List.map show model.available
    in
        { model | selected = sel, available = avail }

selectItem: Model a -> Item a -> Model a
selectItem model item =
    let
        value = item.option.value
        sel = if model.multiple
              then List.concat [ model.selected, [ item ] ]
              else [ item ]

        hide e = if e.option.value == value
                 then {e | selected = True }
                 else if model.multiple then e else {e | selected = False}
        avail = List.map hide model.available
    in
        { model | selected = sel, available = avail }


filterOptions: String -> List (Item a) -> List (Item a)
filterOptions str list =
    List.map (\e -> {e | visible = Simple.Fuzzy.match str e.option.text, active = False}) list

applyFilter: String -> Model a -> Model a
applyFilter str model =
    { model | filterString = str, available = filterOptions str model.available }


makeNextActive: (Int -> Int) -> Model a -> Model a
makeNextActive nextEl model =
    let
        opts = getOptions model
        current = Util.List.findIndexed .active opts
        next = Maybe.map Tuple.second current
                 |> Maybe.map nextEl
                 |> Maybe.andThen (Util.List.get opts)
        merge item1 item2 = { item2 | active = item1.option.value == item2.option.value }
        updateModel item =  { model | available = List.map (merge item) model.available, menuOpen = True }
    in
        case next of
            Just item -> updateModel item
            Nothing ->
                case List.head opts of
                    Just item -> updateModel item
                    Nothing -> model

selectActive: Model a -> Model a
selectActive model =
    let
        current = getOptions model |> Util.List.find .active
    in
        case current of
            Just item ->
                selectItem model item |> applyFilter ""
            Nothing ->
                model

clearActive: Model a -> Model a
clearActive model =
    { model | available = List.map (\e -> {e | active = False}) model.available }


-- TODO enhance update function to return this info
isDropdownChangeMsg: Msg a -> Bool
isDropdownChangeMsg cm =
    case cm of
        AddItem _ -> True
        RemoveItem _ -> True
        KeyPress code ->
             Util.Html.intToKeyCode code
                 |> Maybe.map (\c -> c == Util.Html.Enter)
                 |> Maybe.withDefault False
        _ -> False


update: Msg a -> Model a -> (Model a, Cmd (Msg a))
update msg model =
    case msg of
        SetOptions list ->
            ({model | available = List.map (makeItem model) list}, Cmd.none)

        SetSelection list ->
            let
                m0 = List.foldl (\item -> \m -> deselectItem m item) model model.selected
                m1 = List.map (makeItem model) list
                          |> List.foldl (\item -> \m -> selectItem m item) m0
            in
                (m1, Cmd.none)

        ToggleMenu ->
            ({model | menuOpen = not model.menuOpen}, Cmd.none)

        AddItem e ->
            let
                m = selectItem model e |> applyFilter ""
            in
                ({ m | menuOpen = False }, Cmd.none)

        RemoveItem e ->
            let
                m = deselectItem model e |> applyFilter ""
            in
                ({ m | menuOpen = False }, Cmd.none)

        Filter str ->
            let
                m = applyFilter str model
            in
                ({ m | menuOpen = True}, Cmd.none)

        ShowMenu flag ->
            ({ model | menuOpen = flag }, Cmd.none)

        KeyPress code ->
            case Util.Html.intToKeyCode code of
                Just Util.Html.Up ->
                    (makeNextActive (\n -> n - 1) model, Cmd.none)
                Just Util.Html.Down ->
                    (makeNextActive ((+) 1) model, Cmd.none)
                Just Util.Html.Enter ->
                    let
                        m = selectActive model
                    in
                        ({m | menuOpen = False }, Cmd.none)
                _ ->
                    (model, Cmd.none)


-- View

view: Model a -> Html (Msg a)
view model =
    if model.multiple then viewMultiple model else viewSingle model


viewSingle: Model a -> Html (Msg a)
viewSingle model =
    let
        renderClosed item =
            div [class "message"
                ,style "display" "inline-block !important"
                ,onClick ToggleMenu
                ]
                [i [class "delete icon", onClick (RemoveItem item)][]
                ,text item.option.text
                ]
        renderDefault =
            [ List.head model.selected |> Maybe.map renderClosed |> Maybe.withDefault (renderPlaceholder model)
            , renderMenu model
            ]


        openSearch =
            [ input [ class "search"
                    , placeholder "Search…"
                    , onInput Filter
                    , onKeyUp KeyPress
                    , value model.filterString
                    ][]
            , renderMenu model
            ]
    in
        div [classList [ ("ui search dropdown selection", True)
                       , ("open", model.menuOpen)
                       ]
            ]
            (List.append [ i [class "dropdown icon", onClick ToggleMenu][]
                         ] <|
                 if model.menuOpen && isSearchable model
                 then openSearch
                 else renderDefault
            )


viewMultiple: Model a -> Html (Msg a)
viewMultiple model =
    let
        renderSelectMultiple: Item a -> Html (Msg a)
        renderSelectMultiple item =
            div [classList [ ("ui label", True)
                           , (model.labelColor item.value, True)
                           ]
                ,style "display" "inline-block !important"
                ,onClick (RemoveItem item)
                ]
            [text item.option.text
            ,i [class "delete icon"][]
            ]
    in
        div [classList [ ("ui search dropdown multiple selection", True)
                       , ("open", model.menuOpen)
                       ]
            ]
            (List.concat
                 [ [i [class "dropdown icon", onClick ToggleMenu][]
                   ]
                 , List.map renderSelectMultiple model.selected
                 , if isSearchable model then
                       [ input [ class "search"
                               , placeholder "Search…"
                               , onInput Filter
                               , onKeyUp KeyPress
                               , value model.filterString
                               ][]
                       ]
                   else []
                 , [ renderMenu model
                   ]
                 ])

renderMenu: Model a -> Html (Msg a)
renderMenu model =
    div [classList [( "menu", True )
                   ,( "transition visible", model.menuOpen )
                   ]
        ] (getOptions model |> List.map renderOption)





renderPlaceholder: Model a -> Html (Msg a)
renderPlaceholder model =
    div [classList [ ("placeholder-message", True)
                   , ("text", model.multiple)
                   ]
        ,style "display" "inline-block !important"
        ,onClick ToggleMenu
        ]
      [text model.placeholder
      ]

renderOption: Item a -> Html (Msg a)
renderOption item =
    div [classList [ ("item", True)
                   , ("active", item.active || item.selected)
                   ]
        ,onClick (AddItem item)
        ]
        [text item.option.text
        ]