nunntom/elm-ui-select
1
1
Fork 0
mirror of https://github.com/nunntom/elm-ui-select.git synced 2024-11-29 16:52:25 +03:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'elm-css' into v4.0.0

Browse Source
This commit is contained in:
Tom Nunn 2023-04-13 16:16:31 +01:00
commit 8fb28f2c01
26 changed files with 2050 additions and 393 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
elm.json
View File

@ -7,7 +7,8 @@
"exposed-modules": [
"Select",
"Select.Filter",
"Select.Effect"
"Select.Effect",
"Select.ElmCss"
],
"elm-version": "0.19.0 <= v < 0.20.0",
"dependencies": {
@ -15,7 +16,8 @@
"elm/core": "1.0.0 <= v < 2.0.0",
"elm/html": "1.0.0 <= v < 2.0.0",
"elm/json": "1.0.0 <= v < 2.0.0",
"mdgriffith/elm-ui": "1.0.0 <= v < 2.0.0"
"mdgriffith/elm-ui": "1.0.0 <= v < 2.0.0",
"rtfeldman/elm-css": "18.0.0 <= v < 19.0.0"
},
"test-dependencies": {}
}

26
examples/elm.json
View File

@ -1,18 +1,16 @@
{
"type": "application",
"source-directories": [
"./src",
"../src"
],
"source-directories": ["./src", "../src"],
"elm-version": "0.19.1",
"dependencies": {
"direct": {
"elm/browser": "1.0.1",
"elm/core": "1.0.2",
"elm/browser": "1.0.2",
"elm/core": "1.0.5",
"elm/html": "1.0.0",
"elm/http": "2.0.0",
"elm/json": "1.1.3",
"mdgriffith/elm-ui": "1.1.5",
"mdgriffith/elm-ui": "1.1.8",
"rtfeldman/elm-css": "18.0.0",
"supermario/elm-countries": "1.1.1"
},
"indirect": {
@ -20,23 +18,23 @@
"elm/file": "1.0.5",
"elm/time": "1.0.0",
"elm/url": "1.0.0",
"elm/virtual-dom": "1.0.2"
"elm/virtual-dom": "1.0.3",
"robinheghan/murmur3": "1.0.0",
"rtfeldman/elm-hex": "1.0.0"
}
},
"test-dependencies": {
"direct": {
"elm-explorations/test": "1.2.2",
"avh4/elm-program-test": "3.6.3"
"avh4/elm-program-test": "4.0.0",
"elm-explorations/test": "2.0.0"
},
"indirect": {
"rtfeldman/elm-iso8601-date-strings": "1.1.4",
"avh4/elm-fifo": "1.0.4",
"elm/parser": "1.1.0",
"elm/random": "1.0.0",
"elm-community/list-extra": "8.6.0",
"elm-community/list-extra": "8.7.0",
"hecrj/html-parser": "2.4.0",
"mgold/elm-nonempty-list": "4.2.0",
"rtfeldman/elm-hex": "1.0.0"
"mgold/elm-nonempty-list": "4.2.0"
}
}
}

9
examples/src/EffectExample.elm
View File

