diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index e46bde230..f88277d09 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -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 diff --git a/src/Handler/LMS.hs b/src/Handler/LMS.hs index b01715841..e9d4cac9c 100644 --- a/src/Handler/LMS.hs +++ b/src/Handler/LMS.hs @@ -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) diff --git a/src/Handler/Qualification.hs b/src/Handler/Qualification.hs index 5dcd6fe1a..6ebd89034 100644 --- a/src/Handler/Qualification.hs +++ b/src/Handler/Qualification.hs @@ -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) diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index ff687b2bf..9b5a6a2e8 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -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