Merge pull request #139 from eikek/batch-loading

Batch loading
This commit is contained in:
eikek 2020-06-07 09:21:29 +02:00 committed by GitHub
commit 0382ff2308
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
22 changed files with 826 additions and 73 deletions

View File

@ -12,6 +12,7 @@ import OItem.{
AttachmentArchiveData, AttachmentArchiveData,
AttachmentData, AttachmentData,
AttachmentSourceData, AttachmentSourceData,
Batch,
ItemData, ItemData,
ListItem, ListItem,
Query Query
@ -24,7 +25,7 @@ trait OItem[F[_]] {
def findItem(id: Ident, collective: Ident): F[Option[ItemData]] def findItem(id: Ident, collective: Ident): F[Option[ItemData]]
def findItems(q: Query, maxResults: Int): F[Vector[ListItem]] def findItems(q: Query, batch: Batch): F[Vector[ListItem]]
def findAttachment(id: Ident, collective: Ident): F[Option[AttachmentData[F]]] def findAttachment(id: Ident, collective: Ident): F[Option[AttachmentData[F]]]
@ -84,6 +85,9 @@ object OItem {
type Query = QItem.Query type Query = QItem.Query
val Query = QItem.Query val Query = QItem.Query
type Batch = QItem.Batch
val Batch = QItem.Batch
type ListItem = QItem.ListItem type ListItem = QItem.ListItem
val ListItem = QItem.ListItem val ListItem = QItem.ListItem
@ -138,8 +142,11 @@ object OItem {
.transact(QItem.findItem(id)) .transact(QItem.findItem(id))
.map(opt => opt.flatMap(_.filterCollective(collective))) .map(opt => opt.flatMap(_.filterCollective(collective)))
def findItems(q: Query, maxResults: Int): F[Vector[ListItem]] = def findItems(q: Query, batch: Batch): F[Vector[ListItem]] =
store.transact(QItem.findItems(q).take(maxResults.toLong)).compile.toVector store
.transact(QItem.findItems(q, batch).take(batch.limit.toLong))
.compile
.toVector
def findAttachment(id: Ident, collective: Ident): F[Option[AttachmentData[F]]] = def findAttachment(id: Ident, collective: Ident): F[Option[AttachmentData[F]]] =
store store

View File

@ -8,6 +8,7 @@ import emil.markdown._
import emil.javamail.syntax._ import emil.javamail.syntax._
import docspell.common._ import docspell.common._
import docspell.backend.ops.OItem.Batch
import docspell.store.records._ import docspell.store.records._
import docspell.store.queries.QItem import docspell.store.queries.QItem
import docspell.joex.scheduler.{Context, Task} import docspell.joex.scheduler.{Context, Task}
@ -15,7 +16,7 @@ import cats.data.OptionT
import docspell.joex.mail.EmilHeader import docspell.joex.mail.EmilHeader
object NotifyDueItemsTask { object NotifyDueItemsTask {
val maxItems: Long = 7 val maxItems: Int = 7
type Args = NotifyDueItemsArgs type Args = NotifyDueItemsArgs
def apply[F[_]: Sync](cfg: MailSendConfig, emil: Emil[F]): Task[F, Args, Unit] = def apply[F[_]: Sync](cfg: MailSendConfig, emil: Emil[F]): Task[F, Args, Unit] =
@ -78,7 +79,11 @@ object NotifyDueItemsTask {
dueDateTo = Some(now + Duration.days(ctx.args.remindDays.toLong)), dueDateTo = Some(now + Duration.days(ctx.args.remindDays.toLong)),
orderAsc = Some(_.dueDate) orderAsc = Some(_.dueDate)
) )
res <- ctx.store.transact(QItem.findItems(q).take(maxItems)).compile.toVector res <-
ctx.store
.transact(QItem.findItems(q, Batch.limit(maxItems)).take(maxItems.toLong))
.compile
.toVector
} yield res } yield res
def makeMail[F[_]: Sync]( def makeMail[F[_]: Sync](

View File

@ -3121,6 +3121,8 @@ components:
- tagsInclude - tagsInclude
- tagsExclude - tagsExclude
- inbox - inbox
- offset
- limit
properties: properties:
tagsInclude: tagsInclude:
type: array type: array
@ -3134,6 +3136,16 @@ components:
format: ident format: ident
inbox: inbox:
type: boolean type: boolean
offset:
type: integer
format: int32
limit:
type: integer
format: int32
description: |
The maximum number of results to return. Note that this
limit is a soft limit, there is some hard limit on the
server, too.
direction: direction:
type: string type: string
format: direction format: direction

View File

@ -4,6 +4,7 @@ import cats.effect._
import cats.implicits._ import cats.implicits._
import docspell.backend.BackendApp import docspell.backend.BackendApp
import docspell.backend.auth.AuthToken import docspell.backend.auth.AuthToken
import docspell.backend.ops.OItem.Batch
import docspell.common.{Ident, ItemState} import docspell.common.{Ident, ItemState}
import org.http4s.HttpRoutes import org.http4s.HttpRoutes
import org.http4s.dsl.Http4sDsl import org.http4s.dsl.Http4sDsl
@ -27,9 +28,12 @@ object ItemRoutes {
mask <- req.as[ItemSearch] mask <- req.as[ItemSearch]
_ <- logger.ftrace(s"Got search mask: $mask") _ <- logger.ftrace(s"Got search mask: $mask")
query = Conversions.mkQuery(mask, user.account.collective) query = Conversions.mkQuery(mask, user.account.collective)
_ <- logger.ftrace(s"Running query: $query") _ <- logger.ftrace(s"Running query: $query")
items <- backend.item.findItems(query, 100) items <- backend.item.findItems(
resp <- Ok(Conversions.mkItemList(items)) query,
Batch(mask.offset, mask.limit).restrictLimitTo(500)
)
resp <- Ok(Conversions.mkItemList(items))
} yield resp } yield resp
case GET -> Root / Ident(id) => case GET -> Root / Ident(id) =>

View File

@ -187,7 +187,22 @@ object QItem {
) )
} }
def findItems(q: Query): Stream[ConnectionIO, ListItem] = { case class Batch(offset: Int, limit: Int) {
def restrictLimitTo(n: Int): Batch =
Batch(offset, math.min(n, limit))
}
object Batch {
val all: Batch = Batch(0, Int.MaxValue)
def page(n: Int, size: Int): Batch =
Batch(n * size, size)
def limit(c: Int): Batch =
Batch(0, c)
}
def findItems(q: Query, batch: Batch): Stream[ConnectionIO, ListItem] = {
val IC = RItem.Columns val IC = RItem.Columns
val AC = RAttachment.Columns val AC = RAttachment.Columns
val PC = RPerson.Columns val PC = RPerson.Columns
@ -314,8 +329,13 @@ object QItem {
coalesce(IC.itemDate.prefix("i").f, IC.created.prefix("i").f) ++ fr"DESC" coalesce(IC.itemDate.prefix("i").f, IC.created.prefix("i").f) ++ fr"DESC"
) )
} }
val frag = query ++ fr"WHERE" ++ cond ++ order val limitOffset =
logger.trace(s"List items: $frag") if (batch == Batch.all) Fragment.empty
else fr"LIMIT ${batch.limit} OFFSET ${batch.offset}"
val frag =
query ++ fr"WHERE" ++ cond ++ order ++ limitOffset
logger.trace(s"List $batch items: $frag")
frag.query[ListItem].stream frag.query[ListItem].stream
} }