@ -56,14 +56,15 @@ view model =
, Element.spacing 20
, Element.padding 30
]
[ Select.view []
{ onChange = CountrySelectMsg
[ Select.view
|> Select.withClearButton (Just Resources.ClearButton.clearButton)
|> Select.toElement []
{ select = model.countrySelect
, onChange = CountrySelectMsg
, label = Input.labelAbove [] (Element.text "Choose a country")
, placeholder = Just (Input.placeholder [] (Element.text "Type to search"))
, itemToString = \c -> c.flag ++ " " ++ c.name
}
|> Select.withClearButton (Just Resources.ClearButton.clearButton)
|> Select.toElement model.countrySelect
, Maybe.map (\{ name } -> Element.text ("You chose " ++ name)) model.selectedCountry
|> Maybe.withDefault Element.none
]

9
examples/src/EffectRequestExample.elm
View File

@ -140,14 +140,15 @@ view model =
, Element.spacing 40
, Element.width (Element.maximum 500 Element.shrink)
]
[ Select.view []
{ onChange = SelectMsg
[ Select.view
|> Select.withClearButton (Just Resources.ClearButton.clearButton)
|> Select.toElement []
{ select = model.select
, onChange = SelectMsg
, label = Input.labelHidden "Find a cocktail"
, placeholder = Just (Input.placeholder [] (Element.text "Type to search cocktails"))
, itemToString = .name
}
|> Select.withClearButton (Just Resources.ClearButton.clearButton)
|> Select.toElement model.select
, Maybe.map drinkView (Select.toValue model.select)
|> Maybe.withDefault Element.none
]

147
examples/src/ElmCssEffectExample.elm Normal file
View File

@ -0,0 +1,147 @@
module ElmCssEffectExample exposing (Model, Msg(..), MyEffect(..), init, main, update, view)
import Browser
import Countries exposing (Country)
import Css
import Html.Styled as Html exposing (Html)
import Html.Styled.Attributes exposing (css)
import Select.Effect
import Select.ElmCss as Select exposing (Select)
main : Program () Model Msg
main =
Browser.element
{ init = \_ -> init () |> Tuple.mapSecond performEffect
, view = view >> Html.toUnstyled
, update = \msg model -> update msg model |> Tuple.mapSecond performEffect
, subscriptions = \_ -> Sub.none
}
type alias Model =
{ countrySelect : Select Country
-- Note it is not necessary to store the following in the model, because you can just use `Select.toValue` etc
-- These are just here for the tests
, selectedCountry : Maybe Country
, inputIsFocused : Maybe Bool
, inputValue : String
}
init : () -> ( Model, MyEffect )
init _ =
( { countrySelect =
Select.init "country-select"
|> Select.setItems Countries.all
, selectedCountry = Nothing
, inputIsFocused = Nothing
, inputValue = ""
}
, NoEffect
)
view : Model -> Html Msg
view model =
Html.div
[ css
[ Css.displayFlex
, Css.alignItems Css.center
, Css.flexDirection Css.column
, Css.marginTop (Css.px 200)
, Css.property "gap" "2em"
, Css.fontFamilies [ "Arial" ]
]
]
[ Html.label
[ css
[ Css.fontSize (Css.rem 1.2)
, Css.lineHeight (Css.rem 1.5)
]
]
[ Html.text "Choose a country"
, Select.view
|> Select.withClearButton
(Just <|
Select.clearButton
[ Css.height (Css.pct 100)
, Css.displayFlex
, Css.alignItems Css.center
, Css.marginRight (Css.em 1)
, Css.fontSize (Css.rem 0.6)
, Css.cursor Css.pointer
]
(Html.text "❌")
)
|> Select.toStyled
[ Css.padding (Css.em 0.5)
, Css.paddingRight (Css.em 1.5)
, Css.fontSize (Css.rem 1.2)
, Css.borderRadius (Css.px 4)
, Css.borderWidth (Css.px 1)
, Css.borderColor (Css.rgba 0 0 0 0.5)
]
{ select = model.countrySelect
, onChange = CountrySelectMsg
, itemToString = \c -> c.flag ++ " " ++ c.name
}
]
, Html.div []
[ Maybe.map (\{ name } -> Html.text ("You chose " ++ name)) (Select.toValue model.countrySelect)
|> Maybe.withDefault (Html.text "")
]
]
type Msg
= CountrySelectMsg (Select.Msg Country)
| SelectionChanged (Maybe Country)
| InputFocused
| InputLostFocus
| InputChanged String
type MyEffect
= SelectEffect (Select.Effect Never Msg)
| NoEffect
update : Msg -> Model -> ( Model, MyEffect )
update msg model =
case msg of
CountrySelectMsg subMsg ->
Select.Effect.updateWith
[ Select.Effect.onSelectedChange SelectionChanged
, Select.Effect.onFocus InputFocused
, Select.Effect.onLoseFocus InputLostFocus
, Select.Effect.onInput InputChanged
]
CountrySelectMsg
subMsg
model.countrySelect
|> Tuple.mapFirst (\select -> { model | countrySelect = select })
|> Tuple.mapSecond SelectEffect
SelectionChanged selected ->
( { model | selectedCountry = selected }, NoEffect )
InputFocused ->
( { model | inputIsFocused = Just True }, NoEffect )
InputLostFocus ->
( { model | inputIsFocused = Just False }, NoEffect )
InputChanged val ->
( { model | inputValue = val }, NoEffect )
performEffect : MyEffect -> Cmd Msg
performEffect effect =
case effect of
NoEffect ->
Cmd.none
SelectEffect selectEffect ->
Select.Effect.perform selectEffect

97
examples/src/ElmCssExample.elm Normal file
View File

@ -0,0 +1,97 @@
module ElmCssExample exposing (main)
import Browser
import Countries exposing (Country)
import Css
import Html.Styled as Html exposing (Html)
import Html.Styled.Attributes exposing (css)
import Select.ElmCss as Select exposing (Select)
main : Program () Model Msg
main =
Browser.element
{ init = init
, view = view >> Html.toUnstyled
, update = update
, subscriptions = \_ -> Sub.none
}
type alias Model =
{ countrySelect : Select Country
}
init : () -> ( Model, Cmd Msg )
init _ =
( { countrySelect =
Select.init "country-select"
|> Select.setItems Countries.all
}
, Cmd.none
)
view : Model -> Html Msg
view model =
Html.div
[ css
[ Css.displayFlex
, Css.alignItems Css.center
, Css.flexDirection Css.column
, Css.marginTop (Css.px 200)
, Css.property "gap" "2em"
, Css.fontFamilies [ "Arial" ]
]
]
[ Html.label
[ css
[ Css.fontSize (Css.rem 1.2)
, Css.lineHeight (Css.rem 1.5)
]
]
[ Html.text "Choose a country"
, Select.view
|> Select.withClearButton
(Just <|
Select.clearButton
[ Css.height (Css.pct 100)
, Css.displayFlex
, Css.alignItems Css.center
, Css.marginRight (Css.em 1)
, Css.fontSize (Css.rem 0.6)
, Css.cursor Css.pointer
]
(Html.text "❌")
)
|> Select.toStyled
[ Css.padding (Css.em 0.5)
, Css.paddingRight (Css.em 1.5)
, Css.fontSize (Css.rem 1.2)
, Css.borderRadius (Css.px 4)
, Css.borderWidth (Css.px 1)
, Css.borderColor (Css.rgba 0 0 0 0.5)
]
{ select = model.countrySelect
, onChange = CountrySelectMsg
, itemToString = \c -> c.flag ++ " " ++ c.name
}
]
, Html.div []
[ Maybe.map (\{ name } -> Html.text ("You chose " ++ name)) (Select.toValue model.countrySelect)
|> Maybe.withDefault (Html.text "")
]
]
type Msg
= CountrySelectMsg (Select.Msg Country)
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
CountrySelectMsg subMsg ->
Select.update CountrySelectMsg subMsg model.countrySelect
|> Tuple.mapFirst (\select -> { model | countrySelect = select })

9
examples/src/Example.elm
View File

@ -43,14 +43,15 @@ view model =
, Element.spacing 20
, Element.padding 30
]
[ Select.view []
{ onChange = CountrySelectMsg
[ Select.view
|> Select.withClearButton (Just Resources.ClearButton.clearButton)
|> Select.toElement []
{ select = model.countrySelect
, onChange = CountrySelectMsg
, label = Input.labelAbove [] (Element.text "Choose a country")
, placeholder = Just (Input.placeholder [] (Element.text "Type to search"))
, itemToString = \c -> c.flag ++ " " ++ c.name
}
|> Select.withClearButton (Just Resources.ClearButton.clearButton)
|> Select.toElement model.countrySelect
, Maybe.map (\{ name } -> Element.text ("You chose " ++ name)) (Select.toValue model.countrySelect)
|> Maybe.withDefault Element.none
]

11
examples/src/RequestExample.elm
View File

@ -97,15 +97,16 @@ view model =
, Element.spacing 40
, Element.width (Element.maximum 500 Element.shrink)
]
[ Select.view []
{ onChange = SelectMsg
[ Select.view
|> Select.withClearButton (Just Resources.ClearButton.clearButton)
|> Select.withSelectExactMatchOnBlur True
|> Select.toElement []
{ select = model.select
, onChange = SelectMsg
, label = Input.labelHidden "Find a cocktail"
, placeholder = Just (Input.placeholder [] (Element.text "Type to search cocktails"))
, itemToString = .name
}
|> Select.withClearButton (Just Resources.ClearButton.clearButton)
|> Select.withSelectExactMatchOnBlur True
|> Select.toElement model.select
, Maybe.map drinkView (Select.toValue model.select)
|> Maybe.withDefault Element.none
]

182
examples/tests/ElmCssExampleTest.elm Normal file
View File

@ -0,0 +1,182 @@
module ElmCssExampleTest exposing (exampleProgramTest)
import Countries exposing (Country)
import ElmCssEffectExample as App
import Expect
import Html
import Html.Styled
import ProgramTest exposing (ProgramTest, SimulatedEffect)
import Select.Effect
import Select.ElmCss as Select exposing (Select)
import SimulateInput
import SimulatedEffect.Cmd as SimulatedCmd
import SimulatedEffect.Process as SimulatedProcess
import SimulatedEffect.Task as SimulatedTask
import Test exposing (Test)
import Test.Html.Event
import Test.Html.Query as Query exposing (Single)
import Test.Html.Selector as Selector exposing (Selector)
exampleProgramTest : Test
exampleProgramTest =
Test.describe "Select Tests"
[ Test.test "Filter for United Kingdom produces one result" <|
\() ->
programTest
|> focusInput
|> ProgramTest.fillIn "" "Choose a country" "United Kingdom"
|> ProgramTest.ensureView
(Query.find [ Selector.id (Select.toMenuElementId countrySelect) ]
>> Query.contains [ Html.text "🇬🇧 United Kingdom of Great Britain and Northern Ireland" ]
)
|> ProgramTest.expectView
(Query.find [ Selector.id (Select.toMenuElementId countrySelect) ]
>> Query.children []
>> Query.count (Expect.equal 1)
)
, Test.test "Click United Kingdom selects it" <|
\() ->
programTest
|> focusInput
|> ProgramTest.fillIn "" "Choose a country" "United"
|> Select.Effect.simulateClickOption simulateInputConfig "country-select" "🇬🇧 United Kingdom of Great Britain and Northern Ireland"
|> ProgramTest.expectViewHas [ Selector.text "You chose United Kingdom of Great Britain and Northern Ireland" ]
, Test.test "Keyboard select United Kingdom" <|
\() ->
programTest
|> focusInput
|> ProgramTest.fillIn "" "Choose a country" "United"
|> SimulateInput.arrowDown "country-select"
|> SimulateInput.enter "country-select"
|> ProgramTest.expectViewHas [ Selector.text "You chose United Kingdom of Great Britain and Northern Ireland" ]
, Test.test "Focusing on the input triggers the onFocus msg" <|
\() ->
programTest
|> focusInput
|> ProgramTest.expectModel (.inputIsFocused >> Expect.equal (Just True))
, Test.test "Input losing focus triggers the onLoseFocus msg" <|
\() ->
programTest
|> focusInput
|> ProgramTest.simulateDomEvent (Query.find [ Selector.id (Select.toInputElementId countrySelect) ]) Test.Html.Event.blur
|> ProgramTest.expectModel (.inputIsFocused >> Expect.equal (Just False))
, Test.test "Filling in the input triggers the onInput msg" <|
\() ->
programTest
|> ProgramTest.fillIn "" "Choose a country" "Testing the input"
|> ProgramTest.expectModel (.inputValue >> Expect.equal "Testing the input")
, Test.test "Typing 2 chars with withMinInputLength (Just 3) does not show any items" <|
\() ->
programTestWith (Select.withMinInputLength (Just 3))
|> focusInput
|> ProgramTest.fillIn "" "Choose a country" "un"
|> ProgramTest.expectViewHasNot [ Selector.text "🇬🇧 United Kingdom of Great Britain and Northern Ireland" ]
, Test.test "Typing 3 chars with withMinInputLength (Just 3) does show items" <|
\() ->
programTestWith (Select.withMinInputLength (Just 3))
|> focusInput
|> ProgramTest.fillIn "" "Choose a country" "uni"
|> ProgramTest.expectViewHas [ Selector.text "🇬🇧 United Kingdom of Great Britain and Northern Ireland" ]
, Test.test "Typing less than minInputLength does not show no matches even if nothing matched" <|
\() ->
programTestWith (Select.withMinInputLength (Just 5))
|> focusInput
|> ProgramTest.fillIn "" "Choose a country" "zzzz"
|> ProgramTest.expectViewHasNot [ Selector.text "No matches" ]
, Test.test "Typing up to the minInputLength shows no matches if nothing matched" <|
\() ->
programTestWith (Select.withMinInputLength (Just 3))
|> focusInput
|> ProgramTest.fillIn "" "Choose a country" "zzzz"
|> ProgramTest.expectViewHas [ Selector.text "No matches" ]
, Test.test "Choosing an option and then focusing back on the input shows all the options again" <|
\() ->
programTest
|> focusInput
|> ProgramTest.fillIn "" "Choose a country" "United"
|> Select.Effect.simulateClickOption simulateInputConfig "country-select" "🇬🇧 United Kingdom of Great Britain and Northern Ireland"
|> ProgramTest.simulateDomEvent (Query.find [ Selector.id (Select.toInputElementId countrySelect) ]) Test.Html.Event.focus
|> ProgramTest.expectViewHas [ Selector.text "🇦🇩 Andorra" ]
, Test.test "Setting open on focus to false does not open the menu when the input is focused" <|
\() ->
programTestWith (Select.withOpenMenuOnFocus False)
|> focusInput
|> ProgramTest.expectModel (.countrySelect >> Select.isMenuOpen >> Expect.equal False)
, Test.test "Setting open on focus to true does open the menu when the input is focused" <|
\() ->
programTestWith (Select.withOpenMenuOnFocus True)
|> focusInput
|> ProgramTest.expectModel (.countrySelect >> Select.isMenuOpen >> Expect.equal True)
]
programTest : ProgramTest App.Model App.Msg App.MyEffect
programTest =
ProgramTest.createElement
{ init = App.init
, update = App.update
, view = App.view >> Html.Styled.toUnstyled
}
|> ProgramTest.withSimulatedEffects simulateEffect
|> ProgramTest.start ()
programTestWith : (Select.ViewConfig Country App.Msg -> Select.ViewConfig Country App.Msg) -> ProgramTest App.Model App.Msg App.MyEffect
programTestWith f =
ProgramTest.createElement
{ init = App.init
, update = App.update
, view =
\m ->
Html.div []
[ Html.label []
[ Html.text "Choose a country"
, Select.view
|> f
|> Select.toStyled []
{ select = m.countrySelect
, onChange = App.CountrySelectMsg
, itemToString = \c -> c.flag ++ " " ++ c.name
}
|> Html.Styled.toUnstyled
]
]
}
|> ProgramTest.withSimulatedEffects simulateEffect
|> ProgramTest.start ()
countrySelect : Select Country
countrySelect =
App.init ()
|> Tuple.first
|> .countrySelect
simulateInputConfig : Select.Effect.SimulateInputConfig (Single msg) Selector (ProgramTest model msg effect)
simulateInputConfig =
{ simulateDomEvent = ProgramTest.simulateDomEvent
, find = Query.find
, attribute = Selector.attribute
}
simulateEffect : App.MyEffect -> SimulatedEffect App.Msg
simulateEffect effect =
case effect of
App.NoEffect ->
SimulatedCmd.none
App.SelectEffect selectEffect ->
Select.Effect.simulate
{ perform = SimulatedTask.perform
, batch = SimulatedCmd.batch
, sleep = SimulatedProcess.sleep
}
selectEffect
focusInput : ProgramTest model msg effect -> ProgramTest model msg effect
focusInput =
ProgramTest.simulateDomEvent (Query.find [ Selector.id (Select.toInputElementId countrySelect) ]) Test.Html.Event.focus

62
examples/tests/ExampleTest.elm
View File

@ -6,6 +6,7 @@ import Element
import Element.Input as Input
import Expect
import Html
import Html.Attributes
import ProgramTest exposing (ProgramTest, SimulatedEffect)
import Select exposing (Select)
import Select.Effect
@ -24,7 +25,7 @@ exampleProgramTest =
Test.describe "Select Tests"
[ Test.test "Filter for United Kingdom produces one result" <|
\() ->
programTest
programTest Nothing
|> focusInput
|> ProgramTest.fillIn "" "Choose a country" "United Kingdom"
|> ProgramTest.ensureView
@ -38,14 +39,14 @@ exampleProgramTest =
)
, Test.test "Click United Kingdom selects it" <|
\() ->
programTest
programTest Nothing
|> focusInput
|> ProgramTest.fillIn "" "Choose a country" "United"
|> Select.Effect.simulateClickOption simulateInputConfig "country-select" "🇬🇧 United Kingdom of Great Britain and Northern Ireland"
|> ProgramTest.expectViewHas [ Selector.text "You chose United Kingdom of Great Britain and Northern Ireland" ]
, Test.test "Keyboard select United Kingdom" <|
\() ->
programTest
programTest Nothing
|> focusInput
|> ProgramTest.fillIn "" "Choose a country" "United"
|> SimulateInput.arrowDown "country-select"
@ -53,18 +54,18 @@ exampleProgramTest =
|> ProgramTest.expectViewHas [ Selector.text "You chose United Kingdom of Great Britain and Northern Ireland" ]
, Test.test "Focusing on the input triggers the onFocus msg" <|
\() ->
programTest
programTest Nothing
|> focusInput
|> ProgramTest.expectModel (.inputIsFocused >> Expect.equal (Just True))
, Test.test "Input losing focus triggers the onLoseFocus msg" <|
\() ->
programTest
programTest Nothing
|> focusInput
|> ProgramTest.simulateDomEvent (Query.find [ Selector.id (Select.toInputElementId countrySelect) ]) Test.Html.Event.blur
|> ProgramTest.expectModel (.inputIsFocused >> Expect.equal (Just False))
, Test.test "Filling in the input triggers the onInput msg" <|
\() ->
programTest
programTest Nothing
|> ProgramTest.fillIn "" "Choose a country" "Testing the input"
|> ProgramTest.expectModel (.inputValue >> Expect.equal "Testing the input")
, Test.test "Typing 2 chars with withMinInputLength (Just 3) does not show any items" <|
@ -73,7 +74,7 @@ exampleProgramTest =
|> focusInput
|> ProgramTest.fillIn "" "Choose a country" "un"
|> ProgramTest.expectViewHasNot [ Selector.text "🇬🇧 United Kingdom of Great Britain and Northern Ireland" ]
, Test.test "Typing 3 chars with withMinInputLength (Just 3) does shows items" <|
, Test.test "Typing 3 chars with withMinInputLength (Just 3) does show items" <|
\() ->
programTestWith (Select.withMinInputLength (Just 3))
|> focusInput
@ -93,19 +94,49 @@ exampleProgramTest =
|> ProgramTest.expectViewHas [ Selector.text "No matches" ]
, Test.test "Choosing an option and then focusing back on the input shows all the options again" <|
\() ->
programTest
programTest Nothing
|> focusInput
|> ProgramTest.fillIn "" "Choose a country" "United"
|> Select.Effect.simulateClickOption simulateInputConfig "country-select" "🇬🇧 United Kingdom of Great Britain and Northern Ireland"
|> ProgramTest.simulateDomEvent (Query.find [ Selector.id (Select.toInputElementId countrySelect) ]) Test.Html.Event.focus
|> ProgramTest.expectViewHas [ Selector.text "🇦🇩 Andorra" ]
, Test.test "Programatically selecting an item shows the correct input value and selects the item" <|
\() ->
programTest (Countries.fromCode "AQ")
|> ProgramTest.ensureView
(Query.find
[ Selector.id (Select.toInputElementId countrySelect)
]
>> Query.has [ Selector.attribute (Html.Attributes.value "🇦🇶 Antarctica") ]
)
|> ProgramTest.expectModel (.countrySelect >> Select.toValue >> Expect.equal (Countries.fromCode "AQ"))
, Test.test "Programatically selecting an item and the focusing the input keeps the selected item input value" <|
\() ->
programTest (Countries.fromCode "AQ")
|> focusInput
|> ProgramTest.expectView
(Query.find
[ Selector.id (Select.toInputElementId countrySelect)
]
>> Query.has [ Selector.attribute (Html.Attributes.value "🇦🇶 Antarctica") ]
)
, Test.test "Setting open on focus to false does not open the menu when the input is focused" <|
\() ->
programTestWith (Select.withOpenMenuOnFocus False)
|> focusInput
|> ProgramTest.expectModel (.countrySelect >> Select.isMenuOpen >> Expect.equal False)
, Test.test "Setting open on focus to true does open the menu when the input is focused" <|
\() ->
programTestWith (Select.withOpenMenuOnFocus True)
|> focusInput
|> ProgramTest.expectModel (.countrySelect >> Select.isMenuOpen >> Expect.equal True)
]
programTest : ProgramTest App.Model App.Msg App.MyEffect
programTest =
programTest : Maybe Country -> ProgramTest App.Model App.Msg App.MyEffect
programTest country =
ProgramTest.createElement
{ init = App.init
{ init = App.init >> Tuple.mapFirst (\m -> { m | countrySelect = Select.setSelected country m.countrySelect })
, update = App.update
, view = App.view
}
@ -121,14 +152,15 @@ programTestWith f =
, view =
\m ->
Element.layout [] <|
(Select.view []
{ onChange = App.CountrySelectMsg
(Select.view
|> f
|> Select.toElement []
{ select = m.countrySelect
, onChange = App.CountrySelectMsg
, label = Input.labelAbove [] (Element.text "Choose a country")
, placeholder = Just (Input.placeholder [] (Element.text "Type to search"))
, itemToString = \c -> c.flag ++ " " ++ c.name
}
|> f
|> Select.toElement m.countrySelect
)
}
|> ProgramTest.withSimulatedEffects simulateEffect

4
package.json
View File

@ -9,9 +9,7 @@
"ci": "npm run review && npm run review-examples && npm run test",
"examples": "cd examples/src && elm reactor"
},
"pre-commit": [
"ci"
],
"pre-commit": [],
"repository": {
"type": "git",
"url": "git+https://github.com/nunntom/elm-ui-select.git"

34
src/Internal/List/Extra.elm Normal file
View File

@ -0,0 +1,34 @@
module Internal.List.Extra exposing (find, findIndex)
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
findIndex : (a -> Bool) -> List a -> Maybe Int
findIndex =
findIndexHelp 0
findIndexHelp : Int -> (a -> Bool) -> List a -> Maybe Int
findIndexHelp index predicate list =
case list of
[] ->
Nothing
x :: xs ->
if predicate x then
Just index
else
findIndexHelp (index + 1) predicate xs

23
src/Internal/Model.elm
View File

@ -9,6 +9,7 @@ module Internal.Model exposing
, isLoading
, isOpen
, isRequestFailed
, onInputChange
, openMenu
, requiresNewFilteredOptions
, selectOption
@ -25,6 +26,7 @@ module Internal.Model exposing
, toFilteredOptions
, toHighlighted
, toInputElementId
, toInputText
, toInputValue
, toItems
, toMenuElementId
@ -33,6 +35,7 @@ module Internal.Model exposing
, toMenuPlacement
, toOptionElementId
, toOptionState
, toRelativeContainerMarkerId
, toRequestState
, toValue
, wasHighlightedByMouse
@ -166,6 +169,16 @@ toCurrentFilteredOptions (Model { filteredOptions }) =
Maybe.withDefault [] filteredOptions
toInputText : (a -> String) -> Model a -> String
toInputText itemToString model =
if isFocused model then
toInputValue model
else
Maybe.map itemToString (toValue model)
|> Maybe.withDefault (toInputValue model)
toInputElementId : Model a -> String
toInputElementId (Model { id }) =
id ++ "-input"
@ -186,6 +199,11 @@ toOptionElementId (Model { id }) idx =
id ++ "-option-" ++ String.fromInt idx
toRelativeContainerMarkerId : Model a -> String
toRelativeContainerMarkerId (Model { id }) =
id ++ "-container-marker"
toOptionState : Model a -> ( Int, a ) -> OptionState
toOptionState (Model { highlighted, selected }) ( idx, a ) =
if highlighted == Just idx && selected == Just a then
@ -279,6 +297,11 @@ setSelected a (Model model) =
setInputValue : String -> Model a -> Model a
setInputValue v (Model model) =
Model { model | inputValue = v }
onInputChange : String -> Model a -> Model a
onInputChange v (Model model) =
Model
{ model
| inputValue = v

2
src/Internal/Msg.elm
View File

@ -7,7 +7,7 @@ import Internal.Option exposing (Option)
type Msg a
= InputChanged String (List (Option a))
| OptionClicked (Option a)
| InputFocused (Maybe ( List a, List (Option a) ))
| InputFocused Bool String (Maybe ( List a, List (Option a) ))
| GotNewFilteredOptions ( List a, List (Option a) )
| InputClicked
| InputLostFocus

19
src/Internal/Option.elm
View File

@ -1,6 +1,6 @@
module Internal.Option exposing (Option, findByString, findIndex, init, toItem, toString)
import List.Extra
import Internal.List.Extra as List
type alias Option a =
@ -24,22 +24,9 @@ toString ( _, s ) =
findIndex : List (Option a) -> a -> Maybe Int
findIndex list a =
let
findIndex_ idx l =
case l of
[] ->
Nothing
x :: xs ->
if a == toItem x then
Just idx
else
findIndex_ (idx + 1) xs
in
findIndex_ 0 list
List.findIndex (\o -> a == toItem o) list
findByString : List (Option a) -> String -> Maybe (Option a)
findByString list s =
List.Extra.find (\o -> String.toLower s == String.toLower (toString o)) list
List.find (\o -> String.toLower s == String.toLower (toString o)) list

21
src/Internal/Update.elm
View File

@ -1,12 +1,12 @@
module Internal.Update exposing (sendRequest, update)
import Internal.Effect as Effect exposing (Effect)
import Internal.List.Extra as List
import Internal.Model as Model exposing (Model)
import Internal.Msg exposing (Msg(..))
import Internal.Option as Option exposing (Option)
import Internal.RequestState exposing (RequestState(..))
import Internal.UpdateOptions exposing (UpdateOptions)
import List.Extra
update : UpdateOptions err effect a msg -> (Msg a -> msg) -> Msg a -> Model a -> ( Model a, Effect effect msg )
@ -24,11 +24,11 @@ update ({ onSelect } as options) tagger msg model =
update_ : UpdateOptions err effect a msg -> (Msg a -> msg) -> Msg a -> Model a -> ( Model a, Effect effect msg )
update_ { request, requestMinInputLength, debounceRequest, onFocus, onLoseFocus, onInput } tagger msg model =
update_ { request, requestMinInputLength, debounceRequest, onFocus, onLoseFocus, onInput, onKeyDown } tagger msg model =
case msg of
InputChanged val filteredOptions ->
( model
|> Model.setInputValue val
|> Model.onInputChange val
|> Model.highlightIndex
(if String.isEmpty val then
Nothing
@ -74,7 +74,7 @@ update_ { request, requestMinInputLength, debounceRequest, onFocus, onLoseFocus,
, Effect.none
)
InputFocused maybeOptions ->
InputFocused openMenu inputValue maybeOptions ->
(case maybeOptions of
Just ( items, options ) ->
Model.setItems items model
@ -83,7 +83,13 @@ update_ { request, requestMinInputLength, debounceRequest, onFocus, onLoseFocus,
Nothing ->
model
)
|> onFocusMenu tagger (request /= Nothing)
|> Model.setInputValue inputValue
|> (if openMenu then
onFocusMenu tagger (request /= Nothing)
else
\m -> ( Model.setFocused True m, Effect.none )
)
|> withEffect (\_ -> Effect.emitJust onFocus)
InputClicked ->
@ -108,6 +114,7 @@ update_ { request, requestMinInputLength, debounceRequest, onFocus, onLoseFocus,
KeyDown selectOnTab filteredOptions key ->
Model.setFilteredOptions filteredOptions model
|> handleKey selectOnTab tagger (request /= Nothing) key filteredOptions
|> withEffect (\_ -> Effect.emitJust (Maybe.map (\ev -> ev key) onKeyDown))
GotContainerAndMenuElements maybeIdx result ->
( model
@ -253,7 +260,7 @@ getContainerAndMenuElementsEffect maybeIdx tagger model =
Effect.GetContainerAndMenuElements
(GotContainerAndMenuElements maybeIdx >> tagger)
{ menuId = Model.toMenuElementId model
, containerId = Model.toContainerElementId model
, containerId = Model.toRelativeContainerMarkerId model
}
@ -268,7 +275,7 @@ sendRequest tagger selectItem model effect =
(\items ->
case selectItem of
Just selectItem_ ->
( items, List.Extra.find selectItem_ items )
( items, List.find selectItem_ items )
Nothing ->
( items, Nothing )

6
src/Internal/UpdateOptions.elm
View File

@ -9,6 +9,7 @@ type UpdateOption err effect a msg
| OnFocus msg
| OnLoseFocus msg
| OnInput (String -> msg)
| OnKeyDown (String -> msg)
type alias UpdateOptions err effect a msg =
@ -19,6 +20,7 @@ type alias UpdateOptions err effect a msg =
, onFocus : Maybe msg
, onLoseFocus : Maybe msg
, onInput : Maybe (String -> msg)
, onKeyDown : Maybe (String -> msg)
}
@ -31,6 +33,7 @@ init =
, onFocus = Nothing
, onLoseFocus = Nothing
, onInput = Nothing
, onKeyDown = Nothing
}
@ -59,5 +62,8 @@ fromList =
OnInput msg ->
{ opts | onInput = Just msg }
OnKeyDown msg ->
{ opts | onKeyDown = Just msg }
)
init

296
src/Internal/View.elm
View File

@ -1,9 +1,9 @@
module Internal.View exposing
( ViewConfigInternal
, clearButtonElement
( Config
, ViewConfig
, defaultOptionElement
, init
, toElement
, view
)
import Browser.Dom as Dom
@ -12,108 +12,71 @@ import Element.Background as Background
import Element.Border as Border
import Element.Events as Events
import Element.Input as Input
import Element.Region
import Html.Attributes
import Html.Events
import Internal.Filter as Filter exposing (Filter)
import Internal.Model as Model exposing (Model)
import Internal.Msg exposing (Msg(..))
import Internal.Option as Option exposing (Option)
import Internal.OptionState exposing (OptionState(..))
import Internal.Placement as Placement exposing (Placement)
import Internal.RequestState exposing (RequestState(..))
import Internal.View.Common as View
import Internal.View.Events as ViewEvents
import Internal.ViewConfig as ViewConfig exposing (ViewConfigInternal)
import Json.Decode as Decode
type alias ViewConfigInternal a msg =
{ onChange : Msg a -> msg
, inputAttribs : List (Attribute msg)
, itemToString : a -> String
, label : Input.Label msg
, placeholder : Maybe (Input.Placeholder msg)
, filter : Maybe (Filter a)
, menuPlacement : Maybe Placement
, menuMaxHeight : Maybe Int
, menuMaxWidth : Maybe Int
, menuAttributes : List (Placement -> List (Attribute msg))
, noMatchElement : Element msg
, optionElement : OptionState -> a -> Element msg
, clearButton : Maybe (Element msg)
, positionFixed : Bool
, clearInputValueOnBlur : Bool
, selectExactMatchOnBlur : Bool
, selectOnTab : Bool
, minInputLength : Maybe Int
}
view :
List (Attribute msg)
->
{ onChange : Msg a -> msg
type alias Config a msg =
{ select : Model a
, onChange : Msg a -> msg
, itemToString : a -> String
, label : Input.Label msg
, placeholder : Maybe (Input.Placeholder msg)
}
-> ViewConfigInternal a msg
view attribs v =
{ onChange = v.onChange
, inputAttribs = attribs
, itemToString = v.itemToString
, optionElement = defaultOptionElement v.itemToString
, label = v.label
, placeholder = v.placeholder
, filter = Just Filter.startsWithThenContains
, menuPlacement = Nothing
, menuMaxHeight = Nothing
, menuMaxWidth = Nothing
, menuAttributes = []
, noMatchElement = defaultNoMatchElement
, clearButton = Nothing
, positionFixed = False
, clearInputValueOnBlur = False
, selectExactMatchOnBlur = False
, selectOnTab = True
, minInputLength = Nothing
}
toElement : Model a -> ViewConfigInternal a msg -> Element msg
toElement model config =
toElement_ (Model.toMenuPlacement config.menuMaxHeight config.menuPlacement model)
(Model.toFilteredOptions True config.minInputLength config.itemToString config.filter model)
model
type alias ViewConfig a msg =
ViewConfigInternal a (Attribute msg) (Element msg)
init : ViewConfigInternal a (Attribute msg) (Element msg)
init =
ViewConfig.init
toElement : List (Attribute msg) -> Config a msg -> ViewConfig a msg -> Element msg
toElement attrs ({ select } as config) viewConfig =
toElement_ attrs
(ViewConfig.toPlacement select viewConfig)
(ViewConfig.toFilteredOptions select config.itemToString viewConfig)
config
viewConfig
toElement_ : Placement -> List (Option a) -> Model a -> ViewConfigInternal a msg -> Element msg
toElement_ placement filteredOptions model config =
toElement_ : List (Attribute msg) -> Placement -> List (Option a) -> Config a msg -> ViewConfig a msg -> Element msg
toElement_ attrs placement filteredOptions ({ select } as config) viewConfig =
Element.el
(List.concat
[ [ Element.htmlAttribute (Html.Attributes.id <| Model.toContainerElementId model)
[ [ Element.htmlAttribute (Html.Attributes.id <| Model.toContainerElementId select)
, View.relativeContainerMarker select
|> Element.html
|> Element.inFront
, Element.width Element.fill
, Element.below <|
if
List.length filteredOptions
== 0
&& Model.isOpen model
&& (String.length (Model.toInputValue model) >= Maybe.withDefault 1 config.minInputLength)
&& (Model.toRequestState model == Nothing || Model.toRequestState model == Just Success)
then
config.noMatchElement
if ViewConfig.shouldShowNoMatchElement filteredOptions select viewConfig then
Maybe.withDefault defaultNoMatchElement viewConfig.noMatchElement
else
Element.none
, Placement.toAttribute
(if config.positionFixed then
(if viewConfig.positionFixed then
Placement.Below
else
placement
)
<|
(if config.positionFixed then
positionFixedEl placement (Model.toContainerElement model)
(if viewConfig.positionFixed then
positionFixedEl placement (Model.toContainerElement select)
else
identity
@ -121,139 +84,79 @@ toElement_ placement filteredOptions model config =
<|
menuView
(defaultMenuAttrs
{ menuWidth = Model.toMenuMinWidth model
, maxWidth = config.menuMaxWidth
, menuHeight = Model.toMenuMaxHeight config.menuMaxHeight config.menuPlacement model
{ menuWidth = Model.toMenuMinWidth select
, maxWidth = viewConfig.menuMaxWidth
, menuHeight = Model.toMenuMaxHeight viewConfig.menuMaxHeight viewConfig.menuPlacement select
}
++ List.concatMap (\toAttrs -> toAttrs (Model.toMenuPlacement config.menuMaxHeight config.menuPlacement model)) config.menuAttributes
++ List.concatMap (\toAttrs -> toAttrs placement) viewConfig.menuAttributes
)
{ menuId = Model.toMenuElementId model
, toOptionId = Model.toOptionElementId model
, toOptionState = Model.toOptionState model
{ menuId = Model.toMenuElementId select
, toOptionId = Model.toOptionElementId select
, toOptionState = Model.toOptionState select
, onChange = config.onChange
, menuOpen = Model.isOpen model
, menuOpen = Model.isOpen select
, options = filteredOptions
, optionElement = config.optionElement
, optionElement = Maybe.withDefault (defaultOptionElement config.itemToString) viewConfig.optionElement
}
]
, if Model.isOpen model then
, if Model.isOpen select then
[ Element.htmlAttribute <| Html.Attributes.style "z-index" "21" ]
else
[]
, if Model.requiresNewFilteredOptions model then
let
options _ =
optionsUpdate model config filteredOptions
in
[ Element.htmlAttribute <| Html.Events.on "keydown" (Decode.lazy (\_ -> Decode.succeed (GotNewFilteredOptions (options ()) |> config.onChange)))
, Element.htmlAttribute <| Html.Events.on "touchstart" (Decode.lazy (\_ -> Decode.succeed (GotNewFilteredOptions (options ()) |> config.onChange)))
, Element.htmlAttribute <| Html.Events.on "mousemove" (Decode.lazy (\_ -> Decode.succeed (GotNewFilteredOptions (options ()) |> config.onChange)))
]
else
[]
, ViewEvents.updateFilteredOptions config.onChange config.itemToString select viewConfig filteredOptions
|> List.map Element.htmlAttribute
]
)
(inputView filteredOptions model config)
(inputView attrs filteredOptions config viewConfig)
inputView : List (Option a) -> Model a -> ViewConfigInternal a msg -> Element msg
inputView filteredOptions model config =
inputView : List (Attribute msg) -> List (Option a) -> Config a msg -> ViewConfig a msg -> Element msg
inputView attrs filteredOptions ({ select } as config) viewConfig =
Input.text
(List.concat
[ config.inputAttribs
, if Model.requiresNewFilteredOptions model then
[ Element.htmlAttribute (Html.Events.on "focus" (Decode.lazy (\_ -> Decode.succeed (InputFocused (Just <| optionsUpdate model config filteredOptions) |> config.onChange)))) ]
else
[ Events.onFocus (InputFocused Nothing |> config.onChange) ]
, [ Events.onClick (InputClicked |> config.onChange)
[ attrs
, [ ViewEvents.onFocus config.onChange config.itemToString select viewConfig filteredOptions
|> Element.htmlAttribute
, Events.onClick (InputClicked |> config.onChange)
, Events.onLoseFocus
(config.onChange
(InputLostFocus
{ clearInputValue = config.clearInputValueOnBlur
, selectExactMatch = config.selectExactMatchOnBlur
{ clearInputValue = viewConfig.clearInputValueOnBlur
, selectExactMatch = viewConfig.selectExactMatchOnBlur
}
filteredOptions
)
)
, onKeyDown (Model.isOpen model) (KeyDown config.selectOnTab filteredOptions >> config.onChange)
, Element.htmlAttribute (Html.Attributes.id <| Model.toInputElementId model)
, Element.htmlAttribute <|
ViewEvents.onKeyDown (Model.isOpen select) (KeyDown viewConfig.selectOnTab filteredOptions >> config.onChange)
, Element.htmlAttribute (Html.Attributes.id <| Model.toInputElementId select)
, Element.inFront <|
if Model.toValue model /= Nothing || Model.toInputValue model /= "" then
Maybe.withDefault Element.none config.clearButton
if Model.toValue select /= Nothing || Model.toInputValue select /= "" then
viewConfig.clearButton
|> Maybe.map (\( attrs_, el ) -> clearButtonElement config.onChange attrs_ el)
|> Maybe.withDefault Element.none
else
Element.none
]
, inputAccessibilityAttributes filteredOptions model
]
)
{ onChange =
\v ->
InputChanged v
(Model.setInputValue v model
|> Model.toFilteredOptions False config.minInputLength config.itemToString config.filter
)
|> config.onChange
, text =
if Model.isFocused model then
Model.toInputValue model
, List.map Element.htmlAttribute (View.inputAccessibilityAttributes select)
, [ Element.below <|
if Model.isOpen select then
Element.html <| View.ariaLive (List.length filteredOptions)
else
Maybe.map config.itemToString (Model.toValue model)
|> Maybe.withDefault (Model.toInputValue model)
Element.none
]
]
)
{ onChange = ViewEvents.onInput config.onChange config.itemToString select viewConfig
, text = Model.toInputText config.itemToString select
, placeholder = config.placeholder
, label = config.label
}
optionsUpdate : Model a -> ViewConfigInternal a msg -> List (Option a) -> ( List a, List (Option a) )
optionsUpdate model config filteredOptions =
( Model.toItems model
, if List.isEmpty filteredOptions then
Model.toFilteredOptions False config.minInputLength config.itemToString config.filter model
else
filteredOptions
)
--)
inputAccessibilityAttributes : List (Option a) -> Model a -> List (Attribute msg)
inputAccessibilityAttributes filteredOptions model =
[ htmlAttribute "role" "combobox"
, htmlAttribute "aria-owns" (Model.toMenuElementId model)
, htmlAttribute "aria-autocomplete" "list"
, htmlAttribute "aria-activedescendant" <|
if Model.isOpen model then
Model.toHighlighted model
|> Maybe.map (Model.toOptionElementId model)
|> Maybe.withDefault ""
else
""
, htmlAttribute "aria-expanded"
(if Model.isOpen model then
"true"
else
"false"
)
, htmlAttribute "aria-haspopup" "listbox"
, Element.below <|
if Model.isOpen model then
ariaLive (List.length filteredOptions)
else
Element.none
]
menuView :
List (Attribute msg)
->
@ -314,9 +217,9 @@ optionElement v i opt =
clearButtonElement : (Msg a -> msg) -> List (Attribute msg) -> Element msg -> Element msg
clearButtonElement tagger attribs element =
clearButtonElement onChange attribs element =
Input.button attribs
{ onPress = Just (tagger ClearButtonPressed)
{ onPress = Just (onChange ClearButtonPressed)
, label = element
}
@ -406,55 +309,6 @@ defaultNoMatchElement =
(Element.text "No matches")
onKeyDown : Bool -> (String -> msg) -> Attribute msg
onKeyDown menuOpen tagger =
Element.htmlAttribute <|
Html.Events.custom "keydown"
(Decode.map (hijackKey menuOpen tagger)
(Decode.field "key" Decode.string)
)
hijackKey :
Bool
-> (String -> msg)
-> String
->
{ message : msg
, stopPropagation : Bool
, preventDefault : Bool
}
hijackKey menuOpen tagger key =
{ message = tagger key
, stopPropagation = menuOpen && key == "Escape"
, preventDefault = List.member key [ "ArrowUp", "ArrowDown", "PageUp", "PageDown" ]
}
ariaLive : Int -> Element msg
ariaLive optionCount =
Element.el
[ Element.Region.announceUrgently
, style "position" "absolute"
, style "width" "1px"
, style "height" "1px"
, style "padding" "0"
, style "margin" "-1px"
, style "overflow" "hidden"
, style "clip" "rect(0, 0, 0, 0)"
, style "white-space" "nowrap"
, style "border" "0"
, style "display" "hidden"
]
(Element.text <|
if optionCount > 0 then
String.fromInt optionCount ++ " suggestions found. Use up and down arrows to review"
else
"No suggestions found."
)
htmlAttribute : String -> String -> Attribute msg
htmlAttribute prop val =
Element.htmlAttribute (Html.Attributes.attribute prop val)

67
src/Internal/View/Common.elm Normal file
View File

@ -0,0 +1,67 @@
module Internal.View.Common exposing (ariaLive, inputAccessibilityAttributes, relativeContainerMarker)
import Html exposing (Attribute, Html)
import Html.Attributes exposing (style)
import Internal.Model as Model exposing (Model)
inputAccessibilityAttributes : Model a -> List (Attribute msg)
inputAccessibilityAttributes model =
[ Html.Attributes.attribute "role" "combobox"
, Html.Attributes.attribute "aria-owns" (Model.toMenuElementId model)
, Html.Attributes.attribute "aria-autocomplete" "list"
, Html.Attributes.attribute "aria-activedescendant" <|
if Model.isOpen model then
Model.toHighlighted model
|> Maybe.map (Model.toOptionElementId model)
|> Maybe.withDefault ""
else
""
, Html.Attributes.attribute "aria-expanded"
(if Model.isOpen model then
"true"
else
"false"
)
, Html.Attributes.attribute "aria-haspopup" "listbox"
]
ariaLive : Int -> Html msg
ariaLive optionCount =
Html.div
[ Html.Attributes.attribute "aria-live" "assertive"
, style "position" "absolute"
, style "width" "1px"
, style "height" "1px"
, style "padding" "0"
, style "margin" "-1px"
, style "overflow" "hidden"
, style "clip" "rect(0, 0, 0, 0)"
, style "white-space" "nowrap"
, style "border" "0"
, style "display" "hidden"
]
[ Html.text <|
if optionCount > 0 then
String.fromInt optionCount ++ " suggestions found. Use up and down arrows to review"
else
"No suggestions found."
]
relativeContainerMarker : Model a -> Html msg
relativeContainerMarker model =
Html.div
[ Html.Attributes.style "position" "absolute"
, Html.Attributes.style "height" "100%"
, Html.Attributes.style "top" "0"
, Html.Attributes.style "left" "0"
, Html.Attributes.style "width" "0"
, Html.Attributes.style "visibility" "hidden"
, Html.Attributes.id (Model.toRelativeContainerMarkerId model)
]
[]

342
src/Internal/View/ElmCss.elm Normal file
View File

@ -0,0 +1,342 @@
module Internal.View.ElmCss exposing
( Config
, ViewConfig
, defaultOptionElement
, init
, toStyled
)
import Browser.Dom as Dom
import Css exposing (Style)
import Element exposing (Attribute)
import Html.Styled as Html exposing (Attribute, Html)
import Html.Styled.Attributes as Attributes
import Html.Styled.Events as Events
import Internal.Model as Model exposing (Model)
import Internal.Msg exposing (Msg(..))
import Internal.Option as Option exposing (Option)
import Internal.OptionState exposing (OptionState(..))
import Internal.Placement as Placement exposing (Placement)
import Internal.View.Common as View
import Internal.View.Events as ViewEvents
import Internal.ViewConfig as ViewConfig exposing (ViewConfigInternal)
import Json.Decode as Decode
type alias Config a msg =
{ select : Model a
, onChange : Msg a -> msg
, itemToString : a -> String
}
type alias ViewConfig a msg =
ViewConfigInternal a Style (Html msg)
init : ViewConfig a msg
init =
ViewConfig.init
toStyled : List Style -> Config a msg -> ViewConfig a msg -> Html msg
toStyled attrs ({ select } as config) viewConfig =
toStyled_ attrs
(ViewConfig.toPlacement select viewConfig)
(ViewConfig.toFilteredOptions select config.itemToString viewConfig)
config
viewConfig
toStyled_ : List Style -> Placement -> List (Option a) -> Config a msg -> ViewConfig a msg -> Html msg
toStyled_ attrs placement filteredOptions ({ select } as config) viewConfig =
Html.div
(List.concat
[ [ Attributes.id <| Model.toContainerElementId select
, Attributes.class "elm-select-container"
, Attributes.css
[ Css.position Css.relative
, Css.boxSizing Css.borderBox
, if Model.isOpen select then
Css.zIndex (Css.int 21)
else
Css.batch []
]
]
, ViewEvents.updateFilteredOptions config.onChange config.itemToString select viewConfig filteredOptions
|> List.map Attributes.fromUnstyled
]
)
[ View.relativeContainerMarker select
|> Html.fromUnstyled
, inputView attrs filteredOptions config viewConfig
, if Model.toValue select /= Nothing || Model.toInputValue select /= "" then
viewConfig.clearButton
|> Maybe.map
(\( attrs_, el ) ->
clearButtonElement config.onChange attrs_ el
)
|> Maybe.withDefault (Html.text "")
else
Html.text ""
, if ViewConfig.shouldShowNoMatchElement filteredOptions select viewConfig then
Html.div
[ Attributes.css
[ Css.position Css.absolute
, Css.width (Css.pct 100)
]
]
[ Maybe.withDefault defaultNoMatchElement viewConfig.noMatchElement ]
else
Html.text ""
, if viewConfig.positionFixed then
positionFixedEl placement
(Model.toContainerElement select)
(menuView
(defaultMenuAttrs placement
(List.concatMap (\toAttrs -> toAttrs placement) viewConfig.menuAttributes)
{ menuWidth = Model.toMenuMinWidth select
, maxWidth = viewConfig.menuMaxWidth
, menuHeight = Model.toMenuMaxHeight viewConfig.menuMaxHeight viewConfig.menuPlacement select
}
)
{ menuId = Model.toMenuElementId select
, toOptionId = Model.toOptionElementId select
, toOptionState = Model.toOptionState select
, onChange = config.onChange
, menuOpen = Model.isOpen select
, options = filteredOptions
, optionElement = Maybe.withDefault (defaultOptionElement config.itemToString) viewConfig.optionElement
}
)
else
menuView
(defaultMenuAttrs placement
(List.concatMap (\toAttrs -> toAttrs placement) viewConfig.menuAttributes)
{ menuWidth = Model.toMenuMinWidth select
, maxWidth = viewConfig.menuMaxWidth
, menuHeight = Model.toMenuMaxHeight viewConfig.menuMaxHeight viewConfig.menuPlacement select
}
)
{ menuId = Model.toMenuElementId select
, toOptionId = Model.toOptionElementId select
, toOptionState = Model.toOptionState select
, onChange = config.onChange
, menuOpen = Model.isOpen select
, options = filteredOptions
, optionElement = Maybe.withDefault (defaultOptionElement config.itemToString) viewConfig.optionElement
}
, if Model.isOpen select then
View.ariaLive (List.length filteredOptions)
|> Html.fromUnstyled
else
Html.text ""
]
inputView : List Style -> List (Option a) -> Config a msg -> ViewConfig a msg -> Html msg
inputView attrs filteredOptions ({ select } as config) viewConfig =
Html.input
([ ViewEvents.onFocus config.onChange config.itemToString select viewConfig filteredOptions
|> Attributes.fromUnstyled
, Events.onClick (InputClicked |> config.onChange)
, Events.onBlur
(config.onChange
(InputLostFocus
{ clearInputValue = viewConfig.clearInputValueOnBlur
, selectExactMatch = viewConfig.selectExactMatchOnBlur
}
filteredOptions
)
)
, Attributes.fromUnstyled <|
ViewEvents.onKeyDown (Model.isOpen select) (KeyDown viewConfig.selectOnTab filteredOptions >> config.onChange)
, Attributes.id <| Model.toInputElementId select
, Events.onInput (ViewEvents.onInput config.onChange config.itemToString select viewConfig)
, Attributes.value <| Model.toInputText config.itemToString select
, Attributes.attribute "autocomplete" "dont-fill-in-this-box"
, Attributes.css
[ Css.width (Css.pct 100)
, Css.boxSizing Css.borderBox
, Css.batch attrs
]
]
++ List.map Attributes.fromUnstyled (View.inputAccessibilityAttributes select)
)
[]
menuView :
List (Attribute msg)
->
{ menuId : String
, toOptionId : Int -> String
, toOptionState : ( Int, a ) -> OptionState
, onChange : Msg a -> msg
, menuOpen : Bool
, options : List (Option a)
, optionElement : OptionState -> a -> Html msg
}
-> Html msg
menuView attribs v =
List.indexedMap (optionElement v) v.options
|> Html.div
(attribs
++ (Attributes.id v.menuId
:: (if v.menuOpen && List.length v.options > 0 then
[]
else
[ Attributes.style "visibility" "hidden"
, Attributes.attribute "aria-visible"
(if v.menuOpen then
"false"
else
"true"
)
, Attributes.style "height" "0"
, Attributes.style "overflow-y" "hidden"
]
)
)
)
optionElement :
{ b
| toOptionState : ( Int, a ) -> OptionState
, toOptionId : Int -> String
, onChange : Msg a -> msg
, optionElement : OptionState -> a -> Html msg
}
-> Int
-> Option a
-> Html msg
optionElement v i opt =
Html.div
[ Attributes.id (v.toOptionId i)
, Attributes.attribute "role" "option"
, Attributes.attribute "value" (Option.toString opt)
, Events.preventDefaultOn "mousedown" (Decode.succeed ( v.onChange NoOp, True ))
, Events.preventDefaultOn "click" (Decode.succeed ( v.onChange <| OptionClicked opt, True ))
, Events.onMouseEnter (v.onChange <| MouseEnteredOption i)
]
[ v.optionElement (v.toOptionState ( i, Option.toItem opt )) (Option.toItem opt) ]
clearButtonElement : (Msg a -> msg) -> List Style -> Html msg -> Html msg
clearButtonElement onChange attribs element =
Html.button
[ Attributes.css
[ Css.position Css.absolute
, Css.right Css.zero
, Css.top Css.zero
, Css.backgroundColor Css.transparent
, Css.borderWidth Css.zero
, Css.padding Css.zero
, Css.margin Css.zero
, Css.batch attribs
]
, Attributes.tabindex -1
, Attributes.type_ "button"
, Events.onClick (onChange ClearButtonPressed)
]
[ element ]
defaultMenuAttrs :
Placement
-> List Style
->
{ menuWidth : Maybe Int
, maxWidth : Maybe Int
, menuHeight : Maybe Int
}
-> List (Attribute msg)
defaultMenuAttrs placement css { menuWidth, maxWidth, menuHeight } =
[ Attributes.attribute "role" "listbox"
, Attributes.css
[ Css.position Css.absolute
, case placement of
Placement.Above ->
Css.bottom (Css.pct 100)
Placement.Below ->
Css.batch []
, Maybe.map (toFloat >> Css.px >> Css.maxHeight) menuHeight
|> Maybe.withDefault (Css.batch [])
, Maybe.map (toFloat >> Css.px >> Css.maxWidth) maxWidth
|> Maybe.withDefault (Css.batch [])
, Maybe.map (toFloat >> Css.px >> Css.minWidth) menuWidth
|> Maybe.withDefault (Css.batch [])
, Css.overflowY Css.scroll
, Css.border3 (Css.px 1) Css.solid (Css.rgb 204 204 204)
, Css.borderRadius (Css.px 5)
, Css.backgroundColor (Css.rgb 255 255 255)
, Css.padding2 (Css.px 5) (Css.px 0)
, Css.width (Css.pct 100)
, Css.boxSizing Css.borderBox
, Css.batch css
]
]
positionFixedEl : Placement -> Maybe Dom.Element -> Html msg -> Html msg
positionFixedEl placement container content =
Html.div
(Attributes.style "position" "fixed"
:: (if placement == Placement.Above then
[ Attributes.style "transform"
("translateY(calc(-100% - 5px - "
++ (Maybe.map (.element >> .height >> String.fromFloat) container |> Maybe.withDefault "0")
++ "px))"
)
]
else
[]
)
)
[ content ]
defaultOptionElement : (a -> String) -> OptionState -> a -> Html msg
defaultOptionElement toString optionState a =
Html.div
[ Attributes.style "cursor" "pointer"
, Attributes.style "padding" "10px 14px"
, Attributes.style "background-color" <|
case optionState of
Highlighted ->
"rgb(89%, 89%, 89%)"
Selected ->
"rgba(64%, 83%, 97%, 0.8)"
SelectedAndHighlighted ->
"rgba(64%, 83%, 97%, 1)"
Idle ->
"rgb(255, 255, 255)"
]
[ Html.text (toString a) ]
defaultNoMatchElement : Html msg
defaultNoMatchElement =
Html.div
[ Attributes.css
[ Css.padding (Css.px 5)
, Css.border3 (Css.px 1) Css.solid (Css.rgba 0 0 0 0.5)
, Css.borderRadius (Css.px 5)
, Css.backgroundColor (Css.rgb 255 255 255)
, Css.width (Css.pct 100)
]
]
[ Html.text "No matches" ]

81
src/Internal/View/Events.elm Normal file
View File

@ -0,0 +1,81 @@
module Internal.View.Events exposing (onFocus, onInput, onKeyDown, updateFilteredOptions)
import Html exposing (Attribute)
import Html.Events
import Internal.Model as Model exposing (Model)
import Internal.Msg exposing (Msg(..))
import Internal.Option exposing (Option)
import Internal.ViewConfig exposing (ViewConfigInternal)
import Json.Decode as Decode
onKeyDown : Bool -> (String -> msg) -> Attribute msg
onKeyDown menuOpen tagger =
Html.Events.custom "keydown"
(Decode.map (hijackKey menuOpen tagger)
(Decode.field "key" Decode.string)
)
hijackKey :
Bool
-> (String -> msg)
-> String
->
{ message : msg
, stopPropagation : Bool
, preventDefault : Bool
}
hijackKey menuOpen tagger key =
{ message = tagger key
, stopPropagation = menuOpen && key == "Escape"
, preventDefault = List.member key [ "ArrowUp", "ArrowDown", "PageUp", "PageDown", "Enter" ]
}
onInput : (Msg a -> msg) -> (a -> String) -> Model a -> ViewConfigInternal a attribute view -> String -> msg
onInput onChange itemToString model viewConfig v =
InputChanged v
(Model.onInputChange v model
|> Model.toFilteredOptions False viewConfig.minInputLength itemToString viewConfig.filter
)
|> onChange
onFocus : (Msg a -> msg) -> (a -> String) -> Model a -> ViewConfigInternal a attribute view -> List (Option a) -> Attribute msg
onFocus onChange itemToString model viewConfig filteredOptions =
Html.Events.on "focus" <|
if Model.requiresNewFilteredOptions model then
Decode.lazy (\_ -> Decode.succeed (onChange <| InputFocused viewConfig.openOnFocus (Model.toInputText itemToString model) (Just <| optionsUpdate itemToString model viewConfig filteredOptions)))
else
InputFocused viewConfig.openOnFocus (Model.toInputText itemToString model) Nothing
|> onChange
|> Decode.succeed
optionsUpdate : (a -> String) -> Model a -> ViewConfigInternal a attribute view -> List (Option a) -> ( List a, List (Option a) )
optionsUpdate itemToString model viewConfig filteredOptions =
( Model.toItems model
, if List.isEmpty filteredOptions then
Model.toFilteredOptions False viewConfig.minInputLength itemToString viewConfig.filter model
else
filteredOptions
)
updateFilteredOptions : (Msg a -> msg) -> (a -> String) -> Model a -> ViewConfigInternal a attribute view -> List (Option a) -> List (Attribute msg)
updateFilteredOptions onChange itemToString model viewConfig filteredOptions =
if Model.requiresNewFilteredOptions model then
let
options _ =
optionsUpdate itemToString model viewConfig filteredOptions
in
[ Html.Events.on "keydown" (Decode.lazy (\_ -> Decode.succeed (GotNewFilteredOptions (options ()) |> onChange)))
, Html.Events.on "touchstart" (Decode.lazy (\_ -> Decode.succeed (GotNewFilteredOptions (options ()) |> onChange)))
, Html.Events.on "mousemove" (Decode.lazy (\_ -> Decode.succeed (GotNewFilteredOptions (options ()) |> onChange)))
]
else
[]

64
src/Internal/ViewConfig.elm Normal file
View File

@ -0,0 +1,64 @@
module Internal.ViewConfig exposing (ViewConfigInternal, init, shouldShowNoMatchElement, toFilteredOptions, toPlacement)
import Internal.Filter as Filter exposing (Filter)
import Internal.Model as Model exposing (Model)
import Internal.Option exposing (Option)
import Internal.OptionState exposing (OptionState)
import Internal.Placement exposing (Placement)
import Internal.RequestState exposing (RequestState(..))
type alias ViewConfigInternal a attribute view =
{ filter : Maybe (Filter a)
, menuPlacement : Maybe Placement
, menuMaxHeight : Maybe Int
, menuMaxWidth : Maybe Int
, menuAttributes : List (Placement -> List attribute)
, noMatchElement : Maybe view
, optionElement : Maybe (OptionState -> a -> view)
, clearButton : Maybe ( List attribute, view )
, positionFixed : Bool
, clearInputValueOnBlur : Bool
, selectExactMatchOnBlur : Bool
, selectOnTab : Bool
, minInputLength : Maybe Int
, openOnFocus : Bool
}
init : ViewConfigInternal a attribute view
init =
{ filter = Just Filter.startsWithThenContains
, menuPlacement = Nothing
, menuMaxHeight = Nothing
, menuMaxWidth = Nothing
, menuAttributes = []
, noMatchElement = Nothing
, optionElement = Nothing
, clearButton = Nothing
, positionFixed = False
, clearInputValueOnBlur = False
, selectExactMatchOnBlur = False
, selectOnTab = True
, minInputLength = Nothing
, openOnFocus = True
}
shouldShowNoMatchElement : List (Option a) -> Model a -> ViewConfigInternal a attribute view -> Bool
shouldShowNoMatchElement filteredOptions select viewConfig =
List.length filteredOptions
== 0
&& Model.isOpen select
&& (String.length (Model.toInputValue select) >= Maybe.withDefault 1 viewConfig.minInputLength)
&& (Model.toRequestState select == Nothing || Model.toRequestState select == Just Success)
toPlacement : Model a -> ViewConfigInternal a attribute view -> Placement
toPlacement select viewConfig =
Model.toMenuPlacement viewConfig.menuMaxHeight viewConfig.menuPlacement select
toFilteredOptions : Model a -> (a -> String) -> ViewConfigInternal a attribute view -> List (Option a)
toFilteredOptions select itemToString viewConfig =
Model.toFilteredOptions True viewConfig.minInputLength itemToString viewConfig.filter select

15
src/List/Extra.elm
View File

@ -1,15 +0,0 @@
module List.Extra exposing (find)
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

71
src/Select.elm
View File

@ -5,8 +5,8 @@ module Select exposing
, toValue, toInputValue, toInputElementId, toMenuElementId
, isMenuOpen, isLoading, isRequestFailed, isFocused
, Msg, update, updateWith, sendRequest
, UpdateOption, request, requestMinInputLength, requestDebounceDelay, onSelectedChange, onInput, onFocus, onLoseFocus
, ViewConfig, view, withMenuAttributes, MenuPlacement(..), withMenuMaxHeight, withMenuMaxWidth, withNoMatchElement, withOptionElement, defaultOptionElement, OptionState, withClearButton, ClearButton, clearButton, withFilter, withMenuAlwaysAbove, withMenuAlwaysBelow, withMenuPlacementAuto, withMenuPositionFixed, withClearInputValueOnBlur, withSelectExactMatchOnBlur, withSelectOnTab, withMinInputLength
, UpdateOption, request, requestMinInputLength, requestDebounceDelay, onSelectedChange, onInput, onFocus, onLoseFocus, onKeyDown
, ViewConfig, view, withMenuAttributes, MenuPlacement(..), withMenuMaxHeight, withMenuMaxWidth, withNoMatchElement, withOptionElement, defaultOptionElement, OptionState(..), withClearButton, ClearButton, clearButton, withFilter, withMenuAlwaysAbove, withMenuAlwaysBelow, withMenuPlacementAuto, withMenuPositionFixed, withClearInputValueOnBlur, withSelectExactMatchOnBlur, withSelectOnTab, withMinInputLength, withOpenMenuOnFocus
, toElement
, Effect
)
@ -46,12 +46,12 @@ module Select exposing
# Update Options
@docs UpdateOption, request, requestMinInputLength, requestDebounceDelay, onSelectedChange, onInput, onFocus, onLoseFocus
@docs UpdateOption, request, requestMinInputLength, requestDebounceDelay, onSelectedChange, onInput, onFocus, onLoseFocus, onKeyDown
# Configure View
@docs ViewConfig, view, withMenuAttributes, MenuPlacement, withMenuMaxHeight, withMenuMaxWidth, withNoMatchElement, withOptionElement, defaultOptionElement, OptionState, withClearButton, ClearButton, clearButton, withFilter, withMenuAlwaysAbove, withMenuAlwaysBelow, withMenuPlacementAuto, withMenuPositionFixed, withClearInputValueOnBlur, withSelectExactMatchOnBlur, withSelectOnTab, withMinInputLength
@docs ViewConfig, view, withMenuAttributes, MenuPlacement, withMenuMaxHeight, withMenuMaxWidth, withNoMatchElement, withOptionElement, defaultOptionElement, OptionState, withClearButton, ClearButton, clearButton, withFilter, withMenuAlwaysAbove, withMenuAlwaysBelow, withMenuPlacementAuto, withMenuPositionFixed, withClearInputValueOnBlur, withSelectExactMatchOnBlur, withSelectOnTab, withMinInputLength, withOpenMenuOnFocus
# Element
@ -74,7 +74,7 @@ import Internal.OptionState as OptionState
import Internal.Placement as Placement
import Internal.Update as Update
import Internal.UpdateOptions as UpdateOptions exposing (UpdateOption)
import Internal.View as View exposing (ViewConfigInternal)
import Internal.View as View
import Select.Filter exposing (Filter)
@ -112,7 +112,8 @@ You can do this on init:
, Cmd.none
)
Or you can do it in your view if you prefer to keep your items in your own model.
Or you can do it in your view if you need to keep your items in your own model.
You'd probably only do this if you want to select from things that are owned/managed by other parts of the app.
view : Model -> Element Msg
view model =
@ -141,7 +142,7 @@ setSelected =
-}
setInputValue : String -> Select a -> Select a
setInputValue =
Model.setInputValue
Model.onInputChange
{-| Close the menu
@ -344,6 +345,13 @@ onLoseFocus msg =
UpdateOptions.OnLoseFocus msg
{-| If provided this will be sent whenever there is a keydown event in the input.
-}
onKeyDown : (String -> msg) -> UpdateOption err a msg
onKeyDown msg =
UpdateOptions.OnKeyDown msg
{-| Send a request to populate the menu items. This is useful for initialising the select with items from an api.
Provide a function that takes the current input value and a msg tagger and returns a Cmd which can be used to perform an HTTP request.
@ -405,22 +413,14 @@ sendRequest tagger req andSelect select =
-}
type ViewConfig a msg
= ViewConfig (ViewConfigInternal a msg)
= ViewConfig (View.ViewConfig a msg)
{-| Initialise the default ViewConfig
-}
view :
List (Attribute msg)
->
{ onChange : Msg a -> msg
, itemToString : a -> String
, label : Input.Label msg
, placeholder : Maybe (Input.Placeholder msg)
}
-> ViewConfig a msg
view attribs config =
ViewConfig (View.view attribs config)
view : ViewConfig a msg
view =
ViewConfig View.init
{-| Customise the filtering of the menu based on input value. See [Select.Filter](Select-Filter). Default is startsWithThenContains.
@ -538,7 +538,7 @@ type MenuPlacement
-}
withOptionElement : (OptionState -> a -> Element msg) -> ViewConfig a msg -> ViewConfig a msg
withOptionElement toEl (ViewConfig config) =
ViewConfig { config | optionElement = \state -> toEl (mapOptionState state) }
ViewConfig { config | optionElement = Just (\state -> toEl (mapOptionState state)) }
{-| The default option element. Use this with withOptionElement only if you want the
@ -562,7 +562,7 @@ type OptionState
-}
withNoMatchElement : Element msg -> ViewConfig a msg -> ViewConfig a msg
withNoMatchElement element (ViewConfig config) =
ViewConfig { config | noMatchElement = element }
ViewConfig { config | noMatchElement = Just element }
{-| Add a button to clear the input. This element is positioned as Element.inFront.
@ -588,18 +588,18 @@ withNoMatchElement element (ViewConfig config) =
-}
withClearButton : Maybe (ClearButton msg) -> ViewConfig a msg -> ViewConfig a msg
withClearButton cb (ViewConfig config) =
ViewConfig { config | clearButton = Maybe.map (\(ClearButton attribs label) -> View.clearButtonElement config.onChange attribs label) cb }
ViewConfig { config | clearButton = Maybe.map (\(ClearButton attrs el) -> ( List.map (Element.mapAttribute never) attrs, el )) cb }
{-| A button to clear the input
-}
type ClearButton msg
= ClearButton (List (Attribute msg)) (Element msg)
= ClearButton (List (Attribute Never)) (Element msg)
{-| Create a clear button
-}
clearButton : List (Attribute msg) -> Element msg -> ClearButton msg
clearButton : List (Attribute Never) -> Element msg -> ClearButton msg
clearButton attribs label =
ClearButton attribs label
@ -644,11 +644,28 @@ withMinInputLength v (ViewConfig config) =
ViewConfig { config | minInputLength = v }
{-| Should the menu be opened when the input gets focus?
-}
withOpenMenuOnFocus : Bool -> ViewConfig a msg -> ViewConfig a msg
withOpenMenuOnFocus v (ViewConfig config) =
ViewConfig { config | openOnFocus = v }
{-| Turn the ViewConfig into an Element.
-}
toElement : Select a -> ViewConfig a msg -> Element msg
toElement model (ViewConfig config) =
View.toElement model config
toElement :
List (Attribute msg)
->
{ select : Model a
, onChange : Msg a -> msg
, itemToString : a -> String
, label : Input.Label msg
, placeholder : Maybe (Input.Placeholder msg)
}
-> ViewConfig a msg
-> Element msg
toElement attrs config (ViewConfig vc) =
View.toElement attrs config vc

11
src/Select/Effect.elm
View File

@ -1,7 +1,7 @@
module Select.Effect exposing
( Effect
, update, updateWith
, UpdateOption, request, requestMinInputLength, requestDebounceDelay, onSelectedChange, onInput, onFocus, onLoseFocus
, UpdateOption, request, requestMinInputLength, requestDebounceDelay, onSelectedChange, onInput, onFocus, onLoseFocus, onKeyDown
, sendRequest
, perform, performWithRequest
, simulate, simulateWithRequest
@ -27,7 +27,7 @@ you don't need this module.
# Update Options
@docs UpdateOption, request, requestMinInputLength, requestDebounceDelay, onSelectedChange, onInput, onFocus, onLoseFocus
@docs UpdateOption, request, requestMinInputLength, requestDebounceDelay, onSelectedChange, onInput, onFocus, onLoseFocus, onKeyDown
# Send Request
@ -209,6 +209,13 @@ onLoseFocus msg =
UpdateOptions.OnLoseFocus msg
{-| If provided this will be sent whenever there is a keydown event in the input.
-}
onKeyDown : (String -> msg) -> UpdateOption err effect a msg
onKeyDown msg =
UpdateOptions.OnKeyDown msg
{-| Send a request to populate the menu items. This is useful for initialising the select with items from an api.
Provide a function that takes the current input value and a msg tagger and returns an effect which can be used to perform an HTTP request.

723
src/Select/ElmCss.elm Normal file
View File

@ -0,0 +1,723 @@
module Select.ElmCss exposing
( Select
, init
, setItems, setSelected, setInputValue, closeMenu
, toValue, toInputValue, toInputElementId, toMenuElementId
, isMenuOpen, isLoading, isRequestFailed, isFocused
, Msg, update, updateWith, sendRequest
, UpdateOption, request, requestMinInputLength, requestDebounceDelay, onSelectedChange, onInput, onFocus, onLoseFocus, onKeyDown
, ViewConfig, view, withMenuAttributes, MenuPlacement(..), withMenuMaxHeight, withMenuMaxWidth, withNoMatchElement, withOptionElement, defaultOptionElement, OptionState(..), withClearButton, ClearButton, clearButton, withFilter, withMenuAlwaysAbove, withMenuAlwaysBelow, withMenuPlacementAuto, withMenuPositionFixed, withClearInputValueOnBlur, withSelectExactMatchOnBlur, withSelectOnTab, withMinInputLength, withOpenMenuOnFocus
, toStyled
, Effect
)
{-| A select widget for elm-ui.
# Type
@docs Select
# Create
@docs init
# Set
@docs setItems, setSelected, setInputValue, closeMenu
# Get
@docs toValue, toInputValue, toInputElementId, toMenuElementId
# Check
@docs isMenuOpen, isLoading, isRequestFailed, isFocused
# Update the Select
@docs Msg, update, updateWith, sendRequest
# Update Options
@docs UpdateOption, request, requestMinInputLength, requestDebounceDelay, onSelectedChange, onInput, onFocus, onLoseFocus, onKeyDown
# Configure View
@docs ViewConfig, view, withMenuAttributes, MenuPlacement, withMenuMaxHeight, withMenuMaxWidth, withNoMatchElement, withOptionElement, defaultOptionElement, OptionState, withClearButton, ClearButton, clearButton, withFilter, withMenuAlwaysAbove, withMenuAlwaysBelow, withMenuPlacementAuto, withMenuPositionFixed, withClearInputValueOnBlur, withSelectExactMatchOnBlur, withSelectOnTab, withMinInputLength, withOpenMenuOnFocus
# Element
@docs toStyled
# Effect
@docs Effect
-}
import Css exposing (Style)
import Html.Styled exposing (Html)
import Internal.Effect as Effect
import Internal.Model as Model exposing (Model)
import Internal.Msg as Msg
import Internal.OptionState as OptionState
import Internal.Placement as Placement
import Internal.Update as Update
import Internal.UpdateOptions as UpdateOptions exposing (UpdateOption)
import Internal.View.ElmCss as View
import Select.Filter exposing (Filter)
-- MODEL
{-| The main Select type
-}
type alias Select a =
Model a
{-| Initialise the Select. You must provide a unique id. The id will be used for getting DOM elements etc.
-}
init : String -> Select a
init =
Model.init
{-| Set the list of items
You can do this on init:
type alias Model =
{ select : Select String
}
init : List String -> ( Model, Cmd Msg )
init things =
( { select =
Select.init "thing-select"
|> Select.setItems things
}
, Cmd.none
)
Or you can do it in your view if you need to keep your items in your own model.
You'd probably only do this if you want to select from things that are owned/managed by other parts of the app.
view : Model -> Html Msg
view model =
Select.view []
{ onChange = SelectMsg
, label = Input.labelAbove [] (Element.text "Choose a thing")
, placeholder = Just (Input.placeholder [] (Element.text "Type to search"))
, itemToString = identity
}
|> Select.toElement (Select.setItems model.things model.select)
-}
setItems : List a -> Select a -> Select a
setItems =
Model.setItems
{-| Set the selected item
-}
setSelected : Maybe a -> Select a -> Select a
setSelected =
Model.setSelected
{-| Set the input value
-}
setInputValue : String -> Select a -> Select a
setInputValue =
Model.onInputChange
{-| Close the menu
-}
closeMenu : Select a -> Select a
closeMenu =
Model.closeMenu
-- GET
{-| Get the selected item
-}
toValue : Select a -> Maybe a
toValue =
Model.toValue
{-| Get the value of the input
-}
toInputValue : Select a -> String
toInputValue =
Model.toInputValue
{-| Get the id of the DOM input element. Useful in tests or to associate the provided label with the input
-}
toInputElementId : Select a -> String
toInputElementId =
Model.toInputElementId
{-| Get the id of the DOM menu container. Useful for testing
-}
toMenuElementId : Select a -> String
toMenuElementId =
Model.toMenuElementId
-- CHECK
{-| Is the menu open?
-}
isMenuOpen : Select a -> Bool
isMenuOpen =
Model.isOpen
{-| Is there a request currently loading? Could be used to add loading styling.
-}
isLoading : Select a -> Bool
isLoading =
Model.isLoading
{-| Did a request fail?
-}
isRequestFailed : Select a -> Bool
isRequestFailed =
Model.isRequestFailed
{-| Is the input focused?
-}
isFocused : Select a -> Bool
isFocused =
Model.isFocused
-- UPDATE
{-| The Msg type
-}
type alias Msg a =
Msg.Msg a
{-| Update the Select
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
SelectMsg subMsg ->
Select.update SelectMsg subMsg model.select
|> Tuple.mapFirst (\select -> { model | select = select })
-}
update : (Msg a -> msg) -> Msg a -> Select a -> ( Select a, Cmd msg )
update tagger msg select =
Update.update (UpdateOptions.fromList []) tagger msg select
|> Tuple.mapSecond (Effect.perform (\_ -> Cmd.none))
{-| Update with options.
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
SelectMsg subMsg ->
Select.updateWith [ Select.onSelectedChanged ThingSelected ] SelectMsg subMsg model.select
|> Tuple.mapFirst (\select -> { model | select = select })
ThingSelected maybeThing ->
Debug.todo "Do something when the thing is selected/deselected"
-}
updateWith : List (UpdateOption err a msg) -> (Msg a -> msg) -> Msg a -> Select a -> ( Select a, Cmd msg )
updateWith options tagger msg select =
Update.update (UpdateOptions.fromList options) tagger msg select
|> Tuple.mapSecond (Effect.perform identity)
{-| Options for use with updateWith.
-}
type alias UpdateOption err a msg =
UpdateOptions.UpdateOption err (Cmd msg) a msg
{-| Use an HTTP request to retrieve matching remote results. Note that in order to avoid an elm/http dependency in this package,
you will need to provide the request Cmd yourself. Provide a function that takes the input value and a msg tagger and returns a Cmd.
Update will return this Cmd when the user types in the input.
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
SelectMsg subMsg ->
Select.updateWith [ Select.request fetchThings ] SelectMsg subMsg model.select
|> Tuple.mapFirst (\select -> { model | select = select })
fetchThings : String -> (Result Http.Error (List Thing) -> Msg) -> Cmd Msg
fetchThings query tagger =
Http.get
{ url = "https://awesome-thing.api/things?search=" ++ query
, expect =
Http.expectJson tagger
(Decode.list thingDecoder)
}
-}
request : (String -> (Result err (List a) -> msg) -> Cmd msg) -> UpdateOption err a msg
request effect =
UpdateOptions.Request effect
{-| Configure debouncing for the request. How long should we wait in milliseconds after the user stops typing to send the request? Default is 300.
Select.updateWith [ Select.request fetchThings, Select.requestDebounceDelay 500 ] SelectMsg subMsg model.select
-}
requestDebounceDelay : Float -> UpdateOption err a msg
requestDebounceDelay delay =
UpdateOptions.DebounceRequest delay
{-| How many characters does a user need to type before a request is sent?
If this is too low you may get an unmanagable number of results! Default is 3 characters.
Select.updateWith [ Select.request fetchThings, Select.requestMinInputLength 4 ] SelectMsg subMsg model.select
-}
requestMinInputLength : Int -> UpdateOption err a msg
requestMinInputLength len =
UpdateOptions.RequestMinInputLength len
{-| If provided this msg will be sent whenever the selected item changes.
Select.updateWith [ Select.onSelectedChange SelectionChanged ] SelectMsg subMsg model.select
-}
onSelectedChange : (Maybe a -> msg) -> UpdateOption err a msg
onSelectedChange msg =
UpdateOptions.OnSelect msg
{-| If provided this msg will be sent whenever the input value changes.
-}
onInput : (String -> msg) -> UpdateOption err a msg
onInput msg =
UpdateOptions.OnInput msg
{-| If provided this msg will be sent whenever the input is focused.
-}
onFocus : msg -> UpdateOption err a msg
onFocus msg =
UpdateOptions.OnFocus msg
{-| If provided this msg will be sent whenever the input loses focus.
-}
onLoseFocus : msg -> UpdateOption err a msg
onLoseFocus msg =
UpdateOptions.OnLoseFocus msg
{-| If provided this will be sent whenever there is a keydown event in the input.
-}
onKeyDown : (String -> msg) -> UpdateOption err a msg
onKeyDown msg =
UpdateOptions.OnKeyDown msg
{-| Send a request to populate the menu items. This is useful for initialising the select with items from an api.
Provide a function that takes the current input value and a msg tagger and returns a Cmd which can be used to perform an HTTP request.
init : ( Model, Cmd Msg )
init =
let
( select, cmd ) =
Select.init "thing-select"
|> Select.sendRequest SelectMsg fetchThings Nothing
in
( { select = select }
, cmd
)
fetchThings : String -> (Result Http.Error (List Thing) -> Msg) -> Cmd Msg
fetchThings query tagger =
Http.get
{ url = "https://awesome-thing.api/things?search=" ++ query
, expect =
Http.expectJson tagger
(Decode.list thingDecoder)
}
Optionally provide a function to select one the items when the response returns:
init : ThingId -> ( Model, Cmd Msg )
init thingId =
let
( select, cmd ) =
Select.init "thing-select"
|> Select.sendRequest SelectMsg fetchThings (Just (\{ id } -> id == thingId))
in
( { select = select }
, cmd
)
-}
sendRequest : (Msg a -> msg) -> (String -> (Result err (List a) -> msg) -> Cmd msg) -> Maybe (a -> Bool) -> Select a -> ( Select a, Cmd msg )
sendRequest tagger req andSelect select =
Update.sendRequest tagger andSelect select req
|> Tuple.mapSecond (Effect.perform (\_ -> Cmd.none))
-- VIEW
{-| The View Configuration
view : Model -> Html Msg
view model =
Select.view []
{ onChange = SelectMsg
, label = Input.labelAbove [] (text "Choose a thing")
, placeholder = Just (Input.placeholder [] (text "Type to search"))
, itemToString = .name
}
|> Select.toElement model.thingsSelect
-}
type ViewConfig a msg
= ViewConfig (View.ViewConfig a msg)
{-| Initialise the default ViewConfig
-}
view : ViewConfig a msg
view =
ViewConfig View.init
{-| Customise the filtering of the menu based on input value. See [Select.Filter](Select-Filter). Default is startsWithThenContains.
-}
withFilter : Maybe (Filter a) -> ViewConfig a msg -> ViewConfig a msg
withFilter filter (ViewConfig config) =
ViewConfig { config | filter = filter }
{-| Force the menu to always appear below the input. You may use this for example if you have issues with an input inside a scrollable transformed container.
By default the menu will try to detect whether there is more space above or below and appear there, preferring below.
-}
withMenuAlwaysBelow : ViewConfig a msg -> ViewConfig a msg
withMenuAlwaysBelow (ViewConfig config) =
ViewConfig { config | menuPlacement = Just Placement.Below }
{-| Force the menu to always appear above the input. You may use this for example if you have issues with an input inside a scrollable transformed container.
-}
withMenuAlwaysAbove : ViewConfig a msg -> ViewConfig a msg
withMenuAlwaysAbove (ViewConfig config) =
ViewConfig { config | menuPlacement = Just Placement.Above }
{-| Menu decides whether to appear above or below based on how much space is available. This is the default.
You'd only use this function if you're passing around a config and need to reset this option.
-}
withMenuPlacementAuto : ViewConfig a msg -> ViewConfig a msg
withMenuPlacementAuto (ViewConfig config) =
ViewConfig { config | menuPlacement = Nothing }
{-| Set a maximum height for the menu
-}
withMenuMaxHeight : Maybe Int -> ViewConfig a msg -> ViewConfig a msg
withMenuMaxHeight height (ViewConfig config) =
ViewConfig { config | menuMaxHeight = height }
{-| Set a maximum width for the menu
-}
withMenuMaxWidth : Maybe Int -> ViewConfig a msg -> ViewConfig a msg
withMenuMaxWidth width (ViewConfig config) =
ViewConfig { config | menuMaxWidth = width }
{-| Set arbitrary attributes for the menu element. You can call this multiple times and it will accumulate attributes.
You can define different attributes based on whether the menu appears above or below the input.
Select.view []
{ onChange = SelectMsg
, label = Input.labelAbove [] (Element.text "Choose a thing")
, placeholder = Just (Input.placeholder [] (Element.text "Type to search"))
, itemToString = .name
}
|> Select.withMenuAttributes
(\placement ->
[ Element.Font.size 16
, Element.Border.width 2
]
++ (case placement of
Select.MenuAbove ->
[ Element.moveUp 10 ]
Select.MenuBelow ->
[ Element.moveDown 10 ]
)
)
|> Select.toElement model.select
-}
withMenuAttributes : (MenuPlacement -> List Style) -> ViewConfig a msg -> ViewConfig a msg
withMenuAttributes attribs (ViewConfig config) =
ViewConfig { config | menuAttributes = config.menuAttributes ++ [ mapPlacement >> attribs ] }
{-| Will the menu appear above or below the input?
-}
type MenuPlacement
= MenuAbove
| MenuBelow
{-| Provide your own element for the options in the menu, based on the current [state](#OptionState) of the option.
Select.view []
{ onChange = SelectMsg
, label = Input.labelAbove [] (Element.text "Choose a thing")
, placeholder = Just (Input.placeholder [] (Element.text "Type to search"))
, itemToString = .name
}
|> Select.withOptionElement
(\state item ->
Element.el
[ Element.width Element.fill
, Element.paddingXY 14 10
, Background.color <|
case optionState of
Idle ->
Element.rgb 1 1 1
Highlighted ->
Element.rgb 0.95 0.95 0.95
Selected ->
Element.rgba 0.64 0.83 0.97 0.8
SelectedAndHighlighted ->
Element.rgba 0.64 0.83 0.97 1
]
(Element.text item.name)
)
|> Select.toElement model.select
-}
withOptionElement : (OptionState -> a -> Html msg) -> ViewConfig a msg -> ViewConfig a msg
withOptionElement toEl (ViewConfig config) =
ViewConfig { config | optionElement = Just (\state -> toEl (mapOptionState state)) }
{-| The default option element. Use this with withOptionElement only if you want the
item text on the options to be different from that used in the input and search filtering.
-}
defaultOptionElement : (a -> String) -> (OptionState -> a -> Html msg)
defaultOptionElement itemToString =
\state -> View.defaultOptionElement itemToString (reverseMapOptionState state)
{-| Option state for use with custom option element
-}
type OptionState
= Idle
| Highlighted
| Selected
| SelectedAndHighlighted
{-| Provide your own element to show when there are no matches based on the filter and input value. This appears below the input.
-}
withNoMatchElement : Html msg -> ViewConfig a msg -> ViewConfig a msg
withNoMatchElement element (ViewConfig config) =
ViewConfig { config | noMatchElement = Just element }
{-| Add a button to clear the input. This element is positioned as Element.inFront.
Select.view []
{ onChange = SelectMsg
, label = Input.labelAbove [] (Element.text "Choose a thing")
, placeholder = Just (Input.placeholder [] (Element.text "Type to search"))
, itemToString = .name
}
|> Select.withClearButton
(Just
(Select.clearButton
[ Element.alignRight
, Element.centerY
, Element.moveLeft 12
]
(Element.el [ Element.Region.description "clear selection" ] (Element.text "❌"))
)
)
|> Select.toElement model.select
-}
withClearButton : Maybe (ClearButton msg) -> ViewConfig a msg -> ViewConfig a msg
withClearButton cb (ViewConfig config) =
ViewConfig { config | clearButton = Maybe.map (\(ClearButton attrs el) -> ( attrs, el )) cb }
{-| A button to clear the input
-}
type ClearButton msg
= ClearButton (List Style) (Html msg)
{-| Create a clear button
-}
clearButton : List Style -> Html msg -> ClearButton msg
clearButton attribs label =
ClearButton attribs label
{-| Use style: position fixed for the menu. This can be used if the select is inside a scrollable container to allow the menu to overflow the parent.
Note that if any transforms (e.g. Element.moveUp/Element.moveLeft) are applied to the parent, this no longer works and the menu will be clipped.
This is due to [a feature of the current CSS spec](https://bugs.chromium.org/p/chromium/issues/detail?id=20574).
Also if the container or window is scrolled or resized without the input losing focus, the menu will appear detached from the input!
To overcome this you may want to listen to scroll and resize events on the parent and window and use [closeMenu](#closeMenu) to hide the menu.
-}
withMenuPositionFixed : Bool -> ViewConfig a msg -> ViewConfig a msg
withMenuPositionFixed v (ViewConfig config) =
ViewConfig { config | positionFixed = v }
{-| Should the input value be cleared when the input loses focus if nothing is selected?
-}
withClearInputValueOnBlur : Bool -> ViewConfig a msg -> ViewConfig a msg
withClearInputValueOnBlur v (ViewConfig config) =
ViewConfig { config | clearInputValueOnBlur = v }
{-| If nothing is selected, but the input value matches exactly one of the options (case insensitive),
should we select it automatically when the input loses focus?
-}
withSelectExactMatchOnBlur : Bool -> ViewConfig a msg -> ViewConfig a msg
withSelectExactMatchOnBlur v (ViewConfig config) =
ViewConfig { config | selectExactMatchOnBlur = v }
{-| Should we select the highlighted option when the TAB key is pressed?
-}
withSelectOnTab : Bool -> ViewConfig a msg -> ViewConfig a msg
withSelectOnTab v (ViewConfig config) =
ViewConfig { config | selectOnTab = v }
{-| If set, no options will show until the specified number of characters have been typed into the input
-}
withMinInputLength : Maybe Int -> ViewConfig a msg -> ViewConfig a msg
withMinInputLength v (ViewConfig config) =
ViewConfig { config | minInputLength = v }
{-| Should the menu be opened when the input gets focus?
-}
withOpenMenuOnFocus : Bool -> ViewConfig a msg -> ViewConfig a msg
withOpenMenuOnFocus v (ViewConfig config) =
ViewConfig { config | openOnFocus = v }
{-| Turn the ViewConfig into an Element.
-}
toStyled :
List Style
->
{ select : Model a
, onChange : Msg a -> msg
, itemToString : a -> String
}
-> ViewConfig a msg
-> Html msg
toStyled attrs config (ViewConfig vc) =
View.toStyled attrs config vc
-- EFFECT
{-| For use with the [Effect pattern](https://sporto.github.io/elm-patterns/architecture/effects.html) and [elm-program-test](https://package.elm-lang.org/packages/avh4/elm-program-test/3.6.3/),
see [Select.Effect](Select-Effect).
-}
type alias Effect effect msg =
Effect.Effect effect msg
-- INTERNAL
mapOptionState : OptionState.OptionState -> OptionState
mapOptionState state =
case state of
OptionState.Idle ->
Idle
OptionState.Highlighted ->
Highlighted
OptionState.Selected ->
Selected
OptionState.SelectedAndHighlighted ->
SelectedAndHighlighted
reverseMapOptionState : OptionState -> OptionState.OptionState
reverseMapOptionState state =
case state of
Idle ->
OptionState.Idle
Highlighted ->
OptionState.Highlighted
Selected ->
OptionState.Selected
SelectedAndHighlighted ->
OptionState.SelectedAndHighlighted
mapPlacement : Placement.Placement -> MenuPlacement
mapPlacement placement =
case placement of
Placement.Above ->
MenuAbove
Placement.Below ->
MenuBelow