fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Übersicht Übunbgsblätter enthält links für Korrektur und Rating

Browse Source
This commit is contained in:
SJost 2018-07-31 14:08:59 +02:00
parent 534c7183ff
commit aec528d94c
5 changed files with 88 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
ChangeLog.md
View File

@ -1,4 +1,9 @@
* Version 31.07.2018
Viele Verbesserung zur Anzeige von Korrekturen
* Version 10.07.2018
Bugfixes, wählbares Format für Datum
* Version 04.07.2018

3
messages/de.msg
View File

@ -190,6 +190,7 @@ NotPassed: Nicht bestanden
RatingTime: Korrigiert
RatingComment: Kommentar
SubmissionUsers: Studenten
Rating: Korrektur
RatingPoints: Punkte
RatingFiles: Korrigierte Dateien
@ -227,4 +228,4 @@ EditedBy name@Text time@Text: Durch #{name} um #{time}
LastEdit: Letzte Änderung
SubmissionFilesIgnored: Es wurden Dateien in der hochgeladenen Abgabe ignoriert:
SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}.
SubmissionDoesNotExist smid@CryptoFileNameSubmission: Es existiert keine Abgabe mit Nummer #{toPathPiece smid}.

39
src/Handler/Corrections.hs
View File

@ -85,19 +85,18 @@ colTerm = sortable (Just "term") (i18nCell MsgTerm)
colCourse :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colCourse = sortable (Just "course") (i18nCell MsgCourse)
$ \DBRow{ dbrOutput=(_, _, course, _, _) } -> cell $
$ \DBRow{ dbrOutput=(_, _, course, _, _) } ->
let tid = course ^. _3
csh = course ^. _2
in [whamlet|<a href=@{CourseR tid csh CShowR}>#{display csh}|]
in anchorCell (CourseR tid csh CShowR) [whamlet|#{display csh}|]
colSheet :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colSheet = sortable (Just "sheet") (i18nCell MsgSheet)
$ \DBRow{ dbrOutput=(_, sheet, course, _, _) } -> cell $
let tid = course ^. _3
csh = course ^. _2
shn = sheetName $ entityVal sheet
in [whamlet|<a href=@{CSheetR tid csh shn SShowR}>#{display shn}|]
-- textCell $ sheetName $ entityVal sheet
$ \DBRow{ dbrOutput=(_, sheet, course, _, _) } ->
let tid = course ^. _3
csh = course ^. _2
shn = sheetName $ entityVal sheet
in anchorCell (CSheetR tid csh shn SShowR) [whamlet|#{display shn}|]
colCorrector :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case
@ -106,12 +105,15 @@ colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case
colSubmissionLink :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colSubmissionLink = sortable Nothing (i18nCell MsgSubmission)
$ \DBRow{ dbrOutput=(submission, sheet, course, _, _) } -> cell $ do
$ \DBRow{ dbrOutput=(submission, sheet, course, _, _) } ->
let tid = course ^. _3
csh = course ^. _2
shn = sheetName $ entityVal sheet
cid <- encrypt (entityKey submission :: SubmissionId)
[whamlet|<a href=@{CSubmissionR tid csh shn cid SubShowR}>#{display cid}|]
mkCid = encrypt (entityKey submission :: SubmissionId) -- TODO: executed twice
mkRoute = do
cid <- mkCid
return $ CSubmissionR tid csh shn cid SubShowR
in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|])
colSelect :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData CryptoFileNameSubmission Bool)))
colSelect = dbSelect id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _, _) } -> encrypt subId
@ -121,6 +123,15 @@ colSubmittors = sortable Nothing (i18nCell MsgSubmissionUsers) $ \DBRow{ dbrOutp
cell = listCell (Map.toList users) $ \(userId, User{..}) -> anchorCellM (AdminUserR <$> encrypt userId) (toWidget userDisplayName)
in cell & cellAttrs <>~ [("class", "list--inline list--comma-separated")]
colRating :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colRating = sortable (Just "rating") (i18nCell MsgRating) $ \DBRow{ dbrOutput=(Entity subId Submission{..}, Entity _ Sheet{..}, course, _, _) } ->
let tid = course ^. _3
csh = course ^. _2
-- shn = sheetName
mkRoute = do
cid <- encrypt subId
return $ CSubmissionR tid csh sheetName cid CorrectionR
in anchorCellM mkRoute $(widgetFile "widgets/rating")
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))
@ -165,6 +176,9 @@ makeCorrectionsTable whereClause colChoices psValidator = do
, ( "corrector"
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` corrector) -> corrector E.?. UserDisplayName
)
, ( "rating"
, SortColumn $ \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _) -> submission E.^. SubmissionRatingPoints
)
]
, dbtFilter = [ ( "term"
, FilterColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _ :: CorrectionTableExpr) tids -> if
@ -317,6 +331,7 @@ postCorrectionsR = do
, colCourse
, colSheet
, colSubmissionLink
, colRating
] -- Continue here
psValidator = def
& restrictFilter (\name _ -> name /= "corrector") -- We need to be careful to restrict allowed sorting/filter to not expose sensitive information
@ -337,6 +352,7 @@ postCCorrectionsR tid csh = do
, colCorrector
, colSubmittors
, colSubmissionLink
, colRating
] -- Continue here
psValidator = def
correctionsR whereClause colonnade psValidator $ Map.fromList
@ -355,6 +371,7 @@ postSSubsR tid csh shn = do
, colCorrector
, colSubmittors
, colSubmissionLink
, colRating
]
psValidator = def
correctionsR whereClause colonnade psValidator $ Map.fromList

52
src/Handler/Sheet.hs
View File

@ -156,49 +156,71 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do
getSheetListR :: TermId -> CourseShorthand -> Handler Html
getSheetListR tid csh = do
muid <- maybeAuthId
Entity cid _ <- runDB . getBy404 $ CourseTermShort tid csh
let
sheetData :: E.SqlExpr (E.Entity Sheet) -> E.SqlQuery (E.SqlExpr (Entity Sheet), E.SqlExpr (E.Value (Maybe UTCTime)))
sheetData sheet = do
sheetData :: E.SqlExpr (Entity Sheet) `E.LeftOuterJoin` (E.SqlExpr (Maybe (Entity Submission)) `E.InnerJoin` (E.SqlExpr (Maybe (Entity SubmissionUser)))) -> E.SqlQuery (E.SqlExpr (Entity Sheet), E.SqlExpr (E.Value (Maybe UTCTime)),E.SqlExpr (Maybe (Entity Submission)))
sheetData (sheet `E.LeftOuterJoin` (submission `E.InnerJoin` submissionUser)) = do
E.on $ submission E.?. SubmissionId E.==. submissionUser E.?. SubmissionUserSubmission
E.on $ (E.just $ sheet E.^. SheetId) E.==. submission E.?. SubmissionSheet
E.&&. submissionUser E.?. SubmissionUserUser E.==. E.val muid
let sheetEdit = E.sub_select . E.from $ \sheetEdit -> do
E.where_ $ sheetEdit E.^. SheetEditSheet E.==. sheet E.^. SheetId
return . E.max_ $ sheetEdit E.^. SheetEditTime
E.where_ $ sheet E.^. SheetCourse E.==. E.val cid
return (sheet, sheetEdit)
return (sheet, sheetEdit, submission)
sheetCol = widgetColonnade . mconcat $
[ sortable (Just "name") (i18nCell MsgSheet)
$ \(Entity _ Sheet{..}, _) -> anchorCell (CSheetR tid csh sheetName SShowR) (toWidget sheetName)
$ \(Entity _ Sheet{..}, _, _) -> anchorCell (CSheetR tid csh sheetName SShowR) (toWidget sheetName)
, sortable (Just "last-edit") (i18nCell MsgLastEdit)
$ \(_, E.Value mEditTime) -> case mEditTime of
Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget
Nothing -> mempty
$ \(_, E.Value mEditTime, _) -> case mEditTime of
Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget
Nothing -> mempty
, sortable (Just "submission-since") (i18nCell MsgSheetActiveFrom)
$ \(Entity _ Sheet{..}, _) -> cell $ formatTime SelFormatDateTime sheetActiveFrom >>= toWidget
$ \(Entity _ Sheet{..}, _, _) -> cell $ formatTime SelFormatDateTime sheetActiveFrom >>= toWidget
, sortable (Just "submission-until") (i18nCell MsgSheetActiveTo)
$ \(Entity _ Sheet{..}, _) -> cell $ formatTime SelFormatDateTime sheetActiveTo >>= toWidget
$ \(Entity _ Sheet{..}, _, _) -> cell $ formatTime SelFormatDateTime sheetActiveTo >>= toWidget
, sortable Nothing (i18nCell MsgSheetType)
$ \(Entity _ Sheet{..}, _) -> textCell $ display sheetType
$ \(Entity _ Sheet{..}, _, _) -> textCell $ display sheetType
, sortable (Just "submitted") (i18nCell MsgSubmission)
$ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of
Nothing -> mempty
(Just (Entity sid Submission{..})) ->
let mkCid = encrypt sid -- TODO: executed twice
mkRoute = do
cid <- mkCid
return $ CSubmissionR tid csh sheetName cid SubShowR
in anchorCellM mkRoute (mkCid >>= \cid -> [whamlet|#{display cid}|])
, sortable (Just "rating") (i18nCell MsgRating)
$ \(Entity _ Sheet{..}, _, mbSub) -> case mbSub of
Nothing -> mempty
(Just (Entity sid Submission{..})) ->
let mkCid = encrypt sid
mkRoute = do
cid <- mkCid
return $ CSubmissionR tid csh sheetName cid CorrectionR
in anchorCellM mkRoute $(widgetFile "widgets/rating")
]
psValidator = def
& defaultSorting [("submission-since", SortAsc)]
table <- dbTable psValidator $ DBTable
{ dbtSQLQuery = sheetData
, dbtColonnade = sheetCol
, dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _) }
, dbtProj = \DBRow{ dbrOutput = dbrOutput@(Entity _ Sheet{..}, _, _) }
-> dbrOutput <$ guardM (lift $ (== Authorized) <$> evalAccessDB (CSheetR tid csh sheetName SShowR) False)
, dbtSorting = Map.fromList
[ ( "name"
, SortColumn $ \sheet -> sheet E.^. SheetName
, SortColumn $ \(sheet `E.LeftOuterJoin` submission) -> sheet E.^. SheetName
)
, ( "last-edit"
, SortColumn $ \sheet -> E.sub_select . E.from $ \sheetEdit -> E.distinctOnOrderBy [E.desc $ sheetEdit E.?. SheetEditTime] $ do
, SortColumn $ \(sheet `E.LeftOuterJoin` submission) -> E.sub_select . E.from $ \sheetEdit -> E.distinctOnOrderBy [E.desc $ sheetEdit E.?. SheetEditTime] $ do
return $ sheetEdit E.?. SheetEditTime
)
, ( "submission-since"
, SortColumn $ \sheet -> sheet E.^. SheetActiveFrom
, SortColumn $ \(sheet `E.LeftOuterJoin` submission) -> sheet E.^. SheetActiveFrom
)
, ( "submission-until"
, SortColumn $ \sheet -> sheet E.^. SheetActiveTo
, SortColumn $ \(sheet `E.LeftOuterJoin` submission) -> sheet E.^. SheetActiveTo
)
]
, dbtFilter = Map.fromList

16
templates/widgets/rating.hamlet Normal file
View File

@ -0,0 +1,16 @@
$# Display Rating, expects
$# submissionRatingPoints :: Maybe points
$maybe points <- submissionRatingPoints
$case sheetType
$of Bonus{..}
_{MsgAchievedOf points maxPoints}
$of Normal{..}
_{MsgAchievedOf points maxPoints}
$of Pass{..}
$if points >= passingPoints
_{MsgPassed}
$else
_{MsgNotPassed}
$of NotGraded
#{show tickmark}