View File

@ -11,6 +11,7 @@ import Api.Model.VersionInfo exposing (VersionInfo)
import Browser exposing (UrlRequest) import Browser exposing (UrlRequest)
import Browser.Navigation exposing (Key) import Browser.Navigation exposing (Key)
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Http import Http
import Page exposing (Page(..)) import Page exposing (Page(..))
import Page.CollectiveSettings.Data import Page.CollectiveSettings.Data
@ -57,7 +58,7 @@ init key url flags =
, key = key , key = key
, page = page , page = page
, version = Api.Model.VersionInfo.empty , version = Api.Model.VersionInfo.empty
, homeModel = Page.Home.Data.emptyModel , homeModel = Page.Home.Data.init flags
, loginModel = Page.Login.Data.emptyModel , loginModel = Page.Login.Data.emptyModel
, manageDataModel = Page.ManageData.Data.emptyModel , manageDataModel = Page.ManageData.Data.emptyModel
, collSettingsModel = Page.CollectiveSettings.Data.emptyModel , collSettingsModel = Page.CollectiveSettings.Data.emptyModel
@ -90,6 +91,7 @@ type Msg
| LogoutResp (Result Http.Error ()) | LogoutResp (Result Http.Error ())
| SessionCheckResp (Result Http.Error AuthResult) | SessionCheckResp (Result Http.Error AuthResult)
| ToggleNavMenu | ToggleNavMenu
| GetUiSettings UiSettings
isSignedIn : Flags -> Bool isSignedIn : Flags -> Bool

View File

@ -40,7 +40,7 @@ update msg model =
( m, c, s ) = ( m, c, s ) =
updateWithSub msg model updateWithSub msg model
in in
( { m | subs = s }, c ) ( { m | subs = Sub.batch [ m.subs, s ] }, c )
updateWithSub : Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) updateWithSub : Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
@ -92,7 +92,10 @@ updateWithSub msg model =
) )
LogoutResp _ -> LogoutResp _ ->
( { model | loginModel = Page.Login.Data.emptyModel }, Page.goto (LoginPage Nothing), Sub.none ) ( { model | loginModel = Page.Login.Data.emptyModel }
, Page.goto (LoginPage Nothing)
, Sub.none
)
SessionCheckResp res -> SessionCheckResp res ->
case res of case res of
@ -171,6 +174,14 @@ updateWithSub msg model =
ToggleNavMenu -> ToggleNavMenu ->
( { model | navMenuOpen = not model.navMenuOpen }, Cmd.none, Sub.none ) ( { model | navMenuOpen = not model.navMenuOpen }, Cmd.none, Sub.none )
GetUiSettings settings ->
Util.Update.andThen1
[ updateUserSettings (Page.UserSettings.Data.GetUiSettings settings)
, updateHome (Page.Home.Data.GetUiSettings settings)
]
model
|> noSub
updateItemDetail : Page.ItemDetail.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg ) updateItemDetail : Page.ItemDetail.Data.Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
updateItemDetail lmsg model = updateItemDetail lmsg model =
@ -241,10 +252,17 @@ updateQueue lmsg model =
updateUserSettings : Page.UserSettings.Data.Msg -> Model -> ( Model, Cmd Msg ) updateUserSettings : Page.UserSettings.Data.Msg -> Model -> ( Model, Cmd Msg )
updateUserSettings lmsg model = updateUserSettings lmsg model =
let let
( lm, lc ) = ( lm, lc, ls ) =
Page.UserSettings.Update.update model.flags lmsg model.userSettingsModel Page.UserSettings.Update.update model.flags lmsg model.userSettingsModel
in in
( { model | userSettingsModel = lm } ( { model
| userSettingsModel = lm
, subs =
Sub.batch
[ model.subs
, Sub.map UserSettingsMsg ls
]
}
, Cmd.map UserSettingsMsg lc , Cmd.map UserSettingsMsg lc
) )

