TheAnachronism/docspell
1
0
Fork 0
mirror of https://github.com/TheAnachronism/docspell.git synced 2025-06-04 06:05:59 +00:00
Code Issues Packages Projects Releases Wiki Activity

Throttle search requests

Browse Source 
Throttle search requests when typing. Also fix handling subscriptions
in main.
This commit is contained in:
Eike Kettner 2020-06-13 20:58:15 +02:00
parent 5468e24b55
commit 217fef7384
8 changed files with 160 additions and 132 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
elm.json
View File

@ -22,7 +22,8 @@
"justinmimbs/date": "3.1.2", "justinmimbs/date": "3.1.2",
"norpan/elm-html5-drag-drop": "3.1.4", "norpan/elm-html5-drag-drop": "3.1.4",
"ryannhg/date-format": "2.3.0", "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": { "indirect": {
"elm/bytes": "1.0.8", "elm/bytes": "1.0.8",

92
modules/webapp/src/main/elm/App/Update.elm
View File

@ -40,44 +40,44 @@ update msg model =
( m, c, s ) = ( m, c, s ) =
updateWithSub msg model updateWithSub msg model
in in
( { m | subs = Sub.batch [ m.subs, s ] }, c ) ( { m | subs = s }, c )
updateWithSub : Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) updateWithSub : Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
updateWithSub msg model = updateWithSub msg model =
case msg of case msg of
HomeMsg lm -> HomeMsg lm ->
updateHome lm model |> noSub updateHome lm model
LoginMsg lm -> LoginMsg lm ->
updateLogin lm model |> noSub updateLogin lm model
ManageDataMsg lm -> ManageDataMsg lm ->
updateManageData lm model |> noSub updateManageData lm model
CollSettingsMsg m -> CollSettingsMsg m ->
updateCollSettings m model |> noSub updateCollSettings m model
UserSettingsMsg m -> UserSettingsMsg m ->
updateUserSettings m model |> noSub updateUserSettings m model
QueueMsg m -> QueueMsg m ->
updateQueue m model |> noSub updateQueue m model
RegisterMsg m -> RegisterMsg m ->
updateRegister m model |> noSub updateRegister m model
UploadMsg m -> UploadMsg m ->
updateUpload m model updateUpload m model
NewInviteMsg m -> NewInviteMsg m ->
updateNewInvite m model |> noSub updateNewInvite m model
ItemDetailMsg m -> ItemDetailMsg m ->
updateItemDetail m model updateItemDetail m model
VersionResp (Ok info) -> VersionResp (Ok info) ->
( { model | version = info }, Cmd.none ) |> noSub ( { model | version = info }, Cmd.none, Sub.none )
VersionResp (Err _) -> VersionResp (Err _) ->
( model, Cmd.none, Sub.none ) ( model, Cmd.none, Sub.none )
@ -162,25 +162,27 @@ updateWithSub msg model =
check = check =
checkPage model.flags page checkPage model.flags page
( m, c ) = ( m, c, s ) =
initPage model page initPage model page
in in
if check == page then if check == page then
( { m | page = page }, c, Sub.none ) ( { m | page = page }, c, s )
else else
( model, Page.goto check, Sub.none ) ( model, Page.goto check, Sub.none )
ToggleNavMenu -> ToggleNavMenu ->
( { model | navMenuOpen = not model.navMenuOpen }, Cmd.none, Sub.none ) ( { model | navMenuOpen = not model.navMenuOpen }
, Cmd.none
, Sub.none
)
GetUiSettings settings -> GetUiSettings settings ->
Util.Update.andThen1 Util.Update.andThen2
[ updateUserSettings Page.UserSettings.Data.UpdateSettings [ updateUserSettings Page.UserSettings.Data.UpdateSettings
, updateHome Page.Home.Data.DoSearch , updateHome Page.Home.Data.DoSearch
] ]
{ model | uiSettings = settings } { model | uiSettings = settings }
|> noSub
updateItemDetail : Page.ItemDetail.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) 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 = updateNewInvite lmsg model =
let let
( lm, lc ) = ( lm, lc ) =
@ -208,6 +210,7 @@ updateNewInvite lmsg model =
in in
( { model | newInviteModel = lm } ( { model | newInviteModel = lm }
, Cmd.map NewInviteMsg lc , 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 = updateRegister lmsg model =
let let
( lm, lc ) = ( lm, lc ) =
@ -235,10 +238,11 @@ updateRegister lmsg model =
in in
( { model | registerModel = lm } ( { model | registerModel = lm }
, Cmd.map RegisterMsg lc , 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 = updateQueue lmsg model =
let let
( lm, lc ) = ( lm, lc ) =
@ -246,10 +250,11 @@ updateQueue lmsg model =
in in
( { model | queueModel = lm } ( { model | queueModel = lm }
, Cmd.map QueueMsg lc , 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 = updateUserSettings lmsg model =
let let
( lm, lc, ls ) = ( lm, lc, ls ) =
@ -257,17 +262,13 @@ updateUserSettings lmsg model =
in in
( { model ( { model
| userSettingsModel = lm | userSettingsModel = lm
, subs =
Sub.batch
[ model.subs
, Sub.map UserSettingsMsg ls
]
} }
, Cmd.map UserSettingsMsg lc , 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 = updateCollSettings lmsg model =
let let
( lm, lc ) = ( lm, lc ) =
@ -277,10 +278,11 @@ updateCollSettings lmsg model =
in in
( { model | collSettingsModel = lm } ( { model | collSettingsModel = lm }
, Cmd.map CollSettingsMsg lc , 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 = updateLogin lmsg model =
let let
( lm, lc, ar ) = ( lm, lc, ar ) =
@ -295,21 +297,25 @@ updateLogin lmsg model =
in in
( { model | loginModel = lm, flags = newFlags } ( { model | loginModel = lm, flags = newFlags }
, Cmd.map LoginMsg lc , 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 = updateHome lmsg model =
let let
( lm, lc ) = ( lm, lc, ls ) =
Page.Home.Update.update model.key model.flags model.uiSettings lmsg model.homeModel Page.Home.Update.update model.key model.flags model.uiSettings lmsg model.homeModel
in in
( { model | homeModel = lm } ( { model
| homeModel = lm
}
, Cmd.map HomeMsg lc , 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 = updateManageData lmsg model =
let let
( lm, lc ) = ( lm, lc ) =
@ -317,14 +323,15 @@ updateManageData lmsg model =
in in
( { model | manageDataModel = lm } ( { model | manageDataModel = lm }
, Cmd.map ManageDataMsg lc , Cmd.map ManageDataMsg lc
, Sub.none
) )
initPage : Model -> Page -> ( Model, Cmd Msg ) initPage : Model -> Page -> ( Model, Cmd Msg, Sub Msg )
initPage model page = initPage model page =
case page of case page of
HomePage -> HomePage ->
Util.Update.andThen1 Util.Update.andThen2
[ updateHome Page.Home.Data.Init [ updateHome Page.Home.Data.Init
, updateQueue Page.Queue.Data.StopRefresh , updateQueue Page.Queue.Data.StopRefresh
] ]
@ -337,14 +344,14 @@ initPage model page =
updateQueue Page.Queue.Data.StopRefresh model updateQueue Page.Queue.Data.StopRefresh model
CollectiveSettingPage -> CollectiveSettingPage ->
Util.Update.andThen1 Util.Update.andThen2
[ updateQueue Page.Queue.Data.StopRefresh [ updateQueue Page.Queue.Data.StopRefresh
, updateCollSettings Page.CollectiveSettings.Data.Init , updateCollSettings Page.CollectiveSettings.Data.Init
] ]
model model
UserSettingPage -> UserSettingPage ->
Util.Update.andThen1 Util.Update.andThen2
[ updateQueue Page.Queue.Data.StopRefresh [ updateQueue Page.Queue.Data.StopRefresh
] ]
model model
@ -362,21 +369,8 @@ initPage model page =
updateQueue Page.Queue.Data.StopRefresh model updateQueue Page.Queue.Data.StopRefresh model
ItemDetailPage id -> ItemDetailPage id ->
let Util.Update.andThen2
updateDetail m__ = [ updateItemDetail (Page.ItemDetail.Data.Init id)
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
, updateQueue Page.Queue.Data.StopRefresh , updateQueue Page.Queue.Data.StopRefresh
] ]
model model
noSub : ( Model, Cmd Msg ) -> ( Model, Cmd Msg, Sub Msg )
noSub ( m, c ) =
( m, c, Sub.none )

9
modules/webapp/src/main/elm/Comp/SearchMenu.elm
View File

@ -499,6 +499,9 @@ view settings model =
[ text headline [ text headline
] ]
] ]
nameIcon =
i [ class "left align icon" ] []
in in
div [ class "ui form" ] div [ class "ui form" ]
[ div [ class "inline field" ] [ 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" ] , div [ class "field" ]
[ label [] [ text "All Names" ] [ label [] [ text "All Names" ]
, input , input
@ -528,7 +531,7 @@ view settings model =
] ]
] ]
, div [ class "field" ] , div [ class "field" ]
[ label [] [ text "Name or Notes" ] [ label [] [ text "Name" ]
, input , input
[ type_ "text" [ type_ "text"
, onInput SetName , onInput SetName
@ -536,7 +539,7 @@ view settings model =
] ]
[] []
, span [ class "small-info" ] , span [ class "small-info" ]
[ text "Looks in item name and notes only." [ text "Looks in item name."
] ]
] ]
, span [ class "small-info" ] , span [ class "small-info" ]

6
modules/webapp/src/main/elm/Main.elm
View File

@ -45,12 +45,12 @@ init flags url key =
page = page =
checkPage flags im.page checkPage flags im.page
( m, cmd ) = ( m, cmd, s ) =
if im.page == page then if im.page == page then
App.Update.initPage im page App.Update.initPage im page
else else
( im, Page.goto page ) ( im, Page.goto page, Sub.none )
sessionCheck = sessionCheck =
case m.flags.account of case m.flags.account of
@ -60,7 +60,7 @@ init flags url key =
Nothing -> Nothing ->
Cmd.none Cmd.none
in in
( m ( { m | subs = s }
, Cmd.batch , Cmd.batch
[ cmd [ cmd
, ic , ic

4
modules/webapp/src/main/elm/Page/Home/Data.elm
View File

@ -16,6 +16,7 @@ import Data.Flags exposing (Flags)
import Data.Items import Data.Items
import Data.UiSettings exposing (UiSettings) import Data.UiSettings exposing (UiSettings)
import Http import Http
import Throttle exposing (Throttle)
type alias Model = type alias Model =
@ -27,6 +28,7 @@ type alias Model =
, searchOffset : Int , searchOffset : Int
, moreAvailable : Bool , moreAvailable : Bool
, moreInProgress : Bool , moreInProgress : Bool
, throttle : Throttle Msg
} }
@ -40,6 +42,7 @@ init _ =
, searchOffset = 0 , searchOffset = 0
, moreAvailable = True , moreAvailable = True
, moreInProgress = False , moreInProgress = False
, throttle = Throttle.create 1
} }
@ -53,6 +56,7 @@ type Msg
| DoSearch | DoSearch
| ToggleSearchMenu | ToggleSearchMenu
| LoadMore | LoadMore
| UpdateThrottle
type ViewMode type ViewMode

108
modules/webapp/src/main/elm/Page/Home/Update.elm
View File

@ -7,17 +7,15 @@ import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings) import Data.UiSettings exposing (UiSettings)
import Page exposing (Page(..)) import Page exposing (Page(..))
import Page.Home.Data exposing (..) 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 = update key flags settings msg model =
case msg of case msg of
Init -> Init ->
Util.Update.andThen1 update key flags settings (SearchMenuMsg Comp.SearchMenu.Init) model
[ update key flags settings (SearchMenuMsg Comp.SearchMenu.Init)
]
model
ResetSearch -> ResetSearch ->
let let
@ -34,14 +32,20 @@ update key flags settings msg model =
newModel = newModel =
{ model | searchMenuModel = Tuple.first nextState.modelCmd } { model | searchMenuModel = Tuple.first nextState.modelCmd }
( m2, c2 ) = ( m2, c2, s2 ) =
if nextState.stateChange && not model.searchInProgress then if nextState.stateChange && not model.searchInProgress then
doSearch flags settings newModel doSearch flags settings newModel
else else
( newModel, Cmd.none ) withSub ( newModel, Cmd.none )
in 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 -> ItemCardListMsg m ->
let let
@ -56,9 +60,10 @@ update key flags settings msg model =
Nothing -> Nothing ->
Cmd.none Cmd.none
in in
( { model | itemListModel = m2 } withSub
, Cmd.batch [ Cmd.map ItemCardListMsg c2, cmd ] ( { model | itemListModel = m2 }
) , Cmd.batch [ Cmd.map ItemCardListMsg c2, cmd ]
)
ItemSearchResp (Ok list) -> ItemSearchResp (Ok list) ->
let let
@ -92,52 +97,71 @@ update key flags settings msg model =
update key flags settings (ItemCardListMsg (Comp.ItemCardList.AddResults list)) m update key flags settings (ItemCardListMsg (Comp.ItemCardList.AddResults list)) m
ItemSearchAddResp (Err _) -> ItemSearchAddResp (Err _) ->
( { model withSub
| moreInProgress = False ( { model
} | moreInProgress = False
, Cmd.none }
) , Cmd.none
)
ItemSearchResp (Err _) -> ItemSearchResp (Err _) ->
( { model withSub
| searchInProgress = False ( { model
} | searchInProgress = False
, Cmd.none }
) , Cmd.none
)
DoSearch -> DoSearch ->
let let
nm = nm =
{ model | searchOffset = 0 } { model | searchOffset = 0 }
in in
doSearch flags settings nm if model.searchInProgress then
withSub ( model, Cmd.none )
else
doSearch flags settings nm
ToggleSearchMenu -> ToggleSearchMenu ->
( { model | menuCollapsed = not model.menuCollapsed } withSub
, Cmd.none ( { model | menuCollapsed = not model.menuCollapsed }
) , Cmd.none
)
LoadMore -> LoadMore ->
if model.moreAvailable then if model.moreAvailable then
doSearchMore flags settings model doSearchMore flags settings model |> withSub
else 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 = doSearch flags settings model =
let let
cmd = searchCmd =
doSearchCmd flags settings 0 model doSearchCmd flags settings 0 model
( newThrottle, cmd ) =
Throttle.try searchCmd model.throttle
in in
( { model withSub
| searchInProgress = True ( { model
, viewMode = Listing | searchInProgress = cmd /= Cmd.none
, searchOffset = 0 , viewMode = Listing
} , searchOffset = 0
, cmd , throttle = newThrottle
) }
, cmd
)
doSearchMore : Flags -> UiSettings -> Model -> ( Model, Cmd Msg ) doSearchMore : Flags -> UiSettings -> Model -> ( Model, Cmd Msg )
@ -149,3 +173,13 @@ doSearchMore flags settings model =
( { model | moreInProgress = True, viewMode = Listing } ( { model | moreInProgress = True, viewMode = Listing }
, cmd , cmd
) )
withSub : ( Model, Cmd Msg ) -> ( Model, Cmd Msg, Sub Msg )
withSub ( m, c ) =
( m
, c
, Throttle.ifNeeded
(Time.every 150 (\_ -> UpdateThrottle))
m.throttle
)

48
modules/webapp/src/main/elm/Page/Home/View.elm
View File

@ -47,8 +47,15 @@ view settings model =
, onClick DoSearch , onClick DoSearch
, title "Run search query" , title "Run search query"
, href "" , 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 , case model.viewMode of
Listing -> Listing ->
if model.searchInProgress then Html.map ItemCardListMsg
resultPlaceholder (Comp.ItemCardList.view settings model.itemListModel)
else
Html.map ItemCardListMsg
(Comp.ItemCardList.view settings model.itemListModel)
Detail -> Detail ->
div [] [] 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" ] []
]
]
]
]

22
modules/webapp/src/main/elm/Util/Update.elm
View File

@ -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 ) andThen1 : List (a -> ( a, Cmd b )) -> a -> ( a, Cmd b )
@ -16,3 +16,23 @@ andThen1 fs a =
in in
List.foldl update init fs List.foldl update init fs
|> Tuple.mapSecond Cmd.batch |> 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