lamassu-server/lamassu-admin-elm/src/Selectize.elm
2018-10-08 21:29:06 +02:00

552 lines
16 KiB
Elm

module Selectize
exposing
( initialSelectize
, view
, State
, Config
, HtmlOptions
, HtmlClasses
)
import Html exposing (..)
import Html.Attributes exposing (value, defaultValue, maxlength, class, classList, id, disabled)
import Html.Events as E exposing (on, onWithOptions)
import String
import Json.Decode as Json
import Css.Classes exposing (CssClasses)
import Css.Admin exposing (className)
-- MODEL
type alias HtmlOptions =
{ instructionsForBlank : String
, noMatches : String
, typeForMore : String
, atMaxLength : String
, noOptions : String
, notAvailable : String
, classes : HtmlClasses
, customCssClass : CssClasses
}
type alias HtmlClasses =
{ container : String
, noOptions : String
, singleItemContainer : String
, multiItemContainer : String
, selectBox : String
, selectedItems : String
, fallbackItems : String
, fallbackItem : String
, selectedItem : String
, boxContainer : String
, boxItems : String
, boxItem : String
, boxItemActive : String
, info : String
, infoNoMatches : String
, inputEditing : String
}
type alias H =
HtmlOptions
type Status
= Initial
| Editing
| Cleared
| Idle
| Blurred
type alias State =
{ boxPosition : Int
, status : Status
, string : String
}
type alias Config msg idType itemType =
{ maxItems : Int
, boxLength : Int
, toMsg : State -> msg
, onAdd : idType -> State -> msg
, onRemove : State -> msg
, onFocus : State -> msg
, onBlur : State -> msg
, toId : itemType -> idType
, enabled : Bool
, selectedDisplay : itemType -> String
, optionDisplay : itemType -> String
, match : String -> List itemType -> List itemType
, htmlOptions : HtmlOptions
}
type alias Items itemType =
{ selectedItems : List itemType
, availableItems : List itemType
, boxItems : List itemType
}
initialSelectize : State
initialSelectize =
{ boxPosition = -1, string = "", status = Blurred }
-- UPDATE
clean : String -> String
clean s =
String.trim s
|> String.toLower
updateKeyUp : Config msg idType itemType -> Items itemType -> State -> Int -> msg
updateKeyUp config items state keyCode =
if keyCode == 13 || keyCode == 9 then
config.toMsg { state | status = Initial }
else
config.toMsg state
addSelection : Config msg idType itemType -> Items itemType -> State -> msg
addSelection config items state =
let
maybeItem =
if state.boxPosition < 0 then
Nothing
else
(List.head << (List.drop state.boxPosition)) items.boxItems
in
case maybeItem of
Nothing ->
config.toMsg state
Just item ->
config.onAdd (config.toId item) { state | status = Cleared, string = "", boxPosition = -1 }
updateKeyDown : Config msg idType itemType -> Items itemType -> State -> Int -> msg
updateKeyDown config items state keyCode =
if config.maxItems > 1 && List.length items.selectedItems == config.maxItems then
case keyCode of
-- backspace
8 ->
if String.isEmpty state.string && (not << List.isEmpty) items.selectedItems then
config.onRemove state
else
config.toMsg state
_ ->
config.toMsg state
else
case keyCode of
-- up
38 ->
config.toMsg { state | boxPosition = (max -1 (state.boxPosition - 1)) }
-- down
40 ->
config.toMsg
{ state
| boxPosition =
(min ((List.length items.boxItems) - 1)
(state.boxPosition + 1)
)
}
-- enter
13 ->
addSelection config items state
-- backspace
8 ->
if String.isEmpty state.string && (not << List.isEmpty) items.selectedItems then
config.onRemove state
else
config.toMsg state
-- tab
9 ->
addSelection config items state
_ ->
config.toMsg state
-- VIEW
itemView : Config msg idType itemType -> Bool -> itemType -> Html msg
itemView config isFallback item =
let
c =
config.htmlOptions.classes
in
span
[ classList
[ ( c.selectedItem, True )
, ( c.fallbackItem, isFallback )
]
]
[ text (config.selectedDisplay item) ]
fallbackItemsView : Config msg idType itemType -> Items itemType -> List itemType -> State -> Html msg
fallbackItemsView config items fallbackItems state =
let
c =
config.htmlOptions.classes
selectedItems =
items.selectedItems
isFallback =
List.length selectedItems == 0
classes =
classList
[ ( c.selectedItems, True )
, ( c.fallbackItems, isFallback )
]
itemsView =
if isFallback then
fallbackItems
else
items.selectedItems
in
span [ classes ] (List.map (itemView config isFallback) itemsView)
itemsView : Config msg idType itemType -> Items itemType -> List itemType -> State -> Html msg
itemsView config items fallbackItems state =
case state.status of
Editing ->
fallbackItemsView config items [] state
Initial ->
fallbackItemsView config items [] state
Idle ->
fallbackItemsView config items [] state
Cleared ->
fallbackItemsView config items fallbackItems state
Blurred ->
fallbackItemsView config items fallbackItems state
editingBoxView : Config msg idType itemType -> Items itemType -> State -> Html msg
editingBoxView config items state =
let
h =
config.htmlOptions
c =
h.classes
boxItemHtml pos item =
div
[ classList
[ ( c.boxItem, True )
, ( c.boxItemActive, state.boxPosition == pos )
]
, onMouseDown config state (config.toId item)
]
[ text (config.optionDisplay item)
]
in
div [ class c.boxItems ] (List.indexedMap boxItemHtml items.boxItems)
idleBoxView : Config msg idType itemType -> Items itemType -> State -> Html msg
idleBoxView config items state =
let
h =
config.htmlOptions
numSelected =
List.length items.selectedItems
remainingItems =
List.length items.availableItems - numSelected
typeForMore =
if remainingItems > config.boxLength then
if numSelected < config.maxItems then
div [ class h.classes.info ] [ text h.typeForMore ]
else
div [ class h.classes.info ] [ text "Backspace for more" ]
else
span [] []
in
if config.maxItems > 1 && List.length items.selectedItems == config.maxItems then
span [] []
else
div [ class h.classes.boxContainer ]
[ editingBoxView config items state
, typeForMore
]
noMatches : Config msg idType itemType -> List itemType -> State -> Html msg
noMatches config boxItems state =
let
h =
config.htmlOptions
in
if List.length boxItems == 0 then
div
[ classList
[ ( h.classes.info, True )
, ( h.classes.infoNoMatches, True )
]
]
[ text h.noMatches ]
else
span [] []
boxView : Config msg idType itemType -> Items itemType -> State -> Html msg
boxView config items state =
let
h =
config.htmlOptions
in
case state.status of
Editing ->
div [ class h.classes.boxContainer ]
[ editingBoxView config items state
, noMatches config items.boxItems state
]
Initial ->
idleBoxView config items state
Idle ->
idleBoxView config items state
Cleared ->
idleBoxView config items state
Blurred ->
span [] []
buildItems : List itemType -> List itemType -> List itemType -> Items itemType
buildItems selectedItems availableItems boxItems =
{ selectedItems = selectedItems
, availableItems = availableItems
, boxItems = boxItems
}
diffItems : Config msg idType itemType -> List itemType -> List itemType -> List itemType
diffItems config a b =
let
isEqual itemA itemB =
config.toId itemA == config.toId itemB
notInB b item =
(List.any (isEqual item) b)
|> not
in
List.filter (notInB b) a
mapToItem : (itemType -> idType) -> List itemType -> idType -> Maybe itemType
mapToItem toId available id =
List.filter (((==) id) << toId) available
|> List.head
view : Config msg idType itemType -> List idType -> List itemType -> List idType -> State -> Html msg
view config selectedIds availableItems fallbackIds state =
if List.length availableItems == 0 then
div [ class config.htmlOptions.classes.container ]
[ div [ class config.htmlOptions.classes.noOptions ] [ text config.htmlOptions.noOptions ] ]
else if not config.enabled then
div [ class config.htmlOptions.classes.container ]
[ div [ class config.htmlOptions.classes.noOptions ] [ text "\x2008" ] ]
else
let
h =
config.htmlOptions
selectedItems =
List.filterMap (mapToItem config.toId availableItems) selectedIds
fallbackItems =
List.filterMap (mapToItem config.toId availableItems) fallbackIds
remainingItems =
diffItems config availableItems selectedItems
boxItems =
config.match state.string remainingItems
|> List.take 5
items =
buildItems selectedItems availableItems boxItems
onInputAtt =
onInput config state
onBlurAtt =
onBlur config state
onFocusAtt =
onFocus config state
keyDown =
if config.maxItems > 1 then
if String.isEmpty state.string then
onKeyDownNoDelete config items state
else
onKeyDownDelete config items state
else
onKeyDown config items state
editInput =
case state.status of
Initial ->
if (List.length selectedItems) < config.maxItems then
input [ onBlurAtt, onInputAtt ] []
else
input [ onBlurAtt, onInputAtt, maxlength 0 ] []
Idle ->
if (List.length selectedItems) < config.maxItems then
input [ onBlurAtt, onInputAtt ] []
else
input [ onBlurAtt, onInputAtt, maxlength 0 ] []
Editing ->
let
actualMaxlength =
if List.length boxItems == 0 then
0
else
524288
in
input [ maxlength actualMaxlength, onBlurAtt, onInputAtt, class h.classes.inputEditing ] []
Cleared ->
input [ onKeyUp config items state, value "", onBlurAtt, onInputAtt ] []
Blurred ->
input [ maxlength 0, onFocusAtt, value "" ] []
in
div [ class h.classes.container ]
[ label
[ classList
[ ( h.classes.singleItemContainer, config.maxItems == 1 )
, ( h.classes.multiItemContainer, config.maxItems > 1 )
, ( className config.htmlOptions.customCssClass, True)
]
]
[ span [ class h.classes.selectBox, keyDown ]
[ span [] [ itemsView config items fallbackItems state ]
, editInput
]
, boxView config items state
]
]
onInput : Config msg idType itemType -> State -> Attribute msg
onInput config state =
let
tagger s =
if (String.length s == 0) then
config.toMsg { state | status = Idle, string = s }
else
config.toMsg { state | status = Editing, string = s }
in
E.onInput tagger
onMouseDown : Config msg idType itemType -> State -> idType -> Attribute msg
onMouseDown config state id =
E.onMouseDown (config.onAdd id state)
onBlur : Config msg idType itemType -> State -> Attribute msg
onBlur config state =
E.onBlur (config.onBlur { state | status = Blurred })
onFocus : Config msg idType itemType -> State -> Attribute msg
onFocus config state =
E.onFocus (config.onFocus { state | status = Initial, boxPosition = -1 })
onKeyDownDelete : Config msg idType itemType -> Items itemType -> State -> Attribute msg
onKeyDownDelete config items state =
rawOnKeyDown deleteSpecialKeys (updateKeyDown config items state)
onKeyDownNoDelete : Config msg idType itemType -> Items itemType -> State -> Attribute msg
onKeyDownNoDelete config items state =
rawOnKeyDown noDeleteSpecialKeys (updateKeyDown config items state)
onKeyDown : Config msg idType itemType -> Items itemType -> State -> Attribute msg
onKeyDown config items state =
rawOnKeyDownNoPrevent (updateKeyDown config items state)
onKeyUp : Config msg idType itemType -> Items itemType -> State -> Attribute msg
onKeyUp config items state =
rawOnKeyUp (updateKeyUp config items state)
noDeleteSpecialKeys : List Int
noDeleteSpecialKeys =
[ 8, 38, 40, 9, 13, 27 ]
deleteSpecialKeys : List Int
deleteSpecialKeys =
[ 38, 40, 9, 13, 27 ]
preventSpecialDecoder : List Int -> Json.Decoder Int
preventSpecialDecoder specialKeys =
E.keyCode
|> Json.andThen
(\code ->
if List.member code specialKeys then
Json.succeed code
else
Json.fail "don't prevent"
)
rawOnKeyDown : List Int -> (Int -> msg) -> Attribute msg
rawOnKeyDown specialKeys tagger =
let
options =
{ stopPropagation = False, preventDefault = True }
in
onWithOptions "keydown" options (Json.map tagger (preventSpecialDecoder specialKeys))
rawOnKeyDownNoPrevent : (Int -> msg) -> Attribute msg
rawOnKeyDownNoPrevent tagger =
onWithOptions "keydown" { stopPropagation = False, preventDefault = False } (Json.map tagger E.keyCode)
rawOnKeyUp : (Int -> msg) -> Attribute msg
rawOnKeyUp tagger =
on "keyup" (Json.map tagger E.keyCode)