style: number every table
This commit is contained in:
Gregor Kleen
parent
17882868d2
commit
38945c99c4
@ -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
|
||||
|
||||
@ -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')
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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 --
|
||||
-----------
|
||||
|
||||
@ -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
|
||||
<!-- No Filter UI -->
|
||||
^{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
|
||||
|
||||
@ -5,6 +5,8 @@ $newline never
|
||||
$maybe wHeaders' <- wHeaders
|
||||
<thead>
|
||||
<tr .table__row.table__row--head>
|
||||
$if numberColumn
|
||||
<th .table__th uw-hide-columns--no-hide .table__th--number>
|
||||
$forall widget <- wHeaders'
|
||||
$# cell/header.hamlet
|
||||
^{widget}
|
||||
@ -15,7 +17,12 @@ $newline never
|
||||
<td .table__td colspan=#{show columnCount}>
|
||||
_{dbsEmptyMessage}
|
||||
$else
|
||||
$forall row <- wRows
|
||||
$forall (n, row) <- wRows
|
||||
<tr .table__row>
|
||||
$if numberColumn
|
||||
<td .table__td .table__td--number>
|
||||
<div .table__td-content>
|
||||
$if dbstmShowNumber n
|
||||
#{n}
|
||||
$forall widget <- row
|
||||
^{widget}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user