diff --git a/frontend/src/app.sass b/frontend/src/app.sass index 381533131..c1f05706c 100644 --- a/frontend/src/app.sass +++ b/frontend/src/app.sass @@ -1182,7 +1182,7 @@ a.breadcrumbs__home font-size: 14px font-family: monospace -.func-field__wrapper, .allocation-missing-prios +.func-field__wrapper, .allocation-missing-prios, .allocation-users__accept max-height: 75vh overflow: auto diff --git a/src/Handler/Allocation/Accept.hs b/src/Handler/Allocation/Accept.hs index a8aec85b4..2418d7be3 100644 --- a/src/Handler/Allocation/Accept.hs +++ b/src/Handler/Allocation/Accept.hs @@ -54,7 +54,6 @@ allocationAcceptForm aId = runMaybeT $ do Allocation{..} <- MaybeT $ get aId SessionDataAllocationResults allocMap <- MaybeT $ lookupSessionJson SessionAllocationResults allocRes@(allocTime, allocFp, allocMatching, _ :|> MatchingLogRun{..}) <- hoistMaybe $ allocMap !? (allocationTerm, allocationSchool, allocationShorthand) - $logInfoS "allocationAcceptForm" $ tshow allocRes allocationUsers <- fmap (map $ bimap E.unValue E.unValue) . lift . E.select . E.from $ \allocationUser -> do E.where_ $ allocationUser E.^. AllocationUserAllocation E.==. E.val aId diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index f9fe0b669..6943ffb61 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -465,8 +465,8 @@ defaultSorting :: [SortingSetting] -> PSValidator m x -> PSValidator m x defaultSorting psSorting (runPSValidator -> f) = PSValidator $ \dbTable' -> injectDefault <*> f dbTable' where injectDefault x = case x >>= piSorting of - Just _ -> id - Nothing -> set (_2._psSorting) psSorting + Just prev -> _2 . _psSorting <>~ filter (\ss -> none (((==) `on` sortKey) ss) prev) psSorting + Nothing -> set (_2 . _psSorting) psSorting defaultPagesize :: PagesizeLimit -> PSValidator m x -> PSValidator m x defaultPagesize psLimit (runPSValidator -> f) = PSValidator $ \dbTable' -> injectDefault <*> f dbTable' @@ -996,15 +996,15 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db psFilter' = imap (\key args -> (, args) $ Map.findWithDefault (error $ "Invalid filter key: " <> show key) key dbtFilter) psFilter - sortSql :: Maybe (_ -> [E.SqlExpr E.OrderBy]) - sortSql = do - sqlSorting <- mapM (\(c, d) -> (, d) <$> sqlSortDirection c) psSorting' - return $ \t -> concatMap (\(f, d) -> f d t) sqlSorting + primarySortSql = flip has psSorting' $ _head . _1 . to sqlSortDirection . _Just + + sortSql :: _ -> [E.SqlExpr E.OrderBy] + sortSql t = concatMap (\(f, d) -> f d t) $ mapMaybe (\(c, d) -> (, d) <$> sqlSortDirection c) psSorting' filterSql :: Map FilterKey (Maybe (_ -> E.SqlExpr (E.Value Bool))) filterSql = map (\(fc, args) -> ($ args) <$> filterColumn fc) $ psFilter' - selectPagesize = is _Just sortSql + selectPagesize = primarySortSql && all (is _Just) filterSql psLimit' = bool PagesizeAll psLimit selectPagesize @@ -1012,8 +1012,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db rows' <- E.select . E.from $ \t -> do res <- dbtSQLQuery t - whenIsJust sortSql $ \mkSorting -> - E.orderBy $ mkSorting t + E.orderBy $ sortSql t case csvMode of FormSuccess DBCsvExport{} -> return () FormSuccess DBCsvImport{} -> return () @@ -1048,6 +1047,8 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db sortProjected | is _Just previousKeys = id + | primarySortSql + = id | otherwise = sortBy $ concatMap (\(c, d) (_, r) (_, r') -> adjustOrder d $ sortDirectionProjected c r r') psSorting' where diff --git a/templates/allocation/users.hamlet b/templates/allocation/users.hamlet index 6ca99d859..c8554dc25 100644 --- a/templates/allocation/users.hamlet +++ b/templates/allocation/users.hamlet @@ -1,6 +1,6 @@ $newline never $maybe acceptWgt <- acceptView -
+
^{acceptWgt}
^{usersTable}