From 38945c99c43632b8adf089f786101753cbe2f0b4 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Fri, 6 Mar 2020 10:01:23 +0100 Subject: [PATCH] style: number every table --- frontend/src/app.sass | 22 +++++++++- src/Handler/Admin/StudyFeatures.hs | 11 ++--- src/Handler/Corrections.hs | 59 +++++++++++++-------------- src/Handler/Material.hs | 3 +- src/Handler/Profile.hs | 15 +++---- src/Handler/SystemMessage.hs | 1 - src/Handler/Users.hs | 3 +- src/Handler/Utils/Table/Columns.hs | 8 ---- src/Handler/Utils/Table/Pagination.hs | 33 +++++++-------- templates/table/colonnade.hamlet | 9 +++- 10 files changed, 83 insertions(+), 81 deletions(-) diff --git a/frontend/src/app.sass b/frontend/src/app.sass index 57cc1e542..3af029a3c 100644 --- a/frontend/src/app.sass +++ b/frontend/src/app.sass @@ -312,11 +312,13 @@ input[type="button"].btn-info:hover, .table--striped .table__row:not(.no-stripe):not(.table__row--sum):nth-child(even) - background-color: rgba(0, 0, 0, 0.03) + .table__td + background-color: rgba(0, 0, 0, 0.03) .table--hover .table__row:not(.no-hover):not(.table__row--sum):not(.table__row--head):not(.table__row--foot):hover - background-color: rgba(0, 0, 0, 0.07) + .table__td + background-color: rgba(0, 0, 0, 0.07) .table__row--sum td.table__td::before content: 'Σ' @@ -345,6 +347,19 @@ input[type="button"].btn-info:hover, padding-right: 10px max-width: 300px +.table__td--number + width: min-content + padding-left: 0 + + .table--striped &, .table--hover & + vertical-align: middle + + .table__td-content + text-align: right + font-size: 0.9rem + font-weight: 600 + color: var(--color-fontsec) + .table__td font-size: 16px color: var(--color-font) @@ -390,6 +405,9 @@ input[type="button"].btn-info:hover, &.table__th-link::before display: none +.table__th--number + padding: 0 + @media (max-width: 1200px) .table th padding: 4px 6px diff --git a/src/Handler/Admin/StudyFeatures.hs b/src/Handler/Admin/StudyFeatures.hs index 34be34134..e21ae568b 100644 --- a/src/Handler/Admin/StudyFeatures.hs +++ b/src/Handler/Admin/StudyFeatures.hs @@ -330,7 +330,6 @@ postAdminFeaturesR = do [ sortable (Just "key") (i18nCell MsgGenericKey) (numCell . view (_dbrOutput . _entityVal . _studyDegreeKey)) , sortable (Just "name") (i18nCell MsgDegreeName) (textInputCell _1 (_dbrOutput . _entityVal . _studyDegreeName) (_dbrOutput . _entityKey)) , sortable (Just "short") (i18nCell MsgDegreeShort) (textInputCell _2 (_dbrOutput . _entityVal . _studyDegreeShorthand) (_dbrOutput . _entityKey)) - , dbRow ] dbtSorting = Map.fromList [ ("key" , SortColumn (E.^. StudyDegreeKey)) @@ -379,7 +378,6 @@ postAdminFeaturesR = do , sortable (Just "field-type") (i18nCell MsgStudyTermsDefaultFieldType) (fieldTypeCell _6 (_dbrOutput . _1 . _entityVal . _studyTermsDefaultType) _dbrKey') , flip foldMap schools $ \(Entity ssh School{schoolName}) -> sortable Nothing (cell $ toWidget schoolName) (checkboxCell (_3 . at ssh . _Maybe) (_dbrOutput . _3 . at ssh . _Maybe) _dbrKey') - , dbRow ] dbtSorting = Map.fromList [ ("key" , SortColumn $ queryField >>> (E.^. StudyTermsKey)) @@ -416,8 +414,7 @@ postAdminFeaturesR = do dbtRowKey = (E.^. StudyTermNameCandidateId) dbtProj = return dbtColonnade = dbColonnade $ mconcat - [ dbRow - , sortable (Just "key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _entityVal . _studyTermNameCandidateKey)) + [ sortable (Just "key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _entityVal . _studyTermNameCandidateKey)) , sortable (Just "name") (i18nCell MsgStudyTermsName) (textCell . view (_dbrOutput . _entityVal . _studyTermNameCandidateName)) , sortable (Just "incidence") (i18nCell MsgStudyCandidateIncidence) (pathPieceCell . view (_dbrOutput . _entityVal . _studyTermNameCandidateIncidence)) ] @@ -459,8 +456,7 @@ postAdminFeaturesR = do dbtRowKey = queryCandidate >>> (E.^. StudySubTermParentCandidateId) dbtProj = return dbtColonnade = dbColonnade $ mconcat - [ dbRow - , sortable (Just "child") (i18nCell MsgStudySubTermsChildKey) (numCell . view (_dbrOutput . _1 . _entityVal . _studySubTermParentCandidateKey)) + [ sortable (Just "child") (i18nCell MsgStudySubTermsChildKey) (numCell . view (_dbrOutput . _1 . _entityVal . _studySubTermParentCandidateKey)) , sortable (Just "child-name") (i18nCell MsgStudySubTermsChildName) (maybe mempty i18nCell . preview (_dbrOutput . _3 . _Just . _entityVal . _studyTermsName . _Just)) , sortable (Just "parent") (i18nCell MsgStudySubTermsParentKey) (numCell . view (_dbrOutput . _1 . _entityVal . _studySubTermParentCandidateParent)) , sortable (Just "parent-name") (i18nCell MsgStudySubTermsParentName) (maybe mempty i18nCell . preview (_dbrOutput . _2 . _Just . _entityVal . _studyTermsName . _Just)) @@ -501,8 +497,7 @@ postAdminFeaturesR = do dbtRowKey = queryCandidate >>> (E.^. StudyTermStandaloneCandidateId) dbtProj = return dbtColonnade = formColonnade $ mconcat - [ dbRow - , sortable (Just "key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _1 . _entityVal . _studyTermStandaloneCandidateKey)) + [ sortable (Just "key") (i18nCell MsgStudyTermsKey) (numCell . view (_dbrOutput . _1 . _entityVal . _studyTermStandaloneCandidateKey)) , sortable (Just "name") (i18nCell MsgStudyTermsName) (maybe mempty i18nCell . preview (_dbrOutput . _2 . _Just . _entityVal . _studyTermsName . _Just)) , sortable (Just "incidence") (i18nCell MsgStudyCandidateIncidence) (pathPieceCell . view (_dbrOutput . _1 . _entityVal . _studyTermStandaloneCandidateIncidence)) , sortable Nothing (i18nCell MsgStudyTermsDefaultDegree) (degreeCell _1 (pre $ _dbrOutput . _2 . _Just . _studyTermsDefaultDegree . _Just) _dbrKey') diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 93f636d63..a7e21567f 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -62,7 +62,7 @@ import qualified Data.Conduit.List as C type CorrectionTableExpr = (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User)) type CorrectionTableWhere = CorrectionTableExpr -> E.SqlExpr (E.Value Bool) -type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Maybe UTCTime, Map UserId (User, Maybe Pseudonym)) +type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (CourseName, CourseShorthand, Key Term, Key School), Maybe (Entity User), Maybe UTCTime, Map UserId (User, Maybe Pseudonym), CryptoFileNameSubmission) correctionsTableQuery :: CorrectionTableWhere -> (CorrectionTableExpr -> v) -> CorrectionTableExpr -> E.SqlQuery v correctionsTableQuery whereClause returnStatement t@((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) = do @@ -108,7 +108,7 @@ colSchool = sortable (Just "school") (i18nCell MsgCourseSchool) colCourse :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) colCourse = sortable (Just "course") (i18nCell MsgCourse) - $ \DBRow{ dbrOutput=(_, _, (_,csh,tid,sid),_ , _, _) } -> courseCellCL (tid,sid,csh) + $ \DBRow{ dbrOutput=(_, _, (_,csh,tid,sid),_ , _, _, _) } -> courseCellCL (tid,sid,csh) colSheet :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) colSheet = sortable (Just "sheet") (i18nCell MsgSheet) $ \row -> @@ -122,27 +122,23 @@ colSheet = sortable (Just "sheet") (i18nCell MsgSheet) $ \row -> colCorrector :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case - DBRow{ dbrOutput = (_, _, _, Nothing , _, _) } -> cell mempty - DBRow{ dbrOutput = (_, _, _, Just (Entity _ User{..}), _, _) } -> userCell userDisplayName userSurname + DBRow{ dbrOutput = (_, _, _, Nothing , _, _, _) } -> cell mempty + DBRow{ dbrOutput = (_, _, _, Just (Entity _ User{..}), _, _, _) } -> userCell userDisplayName userSurname colSubmissionLink :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) -colSubmissionLink = sortable Nothing (i18nCell MsgSubmission) - $ \DBRow{ dbrOutput=(submission, sheet, course, _, _,_) } -> +colSubmissionLink = sortable (Just "submission") (i18nCell MsgSubmission) + $ \DBRow{ dbrOutput=(_, sheet, course, _, _,_, cid) } -> let csh = course ^. _2 tid = course ^. _3 ssh = course ^. _4 shn = sheetName $ entityVal sheet - mkCid = encrypt (entityKey submission :: SubmissionId) -- TODO: executed twice - mkRoute = do - cid <- mkCid - return $ CSubmissionR tid ssh csh shn cid SubShowR - in anchorCellCM $cacheIdentHere mkRoute (mkCid >>= \cid -> [whamlet|#{cid}|]) + in anchorCellC $cacheIdentHere (CSubmissionR tid ssh csh shn cid SubShowR) (toPathPiece cid) colSelect :: forall act h. (Semigroup act, Monoid act, Headedness h) => Colonnade h CorrectionTableData (DBCell _ (FormResult (act, DBFormResult CryptoFileNameSubmission Bool CorrectionTableData), SheetTypeSummary)) -colSelect = dbSelect (_1 . applying _2) id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> encrypt subId +colSelect = dbSelect (_1 . applying _2) id $ \DBRow{ dbrOutput=(_, _, _, _, _, _, cid) } -> return cid colSubmittors :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) -colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, _, users) } -> let +colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutput=(_, _, course, _, _, users, _) } -> let csh = course ^. _2 tid = course ^. _3 ssh = course ^. _4 @@ -154,12 +150,12 @@ colSubmittors = sortable (Just "submittors") (i18nCell MsgSubmissionUsers) $ \DB in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")] colSMatrikel :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) -colSMatrikel = sortable Nothing (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, _, _, _, _, users) } -> let +colSMatrikel = sortable Nothing (i18nCell MsgMatrikelNr) $ \DBRow{ dbrOutput=(_, _, _, _, _, users, _) } -> let protoCell = listCell (Map.toList users) $ \(userId, (User{..}, _)) -> anchorCellCM $cacheIdentHere (AdminUserR <$> encrypt userId) (fromMaybe mempty userMatrikelnummer) in protoCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")] colRating :: forall m a. IsDBTable m (a, SheetTypeSummary) => Colonnade Sortable CorrectionTableData (DBCell m (a, SheetTypeSummary)) -colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId sub@Submission{..}, Entity _ Sheet{..}, course, _, _, _) } -> +colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId sub@Submission{..}, Entity _ Sheet{..}, course, _, _, _, _) } -> let csh = course ^. _2 tid = course ^. _3 ssh = course ^. _4 @@ -179,43 +175,43 @@ colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(E ] colAssigned :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) -colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _) } -> +colAssigned = sortable (Just "assignedtime") (i18nCell MsgAssignedTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _, _) } -> maybe mempty dateTimeCell submissionRatingAssigned colRated :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) -colRated = sortable (Just "ratingtime") (i18nCell MsgRatingTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _) } -> +colRated = sortable (Just "ratingtime") (i18nCell MsgRatingTime) $ \DBRow{ dbrOutput=(Entity _subId Submission{..}, _sheet, _course, _, _, _, _) } -> maybe mempty dateTimeCell submissionRatingTime colPseudonyms :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) -colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_, _, _, _, _, users) } -> let +colPseudonyms = sortable Nothing (i18nCell MsgPseudonyms) $ \DBRow{ dbrOutput=(_, _, _, _, _, users, _) } -> let lCell = listCell (catMaybes $ snd . snd <$> Map.toList users) $ \pseudo -> cell [whamlet|#{review _PseudonymText pseudo}|] in lCell & cellAttrs <>~ [("class", "list--inline list--comma-separated")] colRatedField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (Bool, a, b) CorrectionTableData))) colRatedField = sortable Nothing (i18nCell MsgRatingDone) $ formCell id - (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId) - (\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _, _) } mkUnique -> over (_1.mapped) (_1 .~) . over _2 fvInput <$> mreq checkBoxField (fsUniq mkUnique "rated") (Just done)) + (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _) } -> return subId) + (\DBRow{ dbrOutput=(Entity _ (submissionRatingDone -> done), _, _, _, _, _, _) } mkUnique -> over (_1.mapped) (_1 .~) . over _2 fvInput <$> mreq checkBoxField (fsUniq mkUnique "rated") (Just done)) colPointsField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, Maybe Points, b) CorrectionTableData))) colPointsField = sortable (Just "rating") (i18nCell MsgColumnRatingPoints) $ formCell id - (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId) - (\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _, _) } mkUnique -> case sheetType of + (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _) } -> return subId) + (\DBRow{ dbrOutput=(Entity _ Submission{..}, Entity _ Sheet{..}, _, _, _, _, _) } mkUnique -> case sheetType of NotGraded -> over (_1.mapped) (_2 .~) <$> pure (FormSuccess Nothing, mempty) _other -> over (_1.mapped) (_2 .~) . over _2 fvInput <$> mopt (pointsFieldMax $ preview (_grading . _maxPoints) sheetType) (fsUniq mkUnique "points") (Just submissionRatingPoints) ) colMaxPointsField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, Maybe Points, b) CorrectionTableData))) -colMaxPointsField = sortable (Just "sheet-type") (i18nCell MsgSheetType) $ i18nCell . (\DBRow{ dbrOutput=(_, Entity _ Sheet{sheetType}, _, _, _, _) } -> sheetType) +colMaxPointsField = sortable (Just "sheet-type") (i18nCell MsgSheetType) $ i18nCell . (\DBRow{ dbrOutput=(_, Entity _ Sheet{sheetType}, _, _, _, _, _) } -> sheetType) colCommentField :: Colonnade Sortable CorrectionTableData (DBCell _ (FormResult (DBFormResult SubmissionId (a, b, Maybe Text) CorrectionTableData))) colCommentField = sortable (Just "comment") (i18nCell MsgRatingComment) $ fmap (cellAttrs <>~ [("style","width:60%")]) $ formCell id - (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _) } -> return subId) - (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment)) + (\DBRow{ dbrOutput=(Entity subId _, _, _, _, _, _, _) } -> return subId) + (\DBRow{ dbrOutput=(Entity _ Submission{..}, _, _, _, _, _, _) } mkUnique -> over (_1.mapped) ((_3 .~) . assertM (not . null) . fmap (Text.strip . unTextarea)) . over _2 fvInput <$> mopt textareaField (fsUniq mkUnique "comment") (Just $ Textarea <$> submissionRatingComment)) colLastEdit :: IsDBTable m a => Colonnade Sortable CorrectionTableData (DBCell m a) colLastEdit = sortable (Just "last-edit") (i18nCell MsgLastEdit) $ - \DBRow{ dbrOutput=(_, _, _, _, mbLastEdit, _) } -> maybe mempty dateTimeCell mbLastEdit + \DBRow{ dbrOutput=(_, _, _, _, mbLastEdit, _, _) } -> maybe mempty dateTimeCell mbLastEdit makeCorrectionsTable :: ( IsDBTable m x, ToSortable h, Functor h ) @@ -242,7 +238,8 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams return (user, pseudonym E.?. SheetPseudonymPseudonym) let submittorMap = List.foldr (\(Entity userId user, E.Value pseudo) -> Map.insert userId (user, pseudo)) Map.empty submittors - return (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, mbLastEdit, submittorMap) + cid <- encrypt sId + return (submission, sheet, (courseName, courseShorthand, courseTerm, courseSchool), mCorrector, mbLastEdit, submittorMap, cid) dbTable psValidator DBTable { dbtSQLQuery , dbtRowKey = \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) -> submission E.^. SubmissionId @@ -298,6 +295,9 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtParams , ( "last-edit" , SortColumn $ \((_course `E.InnerJoin` _sheet `E.InnerJoin` submission) `E.LeftOuterJoin` _corrector) -> lastEditQuery submission ) + , ( "submission" + , SortProjected . comparing $ toPathPiece . view (_dbrOutput . _7) + ) ] , dbtFilter = Map.fromList [ ( "term" @@ -600,7 +600,6 @@ postCorrectionsR = do let whereClause = ratedBy uid colonnade = mconcat [ colSelect - , dbRow -- very useful, since correction statistics are still missing. , colSchool , colTerm , colCourse @@ -644,7 +643,6 @@ postCCorrectionsR tid ssh csh = do let whereClause = courseIs cid colonnade = mconcat -- should match getSSubsR for consistent UX [ colSelect - , dbRow , colSheet , colSMatrikel , colSubmittors @@ -678,7 +676,6 @@ postSSubsR tid ssh csh shn = do let whereClause = sheetIs shid colonnade = mconcat -- should match getCCorrectionsR for consistent UX [ colSelect - , dbRow , colSMatrikel , colSubmittors , colSubmissionLink @@ -1053,7 +1050,7 @@ postCorrectionsGradeR = do optionsPairs $ map (id &&& id) $ nub $ map (CI.original . unSchoolKey . courseSchool . entityVal) courses psValidator = def & defaultSorting [SortDescBy "ratingtime"] :: PSValidator (MForm (HandlerFor UniWorX)) (FormResult (DBFormResult SubmissionId (Bool, Maybe Points, Maybe Text) CorrectionTableData)) - unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment) + unFormResult = getDBFormResult $ \DBRow{ dbrOutput = (Entity _ sub@Submission{..}, _, _, _, _, _, _) } -> (submissionRatingDone sub, submissionRatingPoints, submissionRatingComment) (fmap unFormResult -> tableRes, table) <- runDB $ makeCorrectionsTable whereClause displayColumns filterUI psValidator $ def { dbParamsFormAction = Just $ SomeRoute CorrectionsGradeR diff --git a/src/Handler/Material.hs b/src/Handler/Material.hs index 8c962d53f..10ab3536b 100644 --- a/src/Handler/Material.hs +++ b/src/Handler/Material.hs @@ -204,8 +204,7 @@ getMShowR tid ssh csh mnm = do return (file E.^. FileTitle, file E.^. FileModified) , dbtRowKey = \(_ `E.InnerJoin` file) -> file E.^. FileId , dbtColonnade = widgetColonnade $ mconcat - [ dbRowIndicator -- important: contains writer to indicate that the tables is not empty - , colFilePathSimple (view $ _dbrOutput . _1) matLink + [ (<> indicatorCell) <$> colFilePathSimple (view $ _dbrOutput . _1) matLink , materialModDateCol (view $ _dbrOutput . _2) ] , dbtProj = return diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 285517656..b6cce8cf6 100644 --- a/src/Handler/Profile.hs +++ b/src/Handler/Profile.hs @@ -409,8 +409,7 @@ mkOwnedCoursesTable = dbtProj = return . (_dbrOutput %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))) dbtColonnade = mconcat - [ dbRow - , sortable (Just "term") (i18nCell MsgTerm & cellAttrs .~ [("priority","0")]) $ do + [ sortable (Just "term") (i18nCell MsgTerm & cellAttrs .~ [("priority","0")]) $ do tid <- view (_dbrOutput . _1) return $ indicatorCell -- return True if one cell is produced here `mappend` termCell tid @@ -459,8 +458,7 @@ mkEnrolledCoursesTable = , dbtRowKey = \(course `E.InnerJoin` _) -> course E.^. CourseId , dbtProj = \x -> return $ x & _dbrOutput . _2 %~ E.unValue , dbtColonnade = mconcat - [ dbRow - , sortable (Just "term") (i18nCell MsgTerm) $ + [ sortable (Just "term") (i18nCell MsgTerm) $ termCell <$> view (_dbrOutput . _1 . _entityVal . _courseTerm) , sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 . _entityVal) $ schoolCell <$> view _courseTerm @@ -527,8 +525,7 @@ mkSubmissionTable = & _dbrOutput . _4 %~ E.unValue dbtColonnade = mconcat - [ dbRow - , sortable (Just "term") (i18nCell MsgTerm) $ + [ sortable (Just "term") (i18nCell MsgTerm) $ termCell <$> view (_dbrOutput . _1 . _1) , sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $ schoolCell <$> view _1 @@ -609,8 +606,7 @@ mkSubmissionGroupTable = & _dbrOutput . _3 %~ E.unValue dbtColonnade = mconcat - [ dbRow - , sortable (Just "term") (i18nCell MsgTerm) $ + [ sortable (Just "term") (i18nCell MsgTerm) $ termCell <$> view (_dbrOutput . _1 . _1) , sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $ schoolCell <$> view _1 @@ -683,8 +679,7 @@ mkCorrectionsTable = & _dbrOutput . _2 %~ E.unValue dbtColonnade = mconcat - [ dbRow - , sortable (Just "term") (i18nCell MsgTerm) $ + [ sortable (Just "term") (i18nCell MsgTerm) $ termCellCL <$> view (_dbrOutput . _1) , sortable (Just "school") (i18nCell MsgCourseSchool) $ schoolCellCL <$> view (_dbrOutput . _1) diff --git a/src/Handler/SystemMessage.hs b/src/Handler/SystemMessage.hs index 321b84310..28a9b94e9 100644 --- a/src/Handler/SystemMessage.hs +++ b/src/Handler/SystemMessage.hs @@ -162,7 +162,6 @@ postMessageListR = do dbtSQLQuery = return dbtColonnade = mconcat [ dbSelect (applying _2) id $ \DBRow{ dbrOutput = (Entity smId _, _) } -> encrypt smId - , dbRow , sortable Nothing (i18nCell MsgSystemMessageId) $ \DBRow{ dbrOutput = (Entity smId _, _) } -> anchorCellM' (encrypt smId) MessageR ciphertext , sortable (Just "from") (i18nCell MsgSystemMessageFrom) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> cell $ maybe mempty (formatTimeW SelFormatDateTime) systemMessageFrom , sortable (Just "to") (i18nCell MsgSystemMessageTo) $ \DBRow{ dbrOutput = (Entity _ SystemMessage{..}, _) } -> cell $ maybe mempty (formatTimeW SelFormatDateTime) systemMessageTo diff --git a/src/Handler/Users.hs b/src/Handler/Users.hs index 27c59d743..11b6483f7 100644 --- a/src/Handler/Users.hs +++ b/src/Handler/Users.hs @@ -74,8 +74,7 @@ postUsersR = do MsgRenderer mr <- getMsgRenderer let dbtColonnade = mconcat $ - [ dbRow - , dbSelect (applying _2) id (return . view (_dbrOutput . _entityKey)) + [ dbSelect (applying _2) id (return . view (_dbrOutput . _entityKey)) , sortable (Just "name") (i18nCell MsgName) $ \DBRow{ dbrOutput = Entity uid User{..} } -> anchorCellM (AdminUserR <$> encrypt uid) (nameWidget userDisplayName userSurname) diff --git a/src/Handler/Utils/Table/Columns.hs b/src/Handler/Utils/Table/Columns.hs index 3eee7527b..10a939e95 100644 --- a/src/Handler/Utils/Table/Columns.hs +++ b/src/Handler/Utils/Table/Columns.hs @@ -80,14 +80,6 @@ type OpticFilterColumn' t inp focus type OpticFilterColumn t focus = OpticFilterColumn' t (Set focus) (E.SqlExpr (E.Value focus)) ------------------------ --- Numbers and Indices - --- | Simple index column, also indicating whether there is a row at all --- For a version without indication, use `Handler.Utils.Pagination.dbRow` instead. -dbRowIndicator :: IsDBTable m Any => Colonnade Sortable (DBRow r) (DBCell m Any) -dbRowIndicator = sortable Nothing (i18nCell MsgNrColumn) $ \DBRow{ dbrIndex } -> tellCell (Any True) $ textCell $ tshow dbrIndex - ----------- -- Terms -- ----------- diff --git a/src/Handler/Utils/Table/Pagination.hs b/src/Handler/Utils/Table/Pagination.hs index 7e4498fd9..916129f53 100644 --- a/src/Handler/Utils/Table/Pagination.hs +++ b/src/Handler/Utils/Table/Pagination.hs @@ -8,7 +8,7 @@ module Handler.Utils.Table.Pagination , SortingSetting(..) , pattern SortAscBy, pattern SortDescBy , FilterColumn(..), IsFilterColumn - , DBRow(..), _dbrOutput, _dbrIndex, _dbrCount + , DBRow(..), _dbrOutput, _dbrCount , DBStyle(..), defaultDBSFilterLayout, DBEmptyStyle(..) , module Handler.Utils.Table.Pagination.CsvColumnExplanations , DBCsvActionMode(..) @@ -36,11 +36,11 @@ module Handler.Utils.Table.Pagination , anchorCell, anchorCell', anchorCellM, anchorCellM' , linkEitherCell, linkEitherCellM, linkEitherCellM' , maybeAnchorCellM, maybeAnchorCellM', maybeLinkEitherCellM' - , anchorCellCM, anchorCellCM', linkEitherCellCM', maybeLinkEitherCellCM' + , anchorCellC, anchorCellCM, anchorCellCM', linkEitherCellCM', maybeLinkEitherCellCM' , cellTooltip , listCell , formCell, DBFormResult(..), getDBFormResult - , dbRow, dbSelect + , dbSelect , (&) , module Control.Monad.Trans.Maybe , module Colonnade @@ -411,7 +411,7 @@ type DBTableKey k' = (Show k', ToJSON k', FromJSON k', Ord k', Binary k', Typeab data DBRow r = forall k'. DBTableKey k' => DBRow { dbrKey :: k' , dbrOutput :: r - , dbrIndex, dbrCount :: Int64 + , dbrCount :: Int64 } makeLenses_ ''DBRow @@ -423,7 +423,7 @@ instance Foldable DBRow where foldMap f DBRow{..} = f dbrOutput instance Traversable DBRow where - traverse f DBRow{..} = DBRow <$> pure dbrKey <*> f dbrOutput <*> pure dbrIndex <*> pure dbrCount + traverse f DBRow{..} = DBRow <$> pure dbrKey <*> f dbrOutput <*> pure dbrCount newtype PSValidator m x = PSValidator { runPSValidator :: DBTable m x -> Maybe PaginationInput -> ([SomeMessage UniWorX], PaginationSettings) } @@ -506,7 +506,7 @@ data DBStyle r = DBStyle , dbsTemplate :: DBSTemplateMode r } -data DBSTemplateMode r = DBSTDefault +data DBSTemplateMode r = DBSTDefault { dbstmNumber :: Int64 -> Bool, dbstmShowNumber :: Int64 -> Bool } | DBSTCourse (Lens' r (Entity Course)) (Lens' r [Entity User]) (Lens' r Bool) (Lens' r (Entity School)) (Traversal' r (Entity Allocation)) instance Default (DBStyle r) where @@ -520,7 +520,7 @@ instance Default (DBStyle r) where ^{scrolltable} |] - , dbsTemplate = DBSTDefault + , dbsTemplate = DBSTDefault (>= 10) (\n -> n `mod` 5 == 0) } defaultDBSFilterLayout :: Widget -- ^ Filter UI @@ -1033,7 +1033,7 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db adjustOrder SortDesc EQ = EQ adjustOrder SortDesc GT = LT - (currentKeys, rows) <- fmap (unzip . sortProjected) . mapMaybeM' (assertMM allFilterProjected . lift . dbtProj) . map (\(dbrIndex, (E.Value dbrCount, dbrKey, dbrOutput)) -> (dbrKey, DBRow{..})) . zip [firstRow..] $ reproduceSorting rows' + (currentKeys, rows) <- fmap (unzip . sortProjected) . mapMaybeM' (assertMM allFilterProjected . lift . dbtProj) . map (\(E.Value dbrCount, dbrKey, dbrOutput) -> (dbrKey, DBRow{..})) $ reproduceSorting rows' formResult csvMode $ \case @@ -1191,8 +1191,8 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db attrs = sortableContent ^. cellAttrs piSorting' = [ sSet | sSet <- fromMaybe [] piSorting, Just (sortKey sSet) /= sortableKey ] case dbsTemplate of - DBSTCourse{} -> return $(widgetFile "table/course/header") - DBSTDefault -> return $(widgetFile "table/cell/header") + DBSTCourse{} -> return $(widgetFile "table/course/header") + DBSTDefault{} -> return $(widgetFile "table/cell/header") in do wHeaders <- maybe (return Nothing) (fmap Just . genHeaders) pSortable case dbsTemplate of @@ -1207,11 +1207,13 @@ dbTable PSValidator{..} dbtable@DBTable{ dbtIdent = dbtIdent'@(toPathPiece -> db courseAllocation = row' ^? a in return $(widgetFile "table/course/course-teaser") return $(widgetFile "table/course/colonnade") - DBSTDefault -> do - wRows <- forM rows $ \row' -> forM (oneColonnadeEncode <$> getColonnade dbtColonnade) $ \(($ row') -> cell') -> do + DBSTDefault{..} -> do + wRows' <- forM rows $ \row' -> forM (oneColonnadeEncode <$> getColonnade dbtColonnade) $ \(($ row') -> cell') -> do widget <- cell' ^. cellContents let attrs = cell' ^. cellAttrs return $(widgetFile "table/cell/body") + let numberColumn = dbstmNumber rowCount + wRows = zip [firstRow..] wRows' return $(widgetFile "table/colonnade") pageCount @@ -1357,6 +1359,9 @@ cellTooltip msg = cellContents.mapped %~ (<> tipWdgt) anchorCell :: (HasRoute UniWorX url, ToWidget UniWorX wgt, IsDBTable m a) => url -> wgt -> DBCell m a anchorCell = anchorCellM . return +anchorCellC :: (HasRoute UniWorX url, ToWidget UniWorX wgt, IsDBTable m a, Binary cache) => cache -> url -> wgt -> DBCell m a +anchorCellC cache = anchorCellCM cache . return + anchorCell' :: ( IsDBTable m a , ToWidget UniWorX wgt , HasRoute UniWorX url @@ -1487,10 +1492,6 @@ formCell formCellLens genIndex genForm input@(DBRow{dbrKey}) = FormCell -- Predefined colonnades --- | Simple number column, also see Handler.Utils.Table.Columns.dbRowIndicator -dbRow :: forall h r m a. (Headedness h, IsDBTable m a) => Colonnade h (DBRow r) (DBCell m a) -dbRow = Colonnade.singleton (headednessPure $ i18nCell MsgNrColumn) $ \DBRow{ dbrIndex } -> textCell $ tshow dbrIndex - dbSelect :: forall x h r i a. (Headedness h, Monoid' x) => Lens' x (FormResult (DBFormResult i a (DBRow r))) -> Setter' a Bool diff --git a/templates/table/colonnade.hamlet b/templates/table/colonnade.hamlet index 081195f60..29e9d628f 100644 --- a/templates/table/colonnade.hamlet +++ b/templates/table/colonnade.hamlet @@ -5,6 +5,8 @@ $newline never $maybe wHeaders' <- wHeaders + $if numberColumn + $forall widget <- wHeaders' $# cell/header.hamlet ^{widget} @@ -15,7 +17,12 @@ $newline never _{dbsEmptyMessage} $else - $forall row <- wRows + $forall (n, row) <- wRows + $if numberColumn + +
+ $if dbstmShowNumber n + #{n} $forall widget <- row ^{widget}