Throttle search requests

Throttle search requests when typing. Also fix handling subscriptions
in main.

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 )

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" ]

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

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

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
+    )

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" ] []
-                    ]
-                ]
-            ]
-        ]

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