diff --git a/elm.json b/elm.json index bbc41890..50606567 100644 --- a/elm.json +++ b/elm.json @@ -22,7 +22,8 @@ "justinmimbs/date": "3.1.2", "norpan/elm-html5-drag-drop": "3.1.4", "ryannhg/date-format": "2.3.0", - "truqu/elm-base64": "2.0.4" + "truqu/elm-base64": "2.0.4", + "ursi/elm-throttle": "1.0.1" }, "indirect": { "elm/bytes": "1.0.8", diff --git a/modules/webapp/src/main/elm/App/Update.elm b/modules/webapp/src/main/elm/App/Update.elm index 0eff0cc0..10439077 100644 --- a/modules/webapp/src/main/elm/App/Update.elm +++ b/modules/webapp/src/main/elm/App/Update.elm @@ -40,44 +40,44 @@ update msg model = ( m, c, s ) = updateWithSub msg model in - ( { m | subs = Sub.batch [ m.subs, s ] }, c ) + ( { m | subs = s }, c ) updateWithSub : Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) updateWithSub msg model = case msg of HomeMsg lm -> - updateHome lm model |> noSub + updateHome lm model LoginMsg lm -> - updateLogin lm model |> noSub + updateLogin lm model ManageDataMsg lm -> - updateManageData lm model |> noSub + updateManageData lm model CollSettingsMsg m -> - updateCollSettings m model |> noSub + updateCollSettings m model UserSettingsMsg m -> - updateUserSettings m model |> noSub + updateUserSettings m model QueueMsg m -> - updateQueue m model |> noSub + updateQueue m model RegisterMsg m -> - updateRegister m model |> noSub + updateRegister m model UploadMsg m -> updateUpload m model NewInviteMsg m -> - updateNewInvite m model |> noSub + updateNewInvite m model ItemDetailMsg m -> updateItemDetail m model VersionResp (Ok info) -> - ( { model | version = info }, Cmd.none ) |> noSub + ( { model | version = info }, Cmd.none, Sub.none ) VersionResp (Err _) -> ( model, Cmd.none, Sub.none ) @@ -162,25 +162,27 @@ updateWithSub msg model = check = checkPage model.flags page - ( m, c ) = + ( m, c, s ) = initPage model page in if check == page then - ( { m | page = page }, c, Sub.none ) + ( { m | page = page }, c, s ) else ( model, Page.goto check, Sub.none ) ToggleNavMenu -> - ( { model | navMenuOpen = not model.navMenuOpen }, Cmd.none, Sub.none ) + ( { model | navMenuOpen = not model.navMenuOpen } + , Cmd.none + , Sub.none + ) GetUiSettings settings -> - Util.Update.andThen1 + Util.Update.andThen2 [ updateUserSettings Page.UserSettings.Data.UpdateSettings , updateHome Page.Home.Data.DoSearch ] { model | uiSettings = settings } - |> noSub updateItemDetail : Page.ItemDetail.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) @@ -200,7 +202,7 @@ updateItemDetail lmsg model = ) -updateNewInvite : Page.NewInvite.Data.Msg -> Model -> ( Model, Cmd Msg ) +updateNewInvite : Page.NewInvite.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) updateNewInvite lmsg model = let ( lm, lc ) = @@ -208,6 +210,7 @@ updateNewInvite lmsg model = in ( { model | newInviteModel = lm } , Cmd.map NewInviteMsg lc + , Sub.none ) @@ -227,7 +230,7 @@ updateUpload lmsg model = ) -updateRegister : Page.Register.Data.Msg -> Model -> ( Model, Cmd Msg ) +updateRegister : Page.Register.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) updateRegister lmsg model = let ( lm, lc ) = @@ -235,10 +238,11 @@ updateRegister lmsg model = in ( { model | registerModel = lm } , Cmd.map RegisterMsg lc + , Sub.none ) -updateQueue : Page.Queue.Data.Msg -> Model -> ( Model, Cmd Msg ) +updateQueue : Page.Queue.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) updateQueue lmsg model = let ( lm, lc ) = @@ -246,10 +250,11 @@ updateQueue lmsg model = in ( { model | queueModel = lm } , Cmd.map QueueMsg lc + , Sub.none ) -updateUserSettings : Page.UserSettings.Data.Msg -> Model -> ( Model, Cmd Msg ) +updateUserSettings : Page.UserSettings.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) updateUserSettings lmsg model = let ( lm, lc, ls ) = @@ -257,17 +262,13 @@ updateUserSettings lmsg model = in ( { model | userSettingsModel = lm - , subs = - Sub.batch - [ model.subs - , Sub.map UserSettingsMsg ls - ] } , Cmd.map UserSettingsMsg lc + , Sub.map UserSettingsMsg ls ) -updateCollSettings : Page.CollectiveSettings.Data.Msg -> Model -> ( Model, Cmd Msg ) +updateCollSettings : Page.CollectiveSettings.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) updateCollSettings lmsg model = let ( lm, lc ) = @@ -277,10 +278,11 @@ updateCollSettings lmsg model = in ( { model | collSettingsModel = lm } , Cmd.map CollSettingsMsg lc + , Sub.none ) -updateLogin : Page.Login.Data.Msg -> Model -> ( Model, Cmd Msg ) +updateLogin : Page.Login.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) updateLogin lmsg model = let ( lm, lc, ar ) = @@ -295,21 +297,25 @@ updateLogin lmsg model = in ( { model | loginModel = lm, flags = newFlags } , Cmd.map LoginMsg lc + , Sub.none ) -updateHome : Page.Home.Data.Msg -> Model -> ( Model, Cmd Msg ) +updateHome : Page.Home.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) updateHome lmsg model = let - ( lm, lc ) = + ( lm, lc, ls ) = Page.Home.Update.update model.key model.flags model.uiSettings lmsg model.homeModel in - ( { model | homeModel = lm } + ( { model + | homeModel = lm + } , Cmd.map HomeMsg lc + , Sub.map HomeMsg ls ) -updateManageData : Page.ManageData.Data.Msg -> Model -> ( Model, Cmd Msg ) +updateManageData : Page.ManageData.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) updateManageData lmsg model = let ( lm, lc ) = @@ -317,14 +323,15 @@ updateManageData lmsg model = in ( { model | manageDataModel = lm } , Cmd.map ManageDataMsg lc + , Sub.none ) -initPage : Model -> Page -> ( Model, Cmd Msg ) +initPage : Model -> Page -> ( Model, Cmd Msg, Sub Msg ) initPage model page = case page of HomePage -> - Util.Update.andThen1 + Util.Update.andThen2 [ updateHome Page.Home.Data.Init , updateQueue Page.Queue.Data.StopRefresh ] @@ -337,14 +344,14 @@ initPage model page = updateQueue Page.Queue.Data.StopRefresh model CollectiveSettingPage -> - Util.Update.andThen1 + Util.Update.andThen2 [ updateQueue Page.Queue.Data.StopRefresh , updateCollSettings Page.CollectiveSettings.Data.Init ] model UserSettingPage -> - Util.Update.andThen1 + Util.Update.andThen2 [ updateQueue Page.Queue.Data.StopRefresh ] model @@ -362,21 +369,8 @@ initPage model page = updateQueue Page.Queue.Data.StopRefresh model ItemDetailPage id -> - let - updateDetail m__ = - let - ( m, c, s ) = - updateItemDetail (Page.ItemDetail.Data.Init id) m__ - in - ( { m | subs = Sub.batch [ m.subs, s ] }, c ) - in - Util.Update.andThen1 - [ updateDetail + Util.Update.andThen2 + [ updateItemDetail (Page.ItemDetail.Data.Init id) , updateQueue Page.Queue.Data.StopRefresh ] model - - -noSub : ( Model, Cmd Msg ) -> ( Model, Cmd Msg, Sub Msg ) -noSub ( m, c ) = - ( m, c, Sub.none ) diff --git a/modules/webapp/src/main/elm/Comp/SearchMenu.elm b/modules/webapp/src/main/elm/Comp/SearchMenu.elm index eb1135cc..d06de0e0 100644 --- a/modules/webapp/src/main/elm/Comp/SearchMenu.elm +++ b/modules/webapp/src/main/elm/Comp/SearchMenu.elm @@ -499,6 +499,9 @@ view settings model = [ text headline ] ] + + nameIcon = + i [ class "left align icon" ] [] in div [ class "ui form" ] [ div [ class "inline field" ] @@ -514,7 +517,7 @@ view settings model = ] ] ] - , formHeader (i [ class "left align icon" ] []) "By Name" + , formHeader nameIcon "Names" , div [ class "field" ] [ label [] [ text "All Names" ] , input @@ -528,7 +531,7 @@ view settings model = ] ] , div [ class "field" ] - [ label [] [ text "Name or Notes" ] + [ label [] [ text "Name" ] , input [ type_ "text" , onInput SetName @@ -536,7 +539,7 @@ view settings model = ] [] , span [ class "small-info" ] - [ text "Looks in item name and notes only." + [ text "Looks in item name." ] ] , span [ class "small-info" ] diff --git a/modules/webapp/src/main/elm/Main.elm b/modules/webapp/src/main/elm/Main.elm index cab34bac..fbc29b5e 100644 --- a/modules/webapp/src/main/elm/Main.elm +++ b/modules/webapp/src/main/elm/Main.elm @@ -45,12 +45,12 @@ init flags url key = page = checkPage flags im.page - ( m, cmd ) = + ( m, cmd, s ) = if im.page == page then App.Update.initPage im page else - ( im, Page.goto page ) + ( im, Page.goto page, Sub.none ) sessionCheck = case m.flags.account of @@ -60,7 +60,7 @@ init flags url key = Nothing -> Cmd.none in - ( m + ( { m | subs = s } , Cmd.batch [ cmd , ic diff --git a/modules/webapp/src/main/elm/Page/Home/Data.elm b/modules/webapp/src/main/elm/Page/Home/Data.elm index 5e8bd36f..7bb62901 100644 --- a/modules/webapp/src/main/elm/Page/Home/Data.elm +++ b/modules/webapp/src/main/elm/Page/Home/Data.elm @@ -16,6 +16,7 @@ import Data.Flags exposing (Flags) import Data.Items import Data.UiSettings exposing (UiSettings) import Http +import Throttle exposing (Throttle) type alias Model = @@ -27,6 +28,7 @@ type alias Model = , searchOffset : Int , moreAvailable : Bool , moreInProgress : Bool + , throttle : Throttle Msg } @@ -40,6 +42,7 @@ init _ = , searchOffset = 0 , moreAvailable = True , moreInProgress = False + , throttle = Throttle.create 1 } @@ -53,6 +56,7 @@ type Msg | DoSearch | ToggleSearchMenu | LoadMore + | UpdateThrottle type ViewMode diff --git a/modules/webapp/src/main/elm/Page/Home/Update.elm b/modules/webapp/src/main/elm/Page/Home/Update.elm index 9dd5636a..592efc6e 100644 --- a/modules/webapp/src/main/elm/Page/Home/Update.elm +++ b/modules/webapp/src/main/elm/Page/Home/Update.elm @@ -7,17 +7,15 @@ import Data.Flags exposing (Flags) import Data.UiSettings exposing (UiSettings) import Page exposing (Page(..)) import Page.Home.Data exposing (..) -import Util.Update +import Throttle +import Time -update : Nav.Key -> Flags -> UiSettings -> Msg -> Model -> ( Model, Cmd Msg ) +update : Nav.Key -> Flags -> UiSettings -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) update key flags settings msg model = case msg of Init -> - Util.Update.andThen1 - [ update key flags settings (SearchMenuMsg Comp.SearchMenu.Init) - ] - model + update key flags settings (SearchMenuMsg Comp.SearchMenu.Init) model ResetSearch -> let @@ -34,14 +32,20 @@ update key flags settings msg model = newModel = { model | searchMenuModel = Tuple.first nextState.modelCmd } - ( m2, c2 ) = + ( m2, c2, s2 ) = if nextState.stateChange && not model.searchInProgress then doSearch flags settings newModel else - ( newModel, Cmd.none ) + withSub ( newModel, Cmd.none ) in - ( m2, Cmd.batch [ c2, Cmd.map SearchMenuMsg (Tuple.second nextState.modelCmd) ] ) + ( m2 + , Cmd.batch + [ c2 + , Cmd.map SearchMenuMsg (Tuple.second nextState.modelCmd) + ] + , s2 + ) ItemCardListMsg m -> let @@ -56,9 +60,10 @@ update key flags settings msg model = Nothing -> Cmd.none in - ( { model | itemListModel = m2 } - , Cmd.batch [ Cmd.map ItemCardListMsg c2, cmd ] - ) + withSub + ( { model | itemListModel = m2 } + , Cmd.batch [ Cmd.map ItemCardListMsg c2, cmd ] + ) ItemSearchResp (Ok list) -> let @@ -92,52 +97,71 @@ update key flags settings msg model = update key flags settings (ItemCardListMsg (Comp.ItemCardList.AddResults list)) m ItemSearchAddResp (Err _) -> - ( { model - | moreInProgress = False - } - , Cmd.none - ) + withSub + ( { model + | moreInProgress = False + } + , Cmd.none + ) ItemSearchResp (Err _) -> - ( { model - | searchInProgress = False - } - , Cmd.none - ) + withSub + ( { model + | searchInProgress = False + } + , Cmd.none + ) DoSearch -> let nm = { model | searchOffset = 0 } in - doSearch flags settings nm + if model.searchInProgress then + withSub ( model, Cmd.none ) + + else + doSearch flags settings nm ToggleSearchMenu -> - ( { model | menuCollapsed = not model.menuCollapsed } - , Cmd.none - ) + withSub + ( { model | menuCollapsed = not model.menuCollapsed } + , Cmd.none + ) LoadMore -> if model.moreAvailable then - doSearchMore flags settings model + doSearchMore flags settings model |> withSub else - ( model, Cmd.none ) + withSub ( model, Cmd.none ) + + UpdateThrottle -> + let + ( newThrottle, cmd ) = + Throttle.update model.throttle + in + withSub ( { model | throttle = newThrottle }, cmd ) -doSearch : Flags -> UiSettings -> Model -> ( Model, Cmd Msg ) +doSearch : Flags -> UiSettings -> Model -> ( Model, Cmd Msg, Sub Msg ) doSearch flags settings model = let - cmd = + searchCmd = doSearchCmd flags settings 0 model + + ( newThrottle, cmd ) = + Throttle.try searchCmd model.throttle in - ( { model - | searchInProgress = True - , viewMode = Listing - , searchOffset = 0 - } - , cmd - ) + withSub + ( { model + | searchInProgress = cmd /= Cmd.none + , viewMode = Listing + , searchOffset = 0 + , throttle = newThrottle + } + , cmd + ) doSearchMore : Flags -> UiSettings -> Model -> ( Model, Cmd Msg ) @@ -149,3 +173,13 @@ doSearchMore flags settings model = ( { model | moreInProgress = True, viewMode = Listing } , cmd ) + + +withSub : ( Model, Cmd Msg ) -> ( Model, Cmd Msg, Sub Msg ) +withSub ( m, c ) = + ( m + , c + , Throttle.ifNeeded + (Time.every 150 (\_ -> UpdateThrottle)) + m.throttle + ) diff --git a/modules/webapp/src/main/elm/Page/Home/View.elm b/modules/webapp/src/main/elm/Page/Home/View.elm index 73b6249a..4accf452 100644 --- a/modules/webapp/src/main/elm/Page/Home/View.elm +++ b/modules/webapp/src/main/elm/Page/Home/View.elm @@ -47,8 +47,15 @@ view settings model = , onClick DoSearch , title "Run search query" , href "" + , disabled model.searchInProgress ] - [ i [ class "ui search icon" ] [] + [ i + [ classList + [ ( "search icon", not model.searchInProgress ) + , ( "loading spinner icon", model.searchInProgress ) + ] + ] + [] ] ] ] @@ -82,12 +89,8 @@ view settings model = ] , case model.viewMode of Listing -> - if model.searchInProgress then - resultPlaceholder - - else - Html.map ItemCardListMsg - (Comp.ItemCardList.view settings model.itemListModel) + Html.map ItemCardListMsg + (Comp.ItemCardList.view settings model.itemListModel) Detail -> div [] [] @@ -123,34 +126,3 @@ view settings model = ] ] ] - - -resultPlaceholder : Html Msg -resultPlaceholder = - div [ class "ui basic segment" ] - [ div [ class "ui active inverted dimmer" ] - [ div [ class "ui medium text loader" ] - [ text "Searching …" - ] - ] - , div [ class "ui middle aligned very relaxed divided basic list segment" ] - [ div [ class "item" ] - [ div [ class "ui fluid placeholder" ] - [ div [ class "full line" ] [] - , div [ class "full line" ] [] - ] - ] - , div [ class "item" ] - [ div [ class "ui fluid placeholder" ] - [ div [ class "full line" ] [] - , div [ class "full line" ] [] - ] - ] - , div [ class "item" ] - [ div [ class "ui fluid placeholder" ] - [ div [ class "full line" ] [] - , div [ class "full line" ] [] - ] - ] - ] - ] diff --git a/modules/webapp/src/main/elm/Util/Update.elm b/modules/webapp/src/main/elm/Util/Update.elm index dee7dfe4..1d14f4ba 100644 --- a/modules/webapp/src/main/elm/Util/Update.elm +++ b/modules/webapp/src/main/elm/Util/Update.elm @@ -1,4 +1,4 @@ -module Util.Update exposing (andThen1) +module Util.Update exposing (andThen1, andThen2) andThen1 : List (a -> ( a, Cmd b )) -> a -> ( a, Cmd b ) @@ -16,3 +16,23 @@ andThen1 fs a = in List.foldl update init fs |> Tuple.mapSecond Cmd.batch + + +andThen2 : List (model -> ( model, Cmd msg, Sub msg )) -> model -> ( model, Cmd msg, Sub msg ) +andThen2 fs m = + let + init = + ( m, [], [] ) + + update el ( m1, c1, s1 ) = + let + ( m2, c2, s2 ) = + el m1 + in + ( m2, c2 :: c1, s2 :: s1 ) + + combine ( m1, cl, sl ) = + ( m1, Cmd.batch cl, Sub.batch sl ) + in + List.foldl update init fs + |> combine