diff --git a/messages/de.msg b/messages/de.msg
index d7eb1b787..f22a70d21 100644
--- a/messages/de.msg
+++ b/messages/de.msg
@@ -124,3 +124,8 @@ SelectColumn: Auswahl
CorrDownload: Herunterladen
CorrSetCorrector: Korrektor zuweisen
NatField xyz@Text: #{xyz} muss eine natürliche Zahl sein!
+
+SubmissionsAlreadyAssigned: Folgende Abgaben waren bereits einem Korrektor zugeteilt und wurden nicht verändert:
+UpdatedAssignedCorrectors num@Int64: #{display num} Abgaben wurden dem neuen Korrektor zugeteilt.
+NoCorrector: Kein Korrektor
+RemovedCorrections num@Int64: Korrektur-Daten wurden von #{display num} Abgaben entfernt.
\ No newline at end of file
diff --git a/src/Foundation.hs b/src/Foundation.hs
index c4e22c72e..a8230a582 100644
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@@ -629,6 +629,12 @@ pageActions (CourseR tid csh CShowR) =
return (sheets,lecturer)
or2M (return lecturer) $ anyM sheets sheetRouteAccess
}
+ , PageActionPrime $ MenuItem
+ { menuItemLabel = "Abgaben"
+ , menuItemIcon = Nothing
+ , menuItemRoute = CourseR tid csh CourseCorrectionsR
+ , menuItemAccessCallback' = return True
+ }
, PageActionSecondary $ MenuItem
{ menuItemLabel = "Neues Übungsblatt anlegen"
, menuItemIcon = Nothing
diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs
index 5b3537b00..2021c54a6 100644
--- a/src/Handler/Corrections.hs
+++ b/src/Handler/Corrections.hs
@@ -1,9 +1,9 @@
{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE MultiWayIf, LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecordWildCards, NamedFieldPuns, TupleSections #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
@@ -48,6 +48,11 @@ import Control.Lens
import Web.PathPieces
+import Text.Hamlet (ihamletFile)
+import Text.Blaze.Html (preEscapedToHtml)
+
+import Database.Persist.Sql (updateWhereCount)
+
type CorrectionsWhere = forall query expr backend . (E.Esqueleto query expr backend) =>
@@ -61,24 +66,24 @@ courseIs :: Key Course -> CorrectionsWhere
courseIs cid (course,_sheet,_submission) = course E.^. CourseId E.==. E.val cid
-type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (E.Value Text, E.Value Text, E.Value (Key Term), E.Value (Key School)))
+type CorrectionTableData = DBRow (Entity Submission, Entity Sheet, (E.Value Text, E.Value Text, E.Value (Key Term), E.Value (Key School)), Maybe (Entity User))
colTerm :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colTerm = sortable (Just "term") (i18nCell MsgTerm)
- $ \DBRow{ dbrOutput=(_, _, course) } ->
+ $ \DBRow{ dbrOutput=(_, _, course, _) } ->
-- cell [whamlet| _{untermKey $ course ^. _3}|] -- lange, internationale Semester
textCell $ termToText $ unTermKey $ E.unValue $ course ^. _3 -- kurze Semsterkürzel
colCourse :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
colCourse = sortable (Just "course") (i18nCell MsgCourse)
- $ \DBRow{ dbrOutput=(_, _, course) } -> cell $
+ $ \DBRow{ dbrOutput=(_, _, course, _) } -> cell $
let tid = E.unValue $ course ^. _3
csh = E.unValue $ course ^. _2
in [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, _) } -> cell $
let tid = E.unValue $ course ^. _3
csh = E.unValue $ course ^. _2
shn = sheetName $ entityVal sheet
@@ -86,13 +91,13 @@ colSheet = sortable (Just "sheet") (i18nCell MsgSheet)
-- textCell $ sheetName $ entityVal sheet
colCorrector :: IsDBTable m a => Colonnade _ CorrectionTableData (DBCell m a)
-colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector)
- $ \DBRow{ dbrOutput=(submission, _, _) } ->
- textCell $ display $ submissionRatingBy $ entityVal submission
+colCorrector = sortable (Just "corrector") (i18nCell MsgCorrector) $ \case
+ DBRow{ dbrOutput = (_, _, _, Nothing) } -> cell mempty
+ DBRow{ dbrOutput = (_, _, _, Just corr) } -> textCell . display . userDisplayName $ entityVal corr
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, _) } -> cell $ do
let tid = E.unValue $ course ^. _3
csh = E.unValue $ course ^. _2
shn = sheetName $ entityVal sheet
@@ -100,16 +105,14 @@ colSubmissionLink = sortable Nothing (i18nCell MsgSubmission)
[whamlet|#{display cid}|]
colSelect :: Colonnade _ CorrectionTableData (DBCell _ (FormResult (DBFormResult CorrectionTableData CryptoFileNameSubmission Bool)))
-colSelect = dbSelect id $ \DBRow{ dbrOutput=(Entity subId _, _, _) } -> encrypt subId
+colSelect = dbSelect id $ \DBRow{ dbrOutput=(Entity subId _, _, _, _) } -> encrypt subId
makeCorrectionsTable :: ( IsDBTable m x, DBOutput CorrectionTableData r', ToSortable h, Functor h )
=> _ -> Colonnade h r' (DBCell m x) -> Handler (DBResult m x)
makeCorrectionsTable whereClause colChoices = do
- let tableData :: E.InnerJoin (E.InnerJoin (E.SqlExpr (Entity Course))
- (E.SqlExpr (Entity Sheet )))
- (E.SqlExpr (Entity Submission))
- -> E.SqlQuery _
- tableData (course `E.InnerJoin` sheet `E.InnerJoin` submission) = do
+ let tableData :: (E.SqlExpr (Entity Course) `E.InnerJoin` E.SqlExpr (Entity Sheet) `E.InnerJoin` E.SqlExpr (Entity Submission)) `E.LeftOuterJoin` E.SqlExpr (Maybe (Entity User)) -> E.SqlQuery _
+ tableData ((course `E.InnerJoin` sheet `E.InnerJoin` submission) `E.LeftOuterJoin` corrector) = do
+ E.on $ corrector E.?. UserId E.==. submission E.^. SubmissionRatingBy
E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet
E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
E.where_ $ whereClause (course,sheet,submission)
@@ -118,15 +121,15 @@ makeCorrectionsTable whereClause colChoices = do
, course E.^. CourseTerm
, course E.^. CourseSchool :: E.SqlExpr (E.Value SchoolId)
)
- return (submission, sheet, crse)
+ return (submission, sheet, crse, corrector)
dbTable def $ DBTable
{ dbtSQLQuery = tableData
, dbtColonnade = colChoices
, dbtSorting = [ ( "term"
- , SortColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) -> course E.^. CourseTerm
+ , SortColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _) -> course E.^. CourseTerm
)
, ( "course"
- , SortColumn $ \(course `E.InnerJoin` _ `E.InnerJoin` _ ) -> course E.^. CourseShorthand
+ , SortColumn $ \((course `E.InnerJoin` _ `E.InnerJoin` _) `E.LeftOuterJoin` _) -> course E.^. CourseShorthand
)
-- TODO
]
@@ -152,7 +155,7 @@ instance RenderMessage UniWorX ActionCorrections where
renderMessage m ls CorrSetCorrector = renderMessage m ls MsgCorrSetCorrector
data ActionCorrectionsData = CorrDownloadData
- | CorrSetCorrectorData UserId
+ | CorrSetCorrectorData (Maybe UserId)
correctionsR :: _ -> _ -> Map ActionCorrections (MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Widget)) -> Handler TypedContent
correctionsR whereClause (formColonnade -> displayColumns) actions = do
@@ -167,11 +170,31 @@ correctionsR whereClause (formColonnade -> displayColumns) actions = do
FormFailure errs -> mapM_ (addMessage "danger" . toHtml) errs
FormMissing -> return ()
FormSuccess (CorrDownloadData, subs) -> do
- (Set.fromList -> ids) <- forM (Set.toList subs) decrypt
+ ids <- Set.fromList <$> forM (Set.toList subs) decrypt -- Set is not traversable
addHeader "Content-Disposition" "attachment; filename=\"corrections.zip\""
sendResponse =<< submissionMultiArchive ids
- FormSuccess (CorrSetCorrectorData uid, subs) -> do
- addMessage "danger" $ "Setting correctors not implemented yet" -- TODO
+ FormSuccess (CorrSetCorrectorData (Just uid), subs') -> do
+ subs <- mapM decrypt $ Set.toList subs'
+ runDB $ do
+ alreadyAssigned <- selectList [SubmissionId <-. subs, SubmissionRatingBy !=. Nothing] []
+ when (not $ null alreadyAssigned) $ do
+ mr <- (toHtml . ) <$> getMessageRender
+ alreadyAssigned' <- forM alreadyAssigned $ \Entity{..} -> (, entityVal) <$> (encrypt entityKey :: DB CryptoFileNameSubmission)
+ addMessage "warn" =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsAlreadyAssigned.hamlet") mr)
+ let unassigned = Set.fromList subs `Set.difference` Set.fromList (entityKey <$> alreadyAssigned)
+ when (not $ null unassigned) $ do
+ num <- updateWhereCount [SubmissionId <-. Set.toList unassigned] [SubmissionRatingBy =. Just uid]
+ addMessageI "success" $ MsgUpdatedAssignedCorrectors num
+ redirect currentRoute
+ FormSuccess (CorrSetCorrectorData Nothing, subs') -> do
+ subs <- mapM decrypt $ Set.toList subs'
+ runDB $ do
+ num <- updateWhereCount [SubmissionId <-. subs] [ SubmissionRatingPoints =. Nothing
+ , SubmissionRatingComment =. Nothing
+ , SubmissionRatingBy =. Nothing
+ , SubmissionRatingTime =. Nothing
+ ]
+ addMessageI "success" $ MsgRemovedCorrections num
redirect currentRoute
fmap toTypedContent . defaultLayout $ do
@@ -186,10 +209,26 @@ downloadAction = ( CorrDownload
, return (pure CorrDownloadData, mempty)
)
-assignAction :: ActionCorrections'
-assignAction = ( CorrSetCorrector
- , return (pure undefined, mempty) -- TODO
- )
+assignAction :: CourseId -> ActionCorrections'
+assignAction cId = ( CorrSetCorrector
+ , do
+ correctors <- liftHandlerT . runDB . E.select . E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` sheetCorrector `E.InnerJoin` user) -> do
+ E.on $ user E.^. UserId E.==. sheetCorrector E.^. SheetCorrectorUser
+ E.on $ sheet E.^. SheetId E.==. sheetCorrector E.^. SheetCorrectorSheet
+ E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse
+
+ E.where_ $ course E.^. CourseId E.==. E.val cId
+
+ return user
+
+ mr <- getMessageRender
+
+ correctors' <- fmap ((mr MsgNoCorrector, Nothing) :) . forM correctors $ \Entity{ entityKey, entityVal = User{..} } -> (display userDisplayName, ) . Just <$> encrypt entityKey
+
+ ($ mempty) . renderAForm FormStandard . wFormToAForm $ do
+ cId <- wreq (selectFieldList correctors' :: Field (HandlerT UniWorX IO) (Maybe CryptoUUIDUser)) (fslI MsgCorrector) Nothing
+ fmap CorrSetCorrectorData <$> (traverse.traverse) decrypt cId
+ )
getCorrectionsR, postCorrectionsR :: Handler TypedContent
getCorrectionsR = postCorrectionsR
@@ -211,8 +250,8 @@ postCorrectionsR = do
getCourseCorrectionsR, postCourseCorrectionsR :: TermId -> Text -> Handler TypedContent
getCourseCorrectionsR = postCourseCorrectionsR
postCourseCorrectionsR tid csh = do
- cid <- runDB $ getBy404 $ CourseTermShort tid csh
- let whereClause = courseIs $ entityKey cid
+ Entity cid _ <- runDB $ getBy404 $ CourseTermShort tid csh
+ let whereClause = courseIs cid
colonnade = mconcat
[ colSelect
, dbRow
@@ -222,5 +261,5 @@ postCourseCorrectionsR tid csh = do
] -- Continue here
correctionsR whereClause colonnade $ Map.fromList
[ downloadAction
- , assignAction
+ , assignAction cid
]
diff --git a/templates/messages/submissionsAlreadyAssigned.hamlet b/templates/messages/submissionsAlreadyAssigned.hamlet
new file mode 100644
index 000000000..b7af031e8
--- /dev/null
+++ b/templates/messages/submissionsAlreadyAssigned.hamlet
@@ -0,0 +1,5 @@
+_{MsgSubmissionsAlreadyAssigned}
+
+
+ $forall (cID, _) <- alreadyAssigned'
+ #{toPathPiece cID}