Automatisierte Korrektur-Zuteilung

messages/de.msg

@@ -123,9 +123,12 @@ SelectColumn: Auswahl
 
 CorrDownload: Herunterladen
 CorrSetCorrector: Korrektor zuweisen
+CorrAutoSetCorrector: Korrekturen verteilen
 NatField xyz@Text: #{xyz} muss eine natürliche Zahl sein!
 
-SubmissionsAlreadyAssigned: Folgende Abgaben waren bereits einem Korrektor zugeteilt und wurden nicht verändert:
+SubmissionsAlreadyAssigned num@Int64: #{display num} Abgaben waren bereits einem Korrektor zugeteilt und wurden nicht verändert:
-UpdatedAssignedCorrectors num@Int64: #{display num} Abgaben wurden dem neuen Korrektor zugeteilt.
+UpdatedAssignedCorrectorSingle num@Int64: #{display num} Abgaben wurden dem neuen Korrektor zugeteilt.
 NoCorrector: Kein Korrektor
 RemovedCorrections num@Int64: Korrektur-Daten wurden von #{display num} Abgaben entfernt.
+UpdatedAssignedCorrectorsAuto num@Int64: #{display num} Abgaben wurden unter den Korrektoren aufgeteilt.
+CouldNotAssignCorrectorsAuto num@Int64: #{display num} Abgaben konnten nicht automatisch zugewiesen werden:

src/Handler/Corrections.hs

@@ -54,6 +54,8 @@ import Text.Blaze.Html (preEscapedToHtml)
 
 import Database.Persist.Sql (updateWhereCount)
 
+import Data.List (genericLength)
+
 
 
 type CorrectionsWhere = forall query expr backend . (E.Esqueleto query expr backend) =>
@@ -172,6 +174,7 @@ makeCorrectionsTable whereClause colChoices psValidator = do
 
 data ActionCorrections = CorrDownload
                        | CorrSetCorrector
+                       | CorrAutoSetCorrector
   deriving (Eq, Ord, Read, Show, Enum, Bounded)
 instance PathPiece ActionCorrections where
   fromPathPiece = readFromPathPiece
@@ -180,9 +183,11 @@ instance PathPiece ActionCorrections where
 instance RenderMessage UniWorX ActionCorrections where
   renderMessage m ls CorrDownload = renderMessage m ls MsgCorrDownload
   renderMessage m ls CorrSetCorrector = renderMessage m ls MsgCorrSetCorrector
+  renderMessage m ls CorrAutoSetCorrector = renderMessage m ls MsgCorrAutoSetCorrector
 
 data ActionCorrectionsData = CorrDownloadData
                            | CorrSetCorrectorData (Maybe UserId)
+                           | CorrAutoSetCorrectorData SheetId
 
 correctionsR :: _ -> _ -> _ -> Map ActionCorrections (MForm (HandlerT UniWorX IO) (FormResult ActionCorrectionsData, Widget)) -> Handler TypedContent
 correctionsR whereClause (formColonnade -> displayColumns) psValidator actions = do
@@ -211,7 +216,7 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
         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
+          addMessageI "success" $ MsgUpdatedAssignedCorrectorSingle num
       redirect currentRoute
     FormSuccess (CorrSetCorrectorData Nothing, subs') -> do
       subs <- mapM decrypt $ Set.toList subs'
@@ -223,6 +228,24 @@ correctionsR whereClause (formColonnade -> displayColumns) psValidator actions =
                                                         ]
         addMessageI "success" $ MsgRemovedCorrections num
       redirect currentRoute
+    FormSuccess (CorrAutoSetCorrectorData shid, 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
+          (assigned, unassigned) <- assignSubmissions shid (Just unassigned)
+          when (not $ null assigned) $
+            addMessageI "success" $ MsgUpdatedAssignedCorrectorsAuto (fromIntegral $ Set.size assigned)
+          when (not $ null unassigned) $ do
+            mr <- (toHtml . ) <$> getMessageRender
+            unassigned' <- forM (Set.toList unassigned) $ \sid -> (encrypt sid :: DB CryptoFileNameSubmission) 
+            addMessage "warn" =<< withUrlRenderer ($(ihamletFile "templates/messages/submissionsNotAssignedAuto.hamlet") mr)
+      redirect currentRoute
 
   fmap toTypedContent . defaultLayout $ do
     setTitleI MsgCourseCorrectionsTitle
@@ -257,6 +280,11 @@ assignAction selId = ( CorrSetCorrector
                             fmap CorrSetCorrectorData <$> (traverse.traverse) decrypt cId
                      )
 
+autoAssignAction :: SheetId -> ActionCorrections'
+autoAssignAction shid = ( CorrAutoSetCorrector
+                        , return (pure $ CorrAutoSetCorrectorData shid, mempty)
+                        )
+
 getCorrectionsR, postCorrectionsR :: Handler TypedContent
 getCorrectionsR = postCorrectionsR
 postCorrectionsR = do
@@ -310,4 +338,5 @@ postSSubsR tid csh shn = do
   correctionsR whereClause colonnade psValidator $ Map.fromList
     [ downloadAction
     , assignAction (Right shid)
+    , autoAssignAction shid
     ]

templates/messages/submissionsAlreadyAssigned.hamlet

@@ -1,4 +1,4 @@
-_{MsgSubmissionsAlreadyAssigned}
+_{MsgSubmissionsAlreadyAssigned (genericLength alreadyAssigned')}
 
 <ul>
   $forall (cID, _) <- alreadyAssigned'

templates/messages/submissionsNotAssignedAuto.hamlet

@@ -0,0 +1,5 @@
+_{MsgCouldNotAssignCorrectorsAuto (genericLength unassigned')}
+
+<ul>
+  $forall cID <- unassigned'
+    <li><pre>#{toPathPiece cID}