TheAnachronism/docspell
1
0
Fork 0
mirror of https://github.com/TheAnachronism/docspell.git synced 2025-03-27 17:35:04 +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",
"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",

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

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

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

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

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

@ -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

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.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

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

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

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

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