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

ChangeLog.md

@@ -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

messages/de.msg

@@ -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}.

src/Handler/Corrections.hs

@@ -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 $
+        $ \DBRow{ dbrOutput=(_, sheet, course, _, _) } ->
-          let tid = course ^. _3
+          let tid   = course ^. _3
-              csh = course ^. _2
+              csh   = course ^. _2
-              shn = sheetName $ entityVal sheet
+              shn   = sheetName $ entityVal sheet
-          in [whamlet|<a href=@{CSheetR tid csh shn SShowR}>#{display shn}|]
+          in anchorCell (CSheetR tid csh shn SShowR) [whamlet|#{display shn}|]
-          -- textCell $ sheetName $ entityVal sheet
 
 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)
+              mkCid = encrypt (entityKey submission :: SubmissionId) -- TODO: executed twice
-          [whamlet|<a href=@{CSubmissionR tid csh shn cid SubShowR}>#{display cid}|]
+              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

src/Handler/Sheet.hs

@@ -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 :: 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 = do
+    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
+          $ \(_, E.Value mEditTime, _) -> case mEditTime of
-          Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget
+            Just editTime -> cell $ formatTime SelFormatDateTime (editTime :: UTCTime) >>= toWidget
-          Nothing -> mempty
+            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

templates/widgets/rating.hamlet

@@ -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}