View File

@ -14,9 +14,11 @@ import Api.Model.ItemLightList exposing (ItemLightList)
import Data.Direction import Data.Direction
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
import Data.Icons as Icons import Data.Icons as Icons
import Data.Items
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick) import Html.Events exposing (onClick)
import Ports
import Util.List import Util.List
import Util.String import Util.String
import Util.Time import Util.Time
@ -29,6 +31,7 @@ type alias Model =
type Msg type Msg
= SetResults ItemLightList = SetResults ItemLightList
| AddResults ItemLightList
| SelectItem ItemLight | SelectItem ItemLight
@ -64,6 +67,28 @@ update _ msg model =
in in
( newModel, Cmd.none, Nothing ) ( newModel, Cmd.none, Nothing )
AddResults list ->
if list.groups == [] then
( model, Cmd.none, Nothing )
else
let
firstNew =
Data.Items.first list
scrollCmd =
case firstNew of
Just item ->
Ports.scrollToElem item.id
Nothing ->
Cmd.none
newModel =
{ model | results = Data.Items.concat model.results list }
in
( newModel, scrollCmd, Nothing )
SelectItem item -> SelectItem item ->
( model, Cmd.none, Just item ) ( model, Cmd.none, Just item )
@ -123,6 +148,7 @@ viewItem item =
[ ( "ui fluid card", True ) [ ( "ui fluid card", True )
, ( newColor, not isConfirmed ) , ( newColor, not isConfirmed )
] ]
, id item.id
, href "#" , href "#"
, onClick (SelectItem item) , onClick (SelectItem item)
] ]

View File

