chore(lms): set default sorting for lms tables by desc date with nulls last

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

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 = dbtProjId
-    -- 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)
 
     dbtColonnade = cols
     dbtSorting = mconcat
       [ single $ sortUserNameLink queryUser
       , single $ sortUserEmail    queryUser      
-      , single ("valid-until"   , SortColumn $ queryQualUser >>> (E.^. QualificationUserValidUntil))
+      , single ("valid-until"   , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserValidUntil))
-      , single ("last-refresh"  , SortColumn $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
+      , single ("last-refresh"  , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserLastRefresh))
-      , single ("first-held"    , SortColumn $ queryQualUser >>> (E.^. QualificationUserFirstHeld))
+      , single ("first-held"    , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserFirstHeld))
-      , single ("blocked-due"   , SortColumn $ queryQualUser >>> (E.^. QualificationUserBlockedDue))
+      , single ("blocked-due"   , SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserBlockedDue))
-      , single ("schedule-renew", SortColumn $ queryQualUser >>> (E.^. QualificationUserScheduleRenewal))      
+      , single ("schedule-renew", SortColumnNullsInv $ queryQualUser >>> (E.^. QualificationUserScheduleRenewal))      
-      , single ("lms-ident"     , SortColumn $ queryLmsUser  >>> (E.?. LmsUserIdent))
+      , single ("lms-ident"     , SortColumnNullsInv $ queryLmsUser  >>> (E.?. LmsUserIdent))
-      , single ("lms-pin"       , SortColumn $ queryLmsUser  >>> (E.?. LmsUserPin))
+      , single ("lms-pin"       , SortColumnNullsInv $ queryLmsUser  >>> (E.?. LmsUserPin))
-      , single ("lms-status"    , SortColumn $ views (to queryLmsUser) (E.?. LmsUserStatus))
+      , single ("lms-status"    , SortColumnNullsInv $ views (to queryLmsUser) (E.?. LmsUserStatus))
-      , single ("lms-started"   , SortColumn $ queryLmsUser  >>> (E.?. LmsUserStarted))
+      , single ("lms-started"   , SortColumnNullsInv $ queryLmsUser  >>> (E.?. LmsUserStarted))
-      , single ("lms-datepin"   , SortColumn $ queryLmsUser  >>> (E.?. LmsUserDatePin))
+      , single ("lms-datepin"   , SortColumnNullsInv $ queryLmsUser  >>> (E.?. LmsUserDatePin))
-      , single ("lms-received"  , SortColumn $ queryLmsUser  >>> (E.?. LmsUserReceived))
+      , single ("lms-received"  , SortColumnNullsInv $ queryLmsUser  >>> (E.?. LmsUserReceived))
-      , single ("lms-notified"  , SortColumn $ queryLmsUser  >>> (E.?. LmsUserNotified)) -- cannot include printJob acknowledge date
+      , single ("lms-notified"  , SortColumnNullsInv $ queryLmsUser  >>> (E.?. LmsUserNotified)) -- cannot include printJob acknowledge date
-      , single ("lms-ended"     , SortColumn $ queryLmsUser  >>> (E.?. LmsUserEnded))
+      , 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)
 

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)
   

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