Corrector duties shown in ProfileDataR page now.
This commit is contained in:
SJost
parent
cc4c8a897e
commit
fe926b116f
@ -169,7 +169,9 @@ Corrector: Korrektor
|
||||
Correctors: Korrektoren
|
||||
CorState: Status
|
||||
CorByTut: Nach Tutorium
|
||||
Tutorial: Tutorium
|
||||
CorProportion: Anteil
|
||||
CorrectionProportion: Anteile
|
||||
DeleteRow: Zeile entfernen
|
||||
ProportionNegative: Anteile dürfen nicht negativ sein
|
||||
CorrectorsUpdated: Korrektoren erfolgreich aktualisiert
|
||||
|
||||
@ -205,6 +205,25 @@ instance RenderMessage UniWorX CorrectorState where
|
||||
CorrectorExcused -> renderMessage' MsgCorrectorExcused
|
||||
where renderMessage' = renderMessage foundation ls
|
||||
|
||||
|
||||
instance RenderMessage UniWorX Load where
|
||||
renderMessage foundation ls (Load {..}) = loadText <> tutorialText
|
||||
where
|
||||
loadText = if byProportion > 0
|
||||
then (tshow $ fromRational byProportion) <> " " <> renderMessage' MsgCorrectionProportion
|
||||
else mempty
|
||||
|
||||
tutorialText = case byTutorial of
|
||||
Nothing -> mempty
|
||||
(Just plusLoad) ->
|
||||
let connector = if
|
||||
| loadText == mempty -> mempty
|
||||
| plusLoad -> " - "
|
||||
| otherwise -> " + "
|
||||
in connector <> renderMessage' MsgTutorial
|
||||
|
||||
renderMessage' = renderMessage foundation ls
|
||||
|
||||
instance RenderMessage UniWorX (UnsupportedAuthPredicate (Route UniWorX)) where
|
||||
renderMessage f ls (UnsupportedAuthPredicate tag route) = renderMessage f ls $ MsgUnsupportedAuthPredicate tag (show route)
|
||||
|
||||
|
||||
@ -113,11 +113,10 @@ getProfileR = do
|
||||
return (course E.^. CourseTerm, course E.^.CourseSchool, course E.^. CourseShorthand)
|
||||
)
|
||||
<*>
|
||||
(E.select $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
|
||||
(E.select $ E.distinct $ E.from $ \(sheet `E.InnerJoin` corrector `E.InnerJoin` course) -> do
|
||||
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
|
||||
E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
|
||||
E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
|
||||
|
||||
return (course E.^. CourseTerm, course E.^. CourseSchool, course E.^. CourseShorthand)
|
||||
)
|
||||
<*>
|
||||
@ -205,7 +204,7 @@ mkOwnedCoursesTable =
|
||||
schoolCell <$> view (_dbrOutput . _1 . re _Just)
|
||||
<*> view (_dbrOutput . _2 )
|
||||
, sortable (Just "course") (i18nCell MsgCourse) $
|
||||
courseLinkCell <$> view (_dbrOutput)
|
||||
courseCellCL <$> view (_dbrOutput)
|
||||
]
|
||||
|
||||
validator = def & defaultSorting [("term",SortDesc),("school",SortAsc),("course",SortAsc)]
|
||||
@ -312,7 +311,7 @@ mkSubmissionTable =
|
||||
schoolCell <$> view ( _1. re _Just)
|
||||
<*> view ( _2 )
|
||||
, sortable (Just "course") (i18nCell MsgCourse) $
|
||||
courseLinkCell <$> view (_dbrOutput . _1)
|
||||
courseCellCL <$> view (_dbrOutput . _1)
|
||||
, sortable (Just "sheet") (i18nCell MsgSheet) . magnify _dbrOutput $
|
||||
sheetCell <$> view _1
|
||||
<*> view _2
|
||||
@ -389,7 +388,7 @@ mkSubmissionGroupTable =
|
||||
schoolCell <$> view ( _1. re _Just)
|
||||
<*> view ( _2 )
|
||||
, sortable (Just "course") (i18nCell MsgCourse) $
|
||||
courseLinkCell <$> view (_dbrOutput . _1)
|
||||
courseCellCL <$> view (_dbrOutput . _1)
|
||||
, sortable (Just "submissiongroup") (i18nCell MsgSubmissionGroupName) . magnify (_dbrOutput . _2 . _entityVal) $
|
||||
maybe mempty textCell <$> view _submissionGroupName
|
||||
, sortable (Just "edit") (i18nCell MsgLastEdit) $
|
||||
@ -423,60 +422,53 @@ mkCorrectionsTable =
|
||||
let dbtIdent = "corrections" :: Text
|
||||
dbtStyle = def
|
||||
-- TODO Continue here
|
||||
withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroup) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroupUser) )->a)
|
||||
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroup) `E.InnerJoin` E.SqlExpr (Entity SubmissionGroupUser) )->a)
|
||||
withType :: ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity SheetCorrector))->a)
|
||||
-> ((E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity SheetCorrector))->a)
|
||||
withType = id
|
||||
|
||||
dbtSQLQuery' uid = \(course `E.InnerJoin` sgroup `E.InnerJoin` sguser) -> do
|
||||
E.on $ sguser E.^. SubmissionGroupUserSubmissionGroup E.==. sgroup E.^. SubmissionGroupId
|
||||
E.on $ sgroup E.^. SubmissionGroupCourse E.==. course E.^. CourseId
|
||||
E.where_ $ sguser E.^. SubmissionGroupUserUser E.==. E.val uid
|
||||
dbtSQLQuery' uid = \(course `E.InnerJoin` sheet `E.InnerJoin` corrector) -> do
|
||||
E.on $ sheet E.^. SheetId E.==. corrector E.^. SheetCorrectorSheet
|
||||
E.on $ sheet E.^. SheetCourse E.==. course E.^. CourseId
|
||||
E.where_ $ corrector E.^. SheetCorrectorUser E.==. E.val uid
|
||||
let crse = ( course E.^. CourseTerm
|
||||
, course E.^. CourseSchool
|
||||
, course E.^. CourseShorthand
|
||||
)
|
||||
return (crse, sgroup, lastSGEdit sgroup)
|
||||
|
||||
lastSGEdit sgroup = -- latest Edit-Time of this Submission Group by a user
|
||||
E.sub_select . E.from $ \(user `E.InnerJoin` sgEdit) -> do
|
||||
E.on $ user E.^. UserId E.==. sgEdit E.^. SubmissionGroupEditUser
|
||||
E.where_ $ sgEdit E.^. SubmissionGroupEditSubmissionGroup E.==. sgroup E.^. SubmissionGroupId
|
||||
return . E.max_ $ sgEdit E.^. SubmissionGroupEditTime
|
||||
return (crse, sheet E.^. SheetName, corrector)
|
||||
|
||||
dbtProj = \x -> return $ x
|
||||
& _dbrOutput . _1 %~ (\(E.Value tid, E.Value ssh, E.Value csh) -> (tid,ssh,csh))
|
||||
& _dbrOutput . _3 %~ E.unValue
|
||||
& _dbrOutput . _2 %~ E.unValue
|
||||
|
||||
dbtColonnade = mconcat
|
||||
[ dbRow
|
||||
, sortable (Just "term") (i18nCell MsgTerm) $
|
||||
termCell <$> view (_dbrOutput . _1 . _1)
|
||||
, sortable (Just "school") (i18nCell MsgCourseSchool) . magnify (_dbrOutput . _1 ) $
|
||||
schoolCell <$> view ( _1. re _Just)
|
||||
<*> view ( _2 )
|
||||
termCellCL <$> view (_dbrOutput . _1)
|
||||
, sortable (Just "school") (i18nCell MsgCourseSchool) $
|
||||
schoolCellCL <$> view (_dbrOutput . _1)
|
||||
, sortable (Just "course") (i18nCell MsgCourse) $
|
||||
courseLinkCell <$> view (_dbrOutput . _1)
|
||||
, sortable (Just "submissiongroup") (i18nCell MsgSubmissionGroupName) . magnify (_dbrOutput . _2 . _entityVal) $
|
||||
maybe mempty textCell <$> view _submissionGroupName
|
||||
, sortable (Just "edit") (i18nCell MsgLastEdit) $
|
||||
maybe mempty timeCell <$> view (_dbrOutput . _3)
|
||||
courseCellCL <$> view (_dbrOutput . _1)
|
||||
, sortable (Just "sheet") (i18nCell MsgSheet) . magnify _dbrOutput $
|
||||
sheetCell <$> view _1 <*> view _2
|
||||
, sortable (Just "cstate") (i18nCell MsgCorState) $
|
||||
correctorStateCell <$> view (_dbrOutput . _3 . _entityVal)
|
||||
, sortable (Just "cload") (i18nCell MsgCorProportion) $
|
||||
correctorLoadCell <$> view (_dbrOutput . _3 . _entityVal)
|
||||
]
|
||||
|
||||
validator = def -- DUPLICATED CODE: Handler.Corrections
|
||||
& restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
|
||||
& restrictSorting (\name _ -> name /= "corrector")
|
||||
& defaultSorting [("edit",SortDesc)]
|
||||
validator = def & defaultSorting [("term",SortDesc),("school",SortAsc),("course",SortAsc),("sheet",SortAsc)]
|
||||
dbtSorting = Map.fromList
|
||||
[ ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseShorthand)
|
||||
, ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseTerm )
|
||||
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseSchool )
|
||||
, ( "submissiongroup" , SortColumn $ withType $ \(_ `E.InnerJoin` sgroup `E.InnerJoin` _) -> sgroup E.^. SubmissionGroupName )
|
||||
, ( "edit" , SortColumn $ withType $ \(_ `E.InnerJoin` sgroup `E.InnerJoin` _ ) -> lastSGEdit sgroup)
|
||||
[ ( "term" , SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseTerm )
|
||||
, ( "school", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseSchool )
|
||||
, ( "course", SortColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _ ) -> crse E.^. CourseShorthand)
|
||||
, ( "sheet" , SortColumn $ withType $ \(_ `E.InnerJoin` sheet `E.InnerJoin` _) -> sheet E.^. SheetName )
|
||||
, ( "cstate", SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.InnerJoin` cs) -> cs E.^. SheetCorrectorState )
|
||||
, ( "cload" , SortColumn $ withType $ \(_ `E.InnerJoin` _ `E.InnerJoin` cs) -> cs E.^. SheetCorrectorLoad )
|
||||
]
|
||||
dbtFilter = Map.fromList
|
||||
[ ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
|
||||
, ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
|
||||
[ ( "term", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseTerm )
|
||||
, ( "school", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseSchool )
|
||||
, ( "course", FilterColumn $ withType $ \(crse `E.InnerJoin` _ `E.InnerJoin` _) -> emptyOrIn $ crse E.^. CourseShorthand)
|
||||
]
|
||||
in \uid -> let dbtSQLQuery = dbtSQLQuery' uid
|
||||
in dbTableWidget' validator $ DBTable {..}
|
||||
|
||||
@ -157,8 +157,8 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
||||
E.orderBy [E.asc $ user E.^. UserEmail]
|
||||
return $ (user E.^. UserId, user E.^. UserEmail)
|
||||
let breakUserFromBuddies (E.Value userID, E.Value email)
|
||||
| uid == userID = (Any True , [])
|
||||
| otherwise = (Any False, [email])
|
||||
| uid == userID = (Any True , [])
|
||||
| otherwise = (Any False, [email])
|
||||
return $ foldMap breakUserFromBuddies submittors
|
||||
|
||||
lastEdits <- do
|
||||
@ -167,7 +167,7 @@ submissionHelper tid ssh csh shn (SubmissionMode mcid) = do
|
||||
E.where_ $ submissionEdit E.^. SubmissionEditSubmission E.==. E.val smid
|
||||
E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime]
|
||||
-- E.limit numberOfSubmissionEditDates -- DEPRECATED we always show all edit times
|
||||
let userName = if maySubmit || isOwner
|
||||
let userName = if isOwner || maySubmit
|
||||
then E.just $ user E.^. UserDisplayName
|
||||
else E.nothing
|
||||
return $ (userName, submissionEdit E.^. SubmissionEditTime)
|
||||
|
||||
@ -38,6 +38,9 @@ termCell tid = anchorCell link name
|
||||
link = TermCourseListR tid
|
||||
name = text2widget $ display tid
|
||||
|
||||
termCellCL :: IsDBTable m a => CourseLink -> DBCell m a
|
||||
termCellCL (tid,_,_) = termCell tid
|
||||
|
||||
schoolCell :: IsDBTable m a => Maybe TermId -> SchoolId -> DBCell m a
|
||||
schoolCell (Just tid) ssh = anchorCell link name
|
||||
where
|
||||
@ -48,8 +51,11 @@ schoolCell Nothing ssh = anchorCell link name
|
||||
link = SchoolShowR ssh
|
||||
name = text2widget $ display ssh
|
||||
|
||||
courseLinkCell :: IsDBTable m a => CourseLink -> DBCell m a
|
||||
courseLinkCell (tid,ssh,csh) = anchorCell link name
|
||||
schoolCellCL :: IsDBTable m a => CourseLink -> DBCell m a
|
||||
schoolCellCL (tid,ssh,_) = schoolCell (Just tid) ssh
|
||||
|
||||
courseCellCL :: IsDBTable m a => CourseLink -> DBCell m a
|
||||
courseCellCL (tid,ssh,csh) = anchorCell link name
|
||||
where
|
||||
link = CourseR tid ssh csh CShowR
|
||||
name = citext2widget csh
|
||||
@ -81,3 +87,10 @@ submissionCell crse shn sid =
|
||||
mkText cid = display2widget cid
|
||||
in anchorCellM' mkCid mkRoute mkText
|
||||
|
||||
correctorStateCell :: IsDBTable m a => SheetCorrector -> DBCell m a
|
||||
correctorStateCell sc =
|
||||
i18nCell $ sheetCorrectorState sc
|
||||
|
||||
correctorLoadCell :: IsDBTable m a => SheetCorrector -> DBCell m a
|
||||
correctorLoadCell sc =
|
||||
i18nCell $ sheetCorrectorLoad sc
|
||||
|
||||
@ -1,39 +1,39 @@
|
||||
<div .scrolltable>
|
||||
<table .table .table--striped .table--hover .table--vertical>
|
||||
<tr .table__row>
|
||||
<th .table__th> _{MsgSubmission}
|
||||
<td .table__td> #{display cid}
|
||||
<th .table__th>_{MsgSubmission}
|
||||
<td .table__td>#{display cid}
|
||||
$maybe Entity _ User{..} <- corrector
|
||||
<tr .table__row>
|
||||
<th .table__th> _{MsgRatingBy}
|
||||
<td .table__td> #{display userDisplayName}
|
||||
<th .table__th>_{MsgRatingBy}
|
||||
<td .table__td>#{display userDisplayName}
|
||||
$maybe time <- submissionRatingTime
|
||||
<tr .table__row>
|
||||
<th .table__th> _{MsgRatingTime}
|
||||
<td .table__td> #{display time}
|
||||
<th .table__th>_{MsgRatingTime}
|
||||
<td .table__td>#{display time}
|
||||
$maybe points <- submissionRatingPoints
|
||||
$case sheetType
|
||||
$of Bonus{..}
|
||||
<tr .table__row>
|
||||
<th .table__th> _{MsgAchievedBonusPoints}
|
||||
<td .table__td> _{MsgAchievedOf points maxPoints}
|
||||
<th .table__th>_{MsgAchievedBonusPoints}
|
||||
<td .table__td>_{MsgAchievedOf points maxPoints}
|
||||
$of Normal{..}
|
||||
<tr .table__row>
|
||||
<th .table__th> _{MsgAchievedNormalPoints}
|
||||
<td .table__td> _{MsgAchievedOf points maxPoints}
|
||||
<th .table__th>_{MsgAchievedNormalPoints}
|
||||
<td .table__td>_{MsgAchievedOf points maxPoints}
|
||||
$of Pass{..}
|
||||
<tr .table__row>
|
||||
<th .table__th> _{MsgPassedResult}
|
||||
<th .table__th>_{MsgPassedResult}
|
||||
<td .table__td>
|
||||
$if points >= passingPoints
|
||||
_{MsgPassed}
|
||||
$else
|
||||
_{MsgNotPassed}
|
||||
<tr .table__row>
|
||||
<th .table__th> _{MsgAchievedPassPoints}
|
||||
<td .table__td> _{MsgPassAchievedOf points passingPoints maxPoints}
|
||||
<th .table__th>_{MsgAchievedPassPoints}
|
||||
<td .table__td>_{MsgPassAchievedOf points passingPoints maxPoints}
|
||||
$of NotGraded
|
||||
$maybe comment <- ratingComment
|
||||
<tr .table__row>
|
||||
<th .table__th> _{MsgRatingComment}
|
||||
<td .table__td style="white-space: pre;"> #{comment}
|
||||
<th .table__th>_{MsgRatingComment}
|
||||
<td .table__td style="white-space: pre;">#{comment}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user