@ -0,0 +1,93 @@
module Comp.UiSettingsForm exposing
( Model
, Msg
, init
, initWith
, update
, view
)
import Comp.IntField
import Data.UiSettings exposing (StoredUiSettings, UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
type alias Model =
{ defaults : UiSettings
, input : StoredUiSettings
, searchPageSizeModel : Comp.IntField.Model
}
initWith : UiSettings -> Model
initWith defaults =
{ defaults = defaults
, input = Data.UiSettings.toStoredUiSettings defaults
, searchPageSizeModel =
Comp.IntField.init
(Just 10)
(Just 500)
False
"Item search page"
}
init : Model
init =
initWith Data.UiSettings.defaults
changeInput : (StoredUiSettings -> StoredUiSettings) -> Model -> StoredUiSettings
changeInput change model =
change model.input
type Msg
= SearchPageSizeMsg Comp.IntField.Msg
getSettings : Model -> UiSettings
getSettings model =
Data.UiSettings.merge model.input model.defaults
--- Update
update : Msg -> Model -> ( Model, Maybe UiSettings )
update msg model =
case msg of
SearchPageSizeMsg lm ->
let
( m, n ) =
Comp.IntField.update lm model.searchPageSizeModel
model_ =
{ model
| searchPageSizeModel = m
, input = changeInput (\s -> { s | itemSearchPageSize = n }) model
}
nextSettings =
Maybe.map (\_ -> getSettings model_) n
in
( model_, nextSettings )
--- View
view : Model -> Html Msg
view model =
div [ class "ui form" ]
[ Html.map SearchPageSizeMsg
(Comp.IntField.viewWithInfo
"Maximum results in one page when searching items."
model.input.itemSearchPageSize
""
model.searchPageSizeModel
)
]

View File

@ -0,0 +1,119 @@
module Comp.UiSettingsManage exposing
( Model
, Msg
, init
, update
, view
)
import Api.Model.BasicResult exposing (BasicResult)
import Comp.UiSettingsForm
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
import Html exposing (..)
import Html.Attributes exposing (..)
import Html.Events exposing (onClick)
import Ports
type alias Model =
{ formModel : Comp.UiSettingsForm.Model
, settings : Maybe UiSettings
, message : Maybe BasicResult
}
type Msg
= UiSettingsFormMsg Comp.UiSettingsForm.Msg
| Submit
| SettingsSaved
init : UiSettings -> Model
init defaults =
{ formModel = Comp.UiSettingsForm.initWith defaults
, settings = Nothing
, message = Nothing
}
--- update
update : Flags -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
update flags msg model =
case msg of
UiSettingsFormMsg lm ->
let
( m_, sett ) =
Comp.UiSettingsForm.update lm model.formModel
in
( { model
| formModel = m_
, settings = sett
, message = Nothing
}
, Cmd.none
, Sub.none
)
Submit ->
case model.settings of
Just s ->
( { model | message = Nothing }
, Ports.storeUiSettings flags s
, Ports.onUiSettingsSaved SettingsSaved
)
Nothing ->
( { model | message = Just (BasicResult False "Settings unchanged or invalid.") }
, Cmd.none
, Sub.none
)
SettingsSaved ->
( { model | message = Just (BasicResult True "Settings saved.") }
, Cmd.none
, Sub.none
)
--- View
isError : Model -> Bool
isError model =
Maybe.map .success model.message == Just False
isSuccess : Model -> Bool
isSuccess model =
Maybe.map .success model.message == Just True
view : String -> Model -> Html Msg
view classes model =
div [ class classes ]
[ Html.map UiSettingsFormMsg (Comp.UiSettingsForm.view model.formModel)
, div [ class "ui divider" ] []
, button
[ class "ui primary button"
, onClick Submit
]
[ text "Submit"
]
, div
[ classList
[ ( "ui message", True )
, ( "success", isSuccess model )
, ( "error", isError model )
, ( "hidden invisible", model.message == Nothing )
]
]
[ Maybe.map .message model.message
|> Maybe.withDefault ""
|> text
]
]

View File

@ -0,0 +1,67 @@
module Data.Items exposing
( concat
, first
, length
)
import Api.Model.ItemLight exposing (ItemLight)
import Api.Model.ItemLightGroup exposing (ItemLightGroup)
import Api.Model.ItemLightList exposing (ItemLightList)
import Util.List
concat : ItemLightList -> ItemLightList -> ItemLightList
concat l0 l1 =
let
lastOld =
lastGroup l0
firstNew =
List.head l1.groups
in
case ( lastOld, firstNew ) of
( Nothing, Nothing ) ->
l0
( Just _, Nothing ) ->
l0
( Nothing, Just _ ) ->
l1
( Just o, Just n ) ->
if o.name == n.name then
let
ng =
ItemLightGroup o.name (o.items ++ n.items)
prev =
Util.List.dropRight 1 l0.groups
suff =
List.drop 1 l1.groups
in
ItemLightList (prev ++ [ ng ] ++ suff)
else
ItemLightList (l0.groups ++ l1.groups)
first : ItemLightList -> Maybe ItemLight
first list =
List.head list.groups
|> Maybe.map .items
|> Maybe.withDefault []
|> List.head
length : ItemLightList -> Int
length list =
List.map (\g -> List.length g.items) list.groups
|> List.sum
lastGroup : ItemLightList -> Maybe ItemLightGroup
lastGroup list =
List.reverse list.groups
|> List.head

View File

@ -0,0 +1,63 @@
module Data.UiSettings exposing
( StoredUiSettings
, UiSettings
, defaults
, merge
, mergeDefaults
, toStoredUiSettings
)
{-| Settings for the web ui. All fields should be optional, since it
is loaded from local storage.
Making fields optional, allows it to evolve without breaking previous
versions. Also if a user is logged out, an empty object is send to
force default settings.
-}
type alias StoredUiSettings =
{ itemSearchPageSize : Maybe Int
}
{-| Settings for the web ui. These fields are all mandatory, since
there is always a default value.
When loaded from local storage, all optional fields can fallback to a
default value, converting the StoredUiSettings into a UiSettings.
-}
type alias UiSettings =
{ itemSearchPageSize : Int
}
defaults : UiSettings
defaults =
{ itemSearchPageSize = 90
}
merge : StoredUiSettings -> UiSettings -> UiSettings
merge given fallback =
{ itemSearchPageSize =
choose given.itemSearchPageSize fallback.itemSearchPageSize
}
mergeDefaults : StoredUiSettings -> UiSettings
mergeDefaults given =
merge given defaults
toStoredUiSettings : UiSettings -> StoredUiSettings
toStoredUiSettings settings =
{ itemSearchPageSize = Just settings.itemSearchPageSize
}
choose : Maybe a -> a -> a
choose m1 m2 =
Maybe.withDefault m2 m1

View File

@ -11,6 +11,7 @@ import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (..) import Html.Events exposing (..)
import Page import Page
import Ports
import Url exposing (Url) import Url exposing (Url)
@ -59,7 +60,12 @@ init flags url key =
Cmd.none Cmd.none
in in
( m ( m
, Cmd.batch [ cmd, Api.versionInfo flags VersionResp, sessionCheck ] , Cmd.batch
[ cmd
, Api.versionInfo flags VersionResp
, sessionCheck
, Ports.getUiSettings flags
]
) )
@ -76,4 +82,7 @@ viewDoc model =
subscriptions : Model -> Sub Msg subscriptions : Model -> Sub Msg
subscriptions model = subscriptions model =
model.subs Sub.batch
[ model.subs
, Ports.loadUiSettings GetUiSettings
]

View File

@ -2,13 +2,19 @@ module Page.Home.Data exposing
( Model ( Model
, Msg(..) , Msg(..)
, ViewMode(..) , ViewMode(..)
, emptyModel , doSearchCmd
, init
, itemNav , itemNav
, resultsBelowLimit
) )
import Api
import Api.Model.ItemLightList exposing (ItemLightList) import Api.Model.ItemLightList exposing (ItemLightList)
import Comp.ItemCardList import Comp.ItemCardList
import Comp.SearchMenu import Comp.SearchMenu
import Data.Flags exposing (Flags)
import Data.Items
import Data.UiSettings exposing (UiSettings)
import Http import Http
@ -18,16 +24,24 @@ type alias Model =
, searchInProgress : Bool , searchInProgress : Bool
, viewMode : ViewMode , viewMode : ViewMode
, menuCollapsed : Bool , menuCollapsed : Bool
, searchOffset : Int
, moreAvailable : Bool
, moreInProgress : Bool
, uiSettings : UiSettings
} }
emptyModel : Model init : Flags -> Model
emptyModel = init _ =
{ searchMenuModel = Comp.SearchMenu.emptyModel { searchMenuModel = Comp.SearchMenu.emptyModel
, itemListModel = Comp.ItemCardList.init , itemListModel = Comp.ItemCardList.init
, searchInProgress = False , searchInProgress = False
, viewMode = Listing , viewMode = Listing
, menuCollapsed = False , menuCollapsed = False
, searchOffset = 0
, moreAvailable = True
, moreInProgress = False
, uiSettings = Data.UiSettings.defaults
} }
@ -37,8 +51,11 @@ type Msg
| ResetSearch | ResetSearch
| ItemCardListMsg Comp.ItemCardList.Msg | ItemCardListMsg Comp.ItemCardList.Msg
| ItemSearchResp (Result Http.Error ItemLightList) | ItemSearchResp (Result Http.Error ItemLightList)
| ItemSearchAddResp (Result Http.Error ItemLightList)
| DoSearch | DoSearch
| ToggleSearchMenu | ToggleSearchMenu
| LoadMore
| GetUiSettings UiSettings
type ViewMode type ViewMode
@ -58,3 +75,31 @@ itemNav id model =
{ prev = Maybe.map .id prev { prev = Maybe.map .id prev
, next = Maybe.map .id next , next = Maybe.map .id next
} }
doSearchCmd : Flags -> Int -> Model -> Cmd Msg
doSearchCmd flags offset model =
let
smask =
Comp.SearchMenu.getItemSearch model.searchMenuModel
mask =
{ smask
| limit = model.uiSettings.itemSearchPageSize
, offset = offset
}
in
if offset == 0 then
Api.itemSearch flags mask ItemSearchResp
else
Api.itemSearch flags mask ItemSearchAddResp
resultsBelowLimit : Model -> Bool
resultsBelowLimit model =
let
len =
Data.Items.length model.itemListModel.results
in
len < model.uiSettings.itemSearchPageSize

View File

@ -1,6 +1,5 @@
module Page.Home.Update exposing (update) module Page.Home.Update exposing (update)
import Api
import Browser.Navigation as Nav import Browser.Navigation as Nav
import Comp.ItemCardList import Comp.ItemCardList
import Comp.SearchMenu import Comp.SearchMenu
@ -16,12 +15,15 @@ update key flags msg model =
Init -> Init ->
Util.Update.andThen1 Util.Update.andThen1
[ update key flags (SearchMenuMsg Comp.SearchMenu.Init) [ update key flags (SearchMenuMsg Comp.SearchMenu.Init)
, doSearch flags
] ]
model model
ResetSearch -> ResetSearch ->
update key flags (SearchMenuMsg Comp.SearchMenu.ResetForm) model let
nm =
{ model | searchOffset = 0 }
in
update key flags (SearchMenuMsg Comp.SearchMenu.ResetForm) nm
SearchMenuMsg m -> SearchMenuMsg m ->
let let
@ -53,33 +55,103 @@ update key flags msg model =
Nothing -> Nothing ->
Cmd.none Cmd.none
in in
( { model | itemListModel = m2 }, 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
noff =
model.uiSettings.itemSearchPageSize
m = m =
{ model | searchInProgress = False, viewMode = Listing } { model
| searchInProgress = False
, searchOffset = noff
, viewMode = Listing
, moreAvailable = list.groups /= []
}
in in
update key flags (ItemCardListMsg (Comp.ItemCardList.SetResults list)) m update key flags (ItemCardListMsg (Comp.ItemCardList.SetResults list)) m
ItemSearchAddResp (Ok list) ->
let
noff =
model.searchOffset + model.uiSettings.itemSearchPageSize
m =
{ model
| searchInProgress = False
, moreInProgress = False
, searchOffset = noff
, viewMode = Listing
, moreAvailable = list.groups /= []
}
in
update key flags (ItemCardListMsg (Comp.ItemCardList.AddResults list)) m
ItemSearchAddResp (Err _) ->
( { model
| moreInProgress = False
}
, Cmd.none
)
ItemSearchResp (Err _) -> ItemSearchResp (Err _) ->
( { model | searchInProgress = False }, Cmd.none ) ( { model
| searchInProgress = False
}
, Cmd.none
)
DoSearch -> DoSearch ->
doSearch flags model let
nm =
{ model | searchOffset = 0 }
in
doSearch flags nm
ToggleSearchMenu -> ToggleSearchMenu ->
( { model | menuCollapsed = not model.menuCollapsed } ( { model | menuCollapsed = not model.menuCollapsed }
, Cmd.none , Cmd.none
) )
LoadMore ->
if model.moreAvailable then
doSearchMore flags model
else
( model, Cmd.none )
GetUiSettings settings ->
let
m_ =
{ model | uiSettings = settings }
in
doSearch flags m_
doSearch : Flags -> Model -> ( Model, Cmd Msg ) doSearch : Flags -> Model -> ( Model, Cmd Msg )
doSearch flags model = doSearch flags model =
let let
mask = cmd =
Comp.SearchMenu.getItemSearch model.searchMenuModel doSearchCmd flags 0 model
in in
( { model | searchInProgress = True, viewMode = Listing } ( { model
, Api.itemSearch flags mask ItemSearchResp | searchInProgress = True
, viewMode = Listing
, searchOffset = 0
}
, cmd
)
doSearchMore : Flags -> Model -> ( Model, Cmd Msg )
doSearchMore flags model =
let
cmd =
doSearchCmd flags model.searchOffset model
in
( { model | moreInProgress = True, viewMode = Listing }
, cmd
) )

View File

@ -61,6 +61,7 @@ view model =
, not model.menuCollapsed , not model.menuCollapsed
) )
, ( "sixteen wide column", model.menuCollapsed ) , ( "sixteen wide column", model.menuCollapsed )
, ( "item-card-list", True )
] ]
] ]
[ div [ div
@ -90,6 +91,36 @@ view model =
Detail -> Detail ->
div [] [] div [] []
] ]
, div
[ classList
[ ( "sixteen wide column", True )
]
]
[ div [ class "ui basic center aligned segment" ]
[ button
[ classList
[ ( "ui basic tiny button", True )
, ( "disabled", not model.moreAvailable )
, ( "hidden invisible", resultsBelowLimit model )
]
, disabled (not model.moreAvailable || model.moreInProgress || model.searchInProgress)
, title "Load more items"
, href "#"
, onClick LoadMore
]
[ if model.moreInProgress then
i [ class "loading spinner icon" ] []
else
i [ class "angle double down icon" ] []
, if model.moreAvailable then
text "Load more"
else
text "That's all"
]
]
]
] ]

View File

@ -10,7 +10,9 @@ import Comp.EmailSettingsManage
import Comp.ImapSettingsManage import Comp.ImapSettingsManage
import Comp.NotificationForm import Comp.NotificationForm
import Comp.ScanMailboxManage import Comp.ScanMailboxManage
import Comp.UiSettingsManage
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
import Data.UiSettings exposing (UiSettings)
type alias Model = type alias Model =
@ -20,6 +22,7 @@ type alias Model =
, imapSettingsModel : Comp.ImapSettingsManage.Model , imapSettingsModel : Comp.ImapSettingsManage.Model
, notificationModel : Comp.NotificationForm.Model , notificationModel : Comp.NotificationForm.Model
, scanMailboxModel : Comp.ScanMailboxManage.Model , scanMailboxModel : Comp.ScanMailboxManage.Model
, uiSettingsModel : Comp.UiSettingsManage.Model
} }
@ -31,6 +34,7 @@ emptyModel flags =
, imapSettingsModel = Comp.ImapSettingsManage.emptyModel , imapSettingsModel = Comp.ImapSettingsManage.emptyModel
, notificationModel = Tuple.first (Comp.NotificationForm.init flags) , notificationModel = Tuple.first (Comp.NotificationForm.init flags)
, scanMailboxModel = Tuple.first (Comp.ScanMailboxManage.init flags) , scanMailboxModel = Tuple.first (Comp.ScanMailboxManage.init flags)
, uiSettingsModel = Comp.UiSettingsManage.init Data.UiSettings.defaults
} }
@ -40,6 +44,7 @@ type Tab
| ImapSettingsTab | ImapSettingsTab
| NotificationTab | NotificationTab
| ScanMailboxTab | ScanMailboxTab
| UiSettingsTab
type Msg type Msg
@ -49,3 +54,5 @@ type Msg
| NotificationMsg Comp.NotificationForm.Msg | NotificationMsg Comp.NotificationForm.Msg
| ImapSettingsMsg Comp.ImapSettingsManage.Msg | ImapSettingsMsg Comp.ImapSettingsManage.Msg
| ScanMailboxMsg Comp.ScanMailboxManage.Msg | ScanMailboxMsg Comp.ScanMailboxManage.Msg
| GetUiSettings UiSettings
| UiSettingsMsg Comp.UiSettingsManage.Msg

View File

@ -5,75 +5,76 @@ import Comp.EmailSettingsManage
import Comp.ImapSettingsManage import Comp.ImapSettingsManage
import Comp.NotificationForm import Comp.NotificationForm
import Comp.ScanMailboxManage import Comp.ScanMailboxManage
import Comp.UiSettingsManage
import Data.Flags exposing (Flags) import Data.Flags exposing (Flags)
import Page.UserSettings.Data exposing (..) import Page.UserSettings.Data exposing (..)
update : Flags -> Msg -> Model -> ( Model, Cmd Msg ) update : Flags -> Msg -> Model -> ( Model, Cmd Msg, Sub Msg )
update flags msg model = update flags msg model =
case msg of case msg of
SetTab t -> SetTab t ->
let let
m = m =
{ model | currentTab = Just t } { model | currentTab = Just t }
( m2, cmd ) =
case t of
EmailSettingsTab ->
let
( em, c ) =
Comp.EmailSettingsManage.init flags
in
( { m | emailSettingsModel = em }, Cmd.map EmailSettingsMsg c )
ImapSettingsTab ->
let
( em, c ) =
Comp.ImapSettingsManage.init flags
in
( { m | imapSettingsModel = em }, Cmd.map ImapSettingsMsg c )
ChangePassTab ->
( m, Cmd.none )
NotificationTab ->
let
initCmd =
Cmd.map NotificationMsg
(Tuple.second (Comp.NotificationForm.init flags))
in
( m, initCmd )
ScanMailboxTab ->
let
initCmd =
Cmd.map ScanMailboxMsg
(Tuple.second (Comp.ScanMailboxManage.init flags))
in
( m, initCmd )
in in
( m2, cmd ) case t of
EmailSettingsTab ->
let
( em, c ) =
Comp.EmailSettingsManage.init flags
in
( { m | emailSettingsModel = em }, Cmd.map EmailSettingsMsg c, Sub.none )
ImapSettingsTab ->
let
( em, c ) =
Comp.ImapSettingsManage.init flags
in
( { m | imapSettingsModel = em }, Cmd.map ImapSettingsMsg c, Sub.none )
ChangePassTab ->
( m, Cmd.none, Sub.none )
NotificationTab ->
let
initCmd =
Cmd.map NotificationMsg
(Tuple.second (Comp.NotificationForm.init flags))
in
( m, initCmd, Sub.none )
ScanMailboxTab ->
let
initCmd =
Cmd.map ScanMailboxMsg
(Tuple.second (Comp.ScanMailboxManage.init flags))
in
( m, initCmd, Sub.none )
UiSettingsTab ->
( m, Cmd.none, Sub.none )
ChangePassMsg m -> ChangePassMsg m ->
let let
( m2, c2 ) = ( m2, c2 ) =
Comp.ChangePasswordForm.update flags m model.changePassModel Comp.ChangePasswordForm.update flags m model.changePassModel
in in
( { model | changePassModel = m2 }, Cmd.map ChangePassMsg c2 ) ( { model | changePassModel = m2 }, Cmd.map ChangePassMsg c2, Sub.none )
EmailSettingsMsg m -> EmailSettingsMsg m ->
let let
( m2, c2 ) = ( m2, c2 ) =
Comp.EmailSettingsManage.update flags m model.emailSettingsModel Comp.EmailSettingsManage.update flags m model.emailSettingsModel
in in
( { model | emailSettingsModel = m2 }, Cmd.map EmailSettingsMsg c2 ) ( { model | emailSettingsModel = m2 }, Cmd.map EmailSettingsMsg c2, Sub.none )
ImapSettingsMsg m -> ImapSettingsMsg m ->
let let
( m2, c2 ) = ( m2, c2 ) =
Comp.ImapSettingsManage.update flags m model.imapSettingsModel Comp.ImapSettingsManage.update flags m model.imapSettingsModel
in in
( { model | imapSettingsModel = m2 }, Cmd.map ImapSettingsMsg c2 ) ( { model | imapSettingsModel = m2 }, Cmd.map ImapSettingsMsg c2, Sub.none )
NotificationMsg lm -> NotificationMsg lm ->
let let
@ -82,6 +83,7 @@ update flags msg model =
in in
( { model | notificationModel = m2 } ( { model | notificationModel = m2 }
, Cmd.map NotificationMsg c2 , Cmd.map NotificationMsg c2
, Sub.none
) )
ScanMailboxMsg lm -> ScanMailboxMsg lm ->
@ -91,4 +93,21 @@ update flags msg model =
in in
( { model | scanMailboxModel = m2 } ( { model | scanMailboxModel = m2 }
, Cmd.map ScanMailboxMsg c2 , Cmd.map ScanMailboxMsg c2
, Sub.none
)
GetUiSettings settings ->
( { model | uiSettingsModel = Comp.UiSettingsManage.init settings }
, Cmd.none
, Sub.none
)
UiSettingsMsg lm ->
let
( m2, c2, s2 ) =
Comp.UiSettingsManage.update flags lm model.uiSettingsModel
in
( { model | uiSettingsModel = m2 }
, Cmd.map UiSettingsMsg c2
, Sub.map UiSettingsMsg s2
) )

View File

@ -5,6 +5,7 @@ import Comp.EmailSettingsManage
import Comp.ImapSettingsManage import Comp.ImapSettingsManage
import Comp.NotificationForm import Comp.NotificationForm
import Comp.ScanMailboxManage import Comp.ScanMailboxManage
import Comp.UiSettingsManage
import Html exposing (..) import Html exposing (..)
import Html.Attributes exposing (..) import Html.Attributes exposing (..)
import Html.Events exposing (onClick) import Html.Events exposing (onClick)
@ -26,6 +27,7 @@ view model =
, makeTab model ImapSettingsTab "E-Mail Settings (IMAP)" "mail icon" , makeTab model ImapSettingsTab "E-Mail Settings (IMAP)" "mail icon"
, makeTab model NotificationTab "Notification Task" "bullhorn icon" , makeTab model NotificationTab "Notification Task" "bullhorn icon"
, makeTab model ScanMailboxTab "Scan Mailbox Task" "envelope open outline icon" , makeTab model ScanMailboxTab "Scan Mailbox Task" "envelope open outline icon"
, makeTab model UiSettingsTab "UI Settings" "cog icon"
] ]
] ]
] ]
@ -47,6 +49,9 @@ view model =
Just ScanMailboxTab -> Just ScanMailboxTab ->
viewScanMailboxManage model viewScanMailboxManage model
Just UiSettingsTab ->
viewUiSettings model
Nothing -> Nothing ->
[] []
) )
@ -66,6 +71,20 @@ makeTab model tab header icon =
] ]
viewUiSettings : Model -> List (Html Msg)
viewUiSettings model =
[ h2 [ class "ui header" ]
[ i [ class "cog icon" ] []
, text "UI Settings"
]
, p []
[ text "These settings only affect the web ui. They are stored in the browser, "
, text "so they are separated between browsers and devices."
]
, Html.map UiSettingsMsg (Comp.UiSettingsManage.view "ui segment" model.uiSettingsModel)
]
viewEmailSettings : Model -> List (Html Msg) viewEmailSettings : Model -> List (Html Msg)
viewEmailSettings model = viewEmailSettings model =
[ h2 [ class "ui header" ] [ h2 [ class "ui header" ]

View File

@ -1,13 +1,22 @@
port module Ports exposing port module Ports exposing
( removeAccount ( getUiSettings
, loadUiSettings
, onUiSettingsSaved
, removeAccount
, scrollToElem
, setAccount , setAccount
, setAllProgress , setAllProgress
, setProgress , setProgress
, storeUiSettings
) )
import Api.Model.AuthResult exposing (AuthResult) import Api.Model.AuthResult exposing (AuthResult)
import Data.Flags exposing (Flags)
import Data.UiSettings exposing (StoredUiSettings, UiSettings)
{-| Save the result of authentication to local storage.
-}
port setAccount : AuthResult -> Cmd msg port setAccount : AuthResult -> Cmd msg
@ -18,3 +27,48 @@ port setProgress : ( String, Int ) -> Cmd msg
port setAllProgress : ( String, Int ) -> Cmd msg port setAllProgress : ( String, Int ) -> Cmd msg
port scrollToElem : String -> Cmd msg
port saveUiSettings : ( AuthResult, UiSettings ) -> Cmd msg
port receiveUiSettings : (StoredUiSettings -> msg) -> Sub msg
port requestUiSettings : ( AuthResult, UiSettings ) -> Cmd msg
port uiSettingsSaved : (() -> msg) -> Sub msg
onUiSettingsSaved : msg -> Sub msg
onUiSettingsSaved m =
uiSettingsSaved (\_ -> m)
storeUiSettings : Flags -> UiSettings -> Cmd msg
storeUiSettings flags settings =
case flags.account of
Just ar ->
saveUiSettings ( ar, settings )
Nothing ->
Cmd.none
loadUiSettings : (UiSettings -> msg) -> Sub msg
loadUiSettings tagger =
receiveUiSettings (Data.UiSettings.mergeDefaults >> tagger)
getUiSettings : Flags -> Cmd msg
getUiSettings flags =
case flags.account of
Just ar ->
requestUiSettings ( ar, Data.UiSettings.defaults )
Nothing ->
Cmd.none

View File

@ -1,5 +1,6 @@
module Util.List exposing module Util.List exposing
( distinct ( distinct
, dropRight
, find , find
, findIndexed , findIndexed
, findNext , findNext
@ -80,3 +81,10 @@ findNext pred list =
|> Maybe.map Tuple.second |> Maybe.map Tuple.second
|> Maybe.map (\i -> i + 1) |> Maybe.map (\i -> i + 1)
|> Maybe.andThen (get list) |> Maybe.andThen (get list)
dropRight : Int -> List a -> List a
dropRight n list =
List.reverse list
|> List.drop n
|> List.reverse

View File

@ -5,6 +5,7 @@ var elmApp = Elm.Main.init({
flags: elmFlags flags: elmFlags
}); });
elmApp.ports.setAccount.subscribe(function(authResult) { elmApp.ports.setAccount.subscribe(function(authResult) {
console.log("Add account from local storage"); console.log("Add account from local storage");
localStorage.setItem("account", JSON.stringify(authResult)); localStorage.setItem("account", JSON.stringify(authResult));
@ -30,3 +31,55 @@ elmApp.ports.setAllProgress.subscribe(function(input) {
$("."+id).progress({percent: percent}); $("."+id).progress({percent: percent});
}, 100); }, 100);
}); });
elmApp.ports.scrollToElem.subscribe(function(id) {
if (id && id != "") {
window.setTimeout(function() {
var el = document.getElementById(id);
if (el) {
if (el["scrollIntoViewIfNeeded"]) {
el.scrollIntoViewIfNeeded();
} else {
el.scrollIntoView();
}
}
}, 20);
}
});
elmApp.ports.saveUiSettings.subscribe(function(args) {
if (Array.isArray(args) && args.length == 2) {
var authResult = args[0];
var settings = args[1];
if (authResult && settings) {
var key = authResult.collective + "/" + authResult.user + "/uiSettings";
console.log("Save ui settings to local storage");
localStorage.setItem(key, JSON.stringify(settings));
elmApp.ports.receiveUiSettings.send(settings);
elmApp.ports.uiSettingsSaved.send(null);
}
}
});
elmApp.ports.requestUiSettings.subscribe(function(args) {
console.log("Requesting ui settings");
if (Array.isArray(args) && args.length == 2) {
var account = args[0];
var defaults = args[1];
var collective = account ? account.collective : null;
var user = account ? account.user : null;
if (collective && user) {
var key = collective + "/" + user + "/uiSettings";
var settings = localStorage.getItem(key);
var data = settings ? JSON.parse(settings) : null;
if (data && defaults) {
$.extend(defaults, data);
elmApp.ports.receiveUiSettings.send(defaults);
} else if (defaults) {
elmApp.ports.receiveUiSettings.send(defaults);
}
} else if (defaults) {
elmApp.ports.receiveUiSettings.send(defaults);
}
}
});