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

Add msg parameter to Effect

Browse Source
This commit is contained in:
Tom Nunn 2022-07-12 17:12:49 +02:00
parent 69dc3418c3
commit 03838bd980
8 changed files with 87 additions and 93 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
examples/src/EffectExample.elm
View File

@ -62,7 +62,7 @@ type Msg
type MyEffect
= SelectEffect (Select.Effect Never)
= SelectEffect (Select.Effect Never Msg)
| NoEffect
@ -70,7 +70,7 @@ update : Msg -> Model -> ( Model, MyEffect )
update msg model =
case msg of
CountrySelectMsg subMsg ->
Select.Effect.update subMsg model.countrySelect
Select.Effect.update CountrySelectMsg subMsg model.countrySelect
|> Tuple.mapFirst (\select -> { model | countrySelect = select })
|> Tuple.mapSecond SelectEffect
@ -82,4 +82,4 @@ performEffect effect =
Cmd.none
SelectEffect selectEffect ->
Select.Effect.perform CountrySelectMsg selectEffect
Select.Effect.perform selectEffect

5
examples/src/EffectRequestExample.elm
View File

@ -68,6 +68,7 @@ update msg model =
, clearInputValueOnBlur = True
, selectExactMatchOnBlur = False
}
SelectMsg
subMsg
model.select
|> Tuple.mapBoth (\select -> { model | select = select }) SelectEffect
@ -95,7 +96,7 @@ fetchCocktails tagger query =
type MyEffect
= NoEffect
| SelectEffect (Select.Effect MyEffect)
| SelectEffect (Select.Effect MyEffect Msg)
| FetchCocktails String
@ -106,7 +107,7 @@ performEffect effect =
Cmd.none
SelectEffect selectEffect ->
Select.Effect.performWithRequest SelectMsg performEffect selectEffect
Select.Effect.performWithRequest performEffect selectEffect
FetchCocktails query ->
fetchCocktails (Select.gotRequestResponse query >> SelectMsg) query

1
examples/tests/ExampleTest.elm
View File

