chore(lms): set default sorting for lms tables by desc date with nulls last
This commit is contained in:
Steffen Jost
parent
caf30801df
commit
fd2931be95
@ -21,6 +21,7 @@ module Database.Esqueleto.Utils
|
||||
, mkDayFilter, mkDayFilterFrom, mkDayFilterTo
|
||||
, mkExistsFilter
|
||||
, anyFilter, allFilter
|
||||
, ascNullsFirst, descNullsLast
|
||||
, orderByList
|
||||
, orderByOrd, orderByEnum
|
||||
, strip, lower, ciEq
|
||||
@ -330,6 +331,13 @@ allFilter fltrs needle criterias = F.foldr aux true fltrs
|
||||
where
|
||||
aux fltr acc = fltr needle criterias E.&&. acc
|
||||
|
||||
-- | Descending order of this field or SqlExpression, but with NULLS at the end.
|
||||
ascNullsFirst :: PersistField a => E.SqlExpr (E.Value a) -> E.SqlExpr E.OrderBy
|
||||
ascNullsFirst = E.orderByExpr " ASC NULLS FIRST"
|
||||
|
||||
descNullsLast :: PersistField a => E.SqlExpr (E.Value a) -> E.SqlExpr E.OrderBy
|
||||
descNullsLast = E.orderByExpr " DESC NULLS LAST"
|
||||
|
||||
|
||||
orderByList :: PersistField a => [a] -> E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value Int)
|
||||
orderByList valus
|
||||
|
||||
@ -351,14 +351,6 @@ lmsTableQuery qid (qualUser `E.InnerJoin` user `E.LeftOuterJoin` lmsUser) = do
|
||||
return (qualUser, user, lmsUser, printAcknowledged)
|
||||
|
||||
|
||||
newtype LmsTableFilterProj = LmsTableFilterProj { ltProjFilterMayAccess :: Maybe Bool }
|
||||
|
||||
instance Default LmsTableFilterProj where
|
||||
def = LmsTableFilterProj
|
||||
{ ltProjFilterMayAccess = Nothing }
|
||||
|
||||
makeLenses_ ''LmsTableFilterProj
|
||||
|
||||
mkLmsTable :: forall h p cols act act'.
|
||||
( Functor h, ToSortable h
|
||||
, Ord act, PathPiece act, RenderMessage UniWorX act
|
||||
@ -382,39 +374,29 @@ mkLmsTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
dbtIdent = "qualification"
|
||||
dbtSQLQuery q = lmsTableQuery qid q
|
||||
dbtRowKey = queryUser >>> (E.^. UserId)
|
||||
dbtProj = dbtProjFilteredPostId
|
||||
-- dbtProj = (views _dbtProjRow . set _dbrOutput) =<< do
|
||||
-- qusr <- view $ _dbtProjRow . resultQualUser
|
||||
-- user <- view $ _dbtProjRow . resultUser
|
||||
-- lusr <- preview $ _dbtProjRow . resultLmsUser
|
||||
-- pjac <- preview $ _dbtProjRow . resultPrintAck
|
||||
-- forMM_ (view $ _dbtProjFilter . _ltProjFilterMayAccess) $ \b -> do
|
||||
-- euid <- encrypt $ user ^. _entityKey
|
||||
-- guardM . lift . lift . fmap (== b) . hasReadAccessTo . urlRoute $ ForProfileDataR euid -- TODO create a page with proper rights; this is only for admins!
|
||||
-- return (qusr,user,lusr,E.Value pjac)
|
||||
dbtProj = dbtProjId
|
||||
|
||||
dbtColonnade = cols
|
||||
dbtSorting = mconcat
|
||||
[ single $ sortUserNameLink queryUser
|
||||
, single $ sortUserEmail queryUser
|
||||
, single ("valid-until" , SortColumn $ queryQualUser >>> (E.^. QualificationUserValidUntil))
|
||||
, single ("last-refresh" , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
|
||||
, single ("first-held" , SortColumn $ queryQualUser >>> (E.^. QualificationUserFirstHeld))
|
||||
, single ("blocked-due" , SortColumn $ queryQualUser >>> (E.^. QualificationUserBlockedDue))
|
||||
, single ("schedule-renew", SortColumn $ queryQualUser >>> (E.^. QualificationUserScheduleRenewal))
|
||||
, single ("lms-ident" , SortColumn $ queryLmsUser >>> (E.?. LmsUserIdent))
|
||||
, single ("lms-pin" , SortColumn $ queryLmsUser >>> (E.?. LmsUserPin))
|
||||
, single ("lms-status" , SortColumn $ views (to queryLmsUser) (E.?. LmsUserStatus))
|
||||
, single ("lms-started" , SortColumn $ queryLmsUser >>> (E.?. LmsUserStarted))
|
||||
, single ("lms-datepin" , SortColumn $ queryLmsUser >>> (E.?. LmsUserDatePin))
|
||||
, single ("lms-received" , SortColumn $ queryLmsUser >>> (E.?. LmsUserReceived))
|
||||
, single ("lms-notified" , SortColumn $ queryLmsUser >>> (E.?. LmsUserNotified)) -- cannot include printJob acknowledge date
|
||||
, single ("lms-ended" , SortColumn $ queryLmsUser >>> (E.?. LmsUserEnded))
|
||||
, single ("valid-until" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserValidUntil))
|
||||
, single ("last-refresh" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
|
||||
, single ("first-held" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserFirstHeld))
|
||||
, single ("blocked-due" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserBlockedDue))
|
||||
, single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserScheduleRenewal))
|
||||
, single ("lms-ident" , SortColumnNullsInv $ queryLmsUser >>> (E.?. LmsUserIdent))
|
||||
, single ("lms-pin" , SortColumnNullsInv $ queryLmsUser >>> (E.?. LmsUserPin))
|
||||
, single ("lms-status" , SortColumnNullsInv $ views (to queryLmsUser) (E.?. LmsUserStatus))
|
||||
, single ("lms-started" , SortColumnNullsInv $ queryLmsUser >>> (E.?. LmsUserStarted))
|
||||
, single ("lms-datepin" , SortColumnNullsInv $ queryLmsUser >>> (E.?. LmsUserDatePin))
|
||||
, single ("lms-received" , SortColumnNullsInv $ queryLmsUser >>> (E.?. LmsUserReceived))
|
||||
, single ("lms-notified" , SortColumnNullsInv $ queryLmsUser >>> (E.?. LmsUserNotified)) -- cannot include printJob acknowledge date
|
||||
, single ("lms-ended" , SortColumnNullsInv $ queryLmsUser >>> (E.?. LmsUserEnded))
|
||||
|
||||
]
|
||||
dbtFilter = mconcat
|
||||
[ --single ("may-access" , FilterProjected $ (_ltProjFilterMayAccess ?~) . getAny)
|
||||
single $ fltrUserNameEmail queryUser
|
||||
[ single $ fltrUserNameEmail queryUser
|
||||
, single ("lms-ident" , FilterColumn . E.mkContainsFilterWith (Just . LmsIdent) $ views (to queryLmsUser) (E.?. LmsUserIdent))
|
||||
-- , single ("lms-status" , FilterColumn . E.mkExactFilterLast $ views (to queryLmsUser) ((E.>=. E.val nowaday) . (E.^. LmsUserStatus))) -- LmsStatus cannot be filtered easily within the DB
|
||||
-- , single ("validity" , FilterColumn . E.mkExactFilterLast $ views (to queryQualUser) ((E.>=. E.val nowaday) . (E.^. QualificationUserValidUntil)))
|
||||
@ -591,7 +573,7 @@ postLmsR sid qsh = do
|
||||
where
|
||||
-- i18nLms :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a
|
||||
i18nLms msg = cell [whamlet|LMS #|] <> i18nCell msg
|
||||
psValidator = def -- & forceFilter "may-access" (Any True)
|
||||
psValidator = def & defaultSorting [SortDescBy "lms-started", SortDescBy "lms-status"]
|
||||
tbl <- mkLmsTable isAdmin qent acts colChoices psValidator
|
||||
return (tbl, qent)
|
||||
|
||||
|
||||
@ -288,14 +288,14 @@ mkQualificationTable isAdmin (Entity qid quali) acts cols psValidator = do
|
||||
fltrSvs = if isAdmin then const E.true else \quser -> quser E.^. QualificationUserUser `Ex.in_` E.vals svs
|
||||
dbtSQLQuery q = qualificationTableQuery qid fltrSvs q
|
||||
dbtRowKey = queryUser >>> (E.^. UserId)
|
||||
dbtProj = dbtProjFilteredPostId
|
||||
dbtProj = dbtProjId -- FilteredPostId
|
||||
dbtColonnade = cols
|
||||
dbtSorting = mconcat
|
||||
[ single $ sortUserNameLink queryUser
|
||||
, single $ sortUserEmail queryUser
|
||||
, single ("valid-until" , SortColumn $ queryQualUser >>> (E.^. QualificationUserValidUntil))
|
||||
, single ("last-refresh" , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
|
||||
, single ("blocked-due" , SortColumn $ queryQualUser >>> (E.^. QualificationUserBlockedDue))
|
||||
, single ("blocked-due" , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserBlockedDue))
|
||||
-- , single ("lms-started" , SortColumn $ queryLmsUser >>> (E.?. LmsUserStarted))
|
||||
-- , single ("lms-status" , SortColumn $ views (to queryLmsUser) (E.?. LmsUserStatus))
|
||||
, single ("lms-status-plus",SortColumn $ \row -> E.coalesce [E.explicitUnsafeCoerceSqlExprValue "timestamp" $ (queryLmsUser row E.?. LmsUserStatus) E.#>>. "{day}"
|
||||
@ -404,7 +404,7 @@ postQualificationR sid qsh = do
|
||||
, sortable (Just "lms-status-plus")(i18nCell MsgTableLmsStatus & cellTooltip (MsgTableLmsStatusTooltip auditMonths))
|
||||
$ \(preview $ resultLmsUser . _entityVal -> lu) -> foldMap lmsStatusPlusCell lu
|
||||
]
|
||||
psValidator = def
|
||||
psValidator = def & defaultSorting [SortDescBy "blocked-due", SortDescBy "valid-until"]
|
||||
tbl <- mkQualificationTable isAdmin qent acts colChoices psValidator
|
||||
return (tbl, qent)
|
||||
|
||||
|
||||
@ -161,7 +161,8 @@ dbFilterKey ident = toPathPiece . WithIdent ident
|
||||
|
||||
data SomeExprValue = forall a. PersistField a => SomeExprValue { getSomeExprValue :: E.SqlExpr (E.Value a) }
|
||||
|
||||
data SortColumn t r' = forall a. PersistField a => SortColumn { getSortColumn :: t -> E.SqlExpr (E.Value a) }
|
||||
data SortColumn t r' = forall a. PersistField a => SortColumn { getSortColumn :: t -> E.SqlExpr (E.Value a) }
|
||||
| forall a. PersistField a => SortColumnNullsInv { getSortColumn :: t -> E.SqlExpr (E.Value a) }
|
||||
| SortColumns { getSortColumns :: t -> [SomeExprValue] }
|
||||
| SortProjected { sortProjected :: r' -> r' -> Ordering }
|
||||
|
||||
@ -178,6 +179,9 @@ sqlSortDirection :: SortColumn t r' -> Maybe (SortDirection -> t -> [E.SqlExpr E
|
||||
sqlSortDirection (SortColumn e ) = Just $ \case
|
||||
SortAsc -> pure . E.asc . e
|
||||
SortDesc -> pure . E.desc . e
|
||||
sqlSortDirection (SortColumnNullsInv e ) = Just $ \case
|
||||
SortAsc -> pure . E.ascNullsFirst . e
|
||||
SortDesc -> pure . E.descNullsLast . e
|
||||
sqlSortDirection (SortColumns es) = Just $ \case
|
||||
SortAsc -> fmap (\(SomeExprValue v) -> E.asc v) . es
|
||||
SortDesc -> fmap (\(SomeExprValue v) -> E.desc v) . es
|
||||
|
||||
Loading…
Reference in New Issue
Block a user