@ -81,7 +81,6 @@ simulateEffect effect =
App.SelectEffect selectEffect ->
Select.Effect.simulate
App.CountrySelectMsg
{ perform = SimulatedTask.perform
, batch = SimulatedCmd.batch
, sleep = SimulatedProcess.sleep

1
examples/tests/RequestTest.elm
View File

@ -68,7 +68,6 @@ simulateEffect effect =
App.SelectEffect selectEffect ->
Select.Effect.simulateWithRequest
App.SelectMsg
{ perform = SimulatedTask.perform
, batch = SimulatedCmd.batch
, sleep = SimulatedProcess.sleep

62
src/Internal/Effect.elm
View File

@ -1,71 +1,68 @@
module Internal.Effect exposing (Effect(..), batch, none, perform, simulate)
import Browser.Dom as Dom
import Internal.Msg exposing (Msg(..))
import Process
import Task exposing (Task)
type Effect effect
= GetContainerAndMenuElements { containerId : String, menuId : String }
| GetElementsAndScrollMenu { menuId : String, optionId : String }
| Batch (List (Effect effect))
type Effect effect msg
= GetContainerAndMenuElements (Result Dom.Error { menu : Dom.Viewport, container : Dom.Element } -> msg) { containerId : String, menuId : String }
| GetElementsAndScrollMenu msg { menuId : String, optionId : String }
| Batch (List (Effect effect msg))
| Request effect
| Debounce Float String
| Debounce (String -> msg) Float String
| None
none : Effect effect
none : Effect effect msg
none =
None
batch : List (Effect effect) -> Effect effect
batch : List (Effect effect msg) -> Effect effect msg
batch effects =
Batch effects
perform : (Msg a -> msg) -> (effect -> Cmd msg) -> Effect effect -> Cmd msg
perform tagger requestCmd effect =
perform : (effect -> Cmd msg) -> Effect effect msg -> Cmd msg
perform requestCmd effect =
case effect of
GetContainerAndMenuElements ids ->
getContainerAndMenuElements (GotContainerAndMenuElements >> tagger) ids
GetContainerAndMenuElements msg ids ->
getContainerAndMenuElements msg ids
GetElementsAndScrollMenu ids ->
getElementsAndScrollMenu (tagger NoOp) ids
GetElementsAndScrollMenu msg ids ->
getElementsAndScrollMenu msg ids
Batch effects ->
List.foldl (\eff cmds -> perform tagger requestCmd eff :: cmds) [] effects
List.foldl (\eff cmds -> perform requestCmd eff :: cmds) [] effects
|> Cmd.batch
Request eff ->
requestCmd eff
Debounce delay val ->
Debounce msg delay val ->
Process.sleep delay
|> Task.perform (\_ -> tagger (InputDebounceReturned val))
|> Task.perform (\_ -> msg val)
None ->
Cmd.none
simulate :
(Msg a -> msg)
->
{ perform : (() -> msg) -> simulatedTask -> simulatedEffect
, batch : List simulatedEffect -> simulatedEffect
, sleep : Float -> simulatedTask
}
{ perform : (() -> msg) -> simulatedTask -> simulatedEffect
, batch : List simulatedEffect -> simulatedEffect
, sleep : Float -> simulatedTask
}
-> (effect -> simulatedEffect)
-> Effect effect
-> Effect effect msg
-> simulatedEffect
simulate tagger conf simulateRequest effect =
simulate conf simulateRequest effect =
case effect of
GetContainerAndMenuElements _ ->
GetContainerAndMenuElements msg _ ->
conf.sleep 0
|> conf.perform
(\_ ->
GotContainerAndMenuElements
msg
(Ok
{ container = { scene = { width = 1163, height = 975 }, viewport = { x = 0, y = 0, width = 1163, height = 975 }, element = { x = 436, y = 452, width = 291, height = 71 } }
, menu =
@ -74,23 +71,22 @@ simulate tagger conf simulateRequest effect =
}
}
)
|> tagger
)
GetElementsAndScrollMenu _ ->
GetElementsAndScrollMenu msg _ ->
conf.sleep 0
|> conf.perform (\_ -> tagger NoOp)
|> conf.perform (\_ -> msg)
Batch effects ->
List.foldl (\eff cmds -> simulate tagger conf simulateRequest eff :: cmds) [] effects
List.foldl (\eff cmds -> simulate conf simulateRequest eff :: cmds) [] effects
|> conf.batch
Request eff ->
simulateRequest eff
Debounce delay val ->
Debounce msg delay val ->
conf.sleep delay
|> conf.perform (\_ -> tagger (InputDebounceReturned val))
|> conf.perform (\_ -> msg val)
None ->
conf.batch []

48
src/Internal/Update.elm
View File

@ -9,8 +9,8 @@ import Internal.RequestState exposing (RequestState(..))
import Select.UpdateConfig exposing (UpdateConfig)
update : UpdateConfig effect -> Msg a -> Model a -> ( Model a, Effect effect )
update ({ request } as config) msg model =
update : UpdateConfig effect -> (Msg a -> msg) -> Msg a -> Model a -> ( Model a, Effect effect msg )
update ({ request } as config) tagger msg model =
case msg of
InputChanged val ->
( model
@ -35,13 +35,13 @@ update ({ request } as config) msg model =
, case request of
Just req ->
if String.length val >= Request.toMinLength req then
Effect.Debounce (Request.toDelay req) val
Effect.Debounce (InputDebounceReturned >> tagger) (Request.toDelay req) val
else
Effect.none
Nothing ->
getContainerAndMenuElementsEffect model
getContainerAndMenuElementsEffect tagger model
)
OptionClicked opt ->
@ -50,10 +50,10 @@ update ({ request } as config) msg model =
)
InputFocused ->
onFocusMenu request model
onFocusMenu tagger request model
InputClicked ->
onFocusMenu request model
onFocusMenu tagger request model
InputLostFocus filteredOptions ->
( Model.blur config filteredOptions model
@ -66,7 +66,7 @@ update ({ request } as config) msg model =
)
KeyDown filteredOptions key ->
handleKey model key filteredOptions
handleKey tagger model key filteredOptions
GotContainerAndMenuElements result ->
( model
@ -109,7 +109,7 @@ update ({ request } as config) msg model =
|> Model.setItems items
|> Model.setRequestState (Just Success)
, if Model.toValue model == Nothing then
getContainerAndMenuElementsEffect model
getContainerAndMenuElementsEffect tagger model
else
Effect.none
@ -127,32 +127,32 @@ update ({ request } as config) msg model =
( model, Effect.none )
onFocusMenu : Maybe (Request effect) -> Model a -> ( Model a, Effect effect )
onFocusMenu maybeRequest model =
onFocusMenu : (Msg a -> msg) -> Maybe (Request effect) -> Model a -> ( Model a, Effect effect msg )
onFocusMenu tagger maybeRequest model =
( Model.setFocused True model
|> Model.highlightIndex 0
, if maybeRequest == Nothing || Model.toRequestState model == Just Success then
getContainerAndMenuElementsEffect model
getContainerAndMenuElementsEffect tagger model
else
Effect.none
)
handleKey : Model a -> String -> List (Option a) -> ( Model a, Effect effect )
handleKey model key filteredOptions =
handleKey : (Msg a -> msg) -> Model a -> String -> List (Option a) -> ( Model a, Effect effect msg )
handleKey tagger model key filteredOptions =
case key of
"ArrowDown" ->
moveHighlight (Basics.min (List.length filteredOptions - 1) (Model.toHighlighted model + 1)) model
moveHighlight tagger (Basics.min (List.length filteredOptions - 1) (Model.toHighlighted model + 1)) model
"ArrowUp" ->
moveHighlight (Basics.max 0 (Model.toHighlighted model - 1)) model
moveHighlight tagger (Basics.max 0 (Model.toHighlighted model - 1)) model
"PageDown" ->
moveHighlight (Basics.min (List.length filteredOptions - 1) (Model.toHighlighted model + 10)) model
moveHighlight tagger (Basics.min (List.length filteredOptions - 1) (Model.toHighlighted model + 10)) model
"PageUp" ->
moveHighlight (Basics.max 0 (Model.toHighlighted model - 10)) model
moveHighlight tagger (Basics.max 0 (Model.toHighlighted model - 10)) model
"Enter" ->
case getAt (Model.toHighlighted model) filteredOptions of
@ -169,13 +169,14 @@ handleKey model key filteredOptions =
( model, Effect.none )
moveHighlight : Int -> Model a -> ( Model a, Effect effect )
moveHighlight newHighlighted model =
moveHighlight : (Msg a -> msg) -> Int -> Model a -> ( Model a, Effect effect msg )
moveHighlight tagger newHighlighted model =
if Model.isOpen model then
( Model.highlightIndex newHighlighted model
, Effect.batch
[ getContainerAndMenuElementsEffect model
[ getContainerAndMenuElementsEffect tagger model
, Effect.GetElementsAndScrollMenu
(tagger NoOp)
{ menuId = Model.toMenuElementId model
, optionId = Model.toOptionElementId model newHighlighted
}
@ -184,13 +185,14 @@ moveHighlight newHighlighted model =
else
( model
, getContainerAndMenuElementsEffect model
, getContainerAndMenuElementsEffect tagger model
)
getContainerAndMenuElementsEffect : Model a -> Effect effect
getContainerAndMenuElementsEffect model =
getContainerAndMenuElementsEffect : (Msg a -> msg) -> Model a -> Effect effect msg
getContainerAndMenuElementsEffect tagger model =
Effect.GetContainerAndMenuElements
(GotContainerAndMenuElements >> tagger)
{ menuId = Model.toMenuElementId model
, containerId = Model.toContainerElementId model
}

12
src/Select.elm
View File

@ -191,8 +191,8 @@ type alias Msg a =
-}
update : (Msg a -> msg) -> Msg a -> Select a -> ( Select a, Cmd msg )
update tagger msg select =
Update.update UpdateConfig.default msg select
|> Tuple.mapSecond (Effect.perform tagger (\_ -> Cmd.none))
Update.update UpdateConfig.default tagger msg select
|> Tuple.mapSecond (Effect.perform (\_ -> Cmd.none))
{-| Update with configuration options, including using an HTTP request to retrieve matching remote results.
@ -234,8 +234,8 @@ You can also use [Select.UpdateConfig](Select-UpdateConfig) to build up a config
-}
updateWith : UpdateConfig (Cmd (Msg a)) -> (Msg a -> msg) -> Msg a -> Select a -> ( Select a, Cmd msg )
updateWith config tagger msg select =
Update.update config msg select
|> Tuple.mapSecond (Effect.perform identity identity >> Cmd.map tagger)
Update.update config identity msg select
|> Tuple.mapSecond (Effect.perform identity >> Cmd.map tagger)
{-| A Request. See [Select.Request](Select-Request) for configuration options.
@ -404,8 +404,8 @@ toElement model (ViewConfig config) =
{-| For use with the [Effect pattern](https://sporto.github.io/elm-patterns/architecture/effects.html)
-}
type alias Effect effect =
Effect.Effect effect
type alias Effect effect msg =
Effect.Effect effect msg

45
src/Select/Effect.elm
View File

@ -51,8 +51,8 @@ import Select.UpdateConfig as UpdateConfig exposing (UpdateConfig)
{-| The Effect type
-}
type alias Effect effect =
Effect.Effect effect
type alias Effect effect msg =
Effect.Effect effect msg
@ -79,7 +79,7 @@ type alias Effect effect =
Select.Effect.perform selectEffect
-}
update : Msg a -> Select a -> ( Select a, Effect Never )
update : (Msg a -> msg) -> Msg a -> Select a -> ( Select a, Effect Never msg )
update =
Update.update UpdateConfig.default
@ -101,6 +101,7 @@ See [Select.UpdateConfig](Select-UpdateConfig) for configuration options.
, clearInputValueOnBlur = False
, selectExactMatchOnBlur = True
}
SelectMsg
subMsg
model.select
|> Tuple.mapFirst (\select -> { model | select = select })
@ -133,7 +134,7 @@ You can also use [Select.UpdateConfig](Select-UpdateConfig) to build up a config
|> Tuple.mapFirst (\select -> { model | select = select })
-}
updateWith : UpdateConfig effect -> Msg a -> Select a -> ( Select a, Effect effect )
updateWith : UpdateConfig effect -> (Msg a -> msg) -> Msg a -> Select a -> ( Select a, Effect effect msg )
updateWith =
Update.update
@ -166,9 +167,9 @@ request =
Select.Effect.perform selectEffect
-}
perform : (Msg a -> msg) -> Effect Never -> Cmd msg
perform tagger =
Effect.perform tagger (\_ -> Cmd.none)
perform : Effect Never msg -> Cmd msg
perform =
Effect.perform (\_ -> Cmd.none)
{-| Perform the Effect with a request. You need to provide your own perform function to perform the provided request effect.
@ -183,7 +184,7 @@ perform tagger =
fetchThings (Select.gotRequestResponse >> SelectMsg) query
-}
performWithRequest : (Msg a -> msg) -> (effect -> Cmd msg) -> Effect effect -> Cmd msg
performWithRequest : (effect -> Cmd msg) -> Effect effect msg -> Cmd msg
performWithRequest =
Effect.perform
@ -205,16 +206,14 @@ you need to provide some of the functions to help with the simulation.
-}
simulate :
(Msg a -> msg)
->
{ perform : (() -> msg) -> simulatedTask -> simulatedEffect
, batch : List simulatedEffect -> simulatedEffect
, sleep : Float -> simulatedTask
}
-> Effect Never
{ perform : (() -> msg) -> simulatedTask -> simulatedEffect
, batch : List simulatedEffect -> simulatedEffect
, sleep : Float -> simulatedTask
}
-> Effect Never msg
-> simulatedEffect
simulate tagger conf =
Effect.simulate tagger conf (\_ -> conf.batch [])
simulate conf =
Effect.simulate conf (\_ -> conf.batch [])
{-| Simulate the select effects with a request. This is designed to work with [elm-program-test](https://package.elm-lang.org/packages/avh4/elm-program-test/3.6.3/), but since this package doesn't have it as a dependency,
@ -241,14 +240,12 @@ you need to provide some of the functions to help with the simulation.
-}
simulateWithRequest :
(Msg a -> msg)
->
{ perform : (() -> msg) -> simulatedTask -> simulatedEffect
, batch : List simulatedEffect -> simulatedEffect
, sleep : Float -> simulatedTask
}
{ perform : (() -> msg) -> simulatedTask -> simulatedEffect
, batch : List simulatedEffect -> simulatedEffect
, sleep : Float -> simulatedTask
}
-> (effect -> simulatedEffect)
-> Effect effect
-> Effect effect msg
-> simulatedEffect
simulateWithRequest =
Effect.simulate