Merge branch 'master' into 184-replace-displayable-by-rendermessage

.directory

@@ -1,5 +1,5 @@
 [Dolphin]
-Timestamp=2018,3,14,10,57,55
+Timestamp=2019,6,26,19,32,25
 Version=4
 
 [Settings]

.vscode/tasks.json

@@ -14,6 +14,7 @@
         "reveal": "always",
         "focus": false,
         "panel": "dedicated",
+        "clear": true,
         "showReuseMessage": false
       }
     },

messages/uniworx/de.msg

@@ -34,6 +34,12 @@ GenericShort: Kürzel
 GenericIsNew: Neu
 GenericHasConflict: Konflikt
 GenericBack: Zurück
+GenericChange: Änderung
+GenericNumChange: +/-
+GenericMin: Min
+GenericAvg: Avg
+GenericMax: Max
+GenericAll: Insgesamt
 
 SummerTerm year@Integer: Sommersemester #{year}
 WinterTerm year@Integer: Wintersemester #{year}/#{succ year}
@@ -157,7 +163,7 @@ SheetEditOk        tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetNa
 SheetNameDup       tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: Es gibt bereits ein Übungsblatt #{sheetName} in diesem Kurs #{tid}-#{ssh}-#{csh}
 SheetDelHead       tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{sheetName} wirklich aus Kurs #{tid}-#{ssh}-#{csh} herauslöschen? Alle assoziierten Abgaben und Korrekturen gehen ebenfalls verloren!
 SheetDelOk         tid@TermId ssh@SchoolId csh@CourseShorthand sheetName@SheetName: #{tid}-#{ssh}-#{csh}: #{sheetName} gelöscht.
-SheetDelHasSubmissions objs@Int: Inkl. #{tshow objs} #{pluralDE objs "Abgabe" "Abgaben"}!
+SheetDelHasSubmissions objs@Int: Inkl. #{objs} #{pluralDE objs "Abgabe" "Abgaben"}!
 
 SheetDeleteQuestion: Wollen Sie das unten aufgeführte Übungsblatt und alle zugehörigen Abgaben wirklich löschen?
 SheetDeleted: Übungsblatt gelöscht
@@ -197,6 +203,7 @@ SheetErrHintEarly: Hinweise dürfen erst nach Beginn des Abgabezeitraums herausg
 SheetErrSolutionEarly: Lösungen dürfen erst nach Ende der Abgabezeitraums herausgegeben werden
 SheetNoCurrent: Es gibt momentan kein aktives Übungsblatt.
 SheetNoOldUnassigned: Alle Abgaben inaktiver Blätter sind bereits einen Korrektor zugeteilt.
+SheetsUnassignable name@Text: Momentan keine Abgaben zuteilbar für #{name}
 
 Deadline: Abgabe
 Done: Eingereicht
@@ -249,7 +256,7 @@ MaterialEditTitle materialName@MaterialName: Material "#{materialName}" editiere
 MaterialSaveOk  tid@TermId ssh@SchoolId csh@CourseShorthand materialName@MaterialName: Material "#{materialName}" erfolgreich gespeichert in Kurs #{tid}-#{ssh}-#{csh}
 MaterialNameDup tid@TermId ssh@SchoolId csh@CourseShorthand materialName@MaterialName: Es gibt bereits Material mit Namen "#{materialName}" in diesem Kurs #{tid}-#{ssh}-#{csh}
 MaterialDeleteCaption: Wollen Sie das unten aufgeführte Material wirklich löschen?
-MaterialDelHasFiles count@Int64: inklusive #{tshow count} #{pluralDE count "Datei" "Dateien"}
+MaterialDelHasFiles count@Int64: inklusive #{count} #{pluralDE count "Datei" "Dateien"}
 MaterialIsVisible: Achtung, dieses Material wurde bereits veröffentlicht.
 MaterialDeleted materialName@MaterialName: Material "#{materialName}" gelöscht
 
@@ -316,6 +323,7 @@ Correctors: Korrektoren
 CorState: Status
 CorByTut: Zuteilung nach Tutorium
 CorProportion: Anteil
+CorDeficitProportion: Defizit Anteile
 CorByProportionOnly proportion@Rational: #{rationalToFixed3 proportion} Anteile
 CorByProportionIncludingTutorial proportion@Rational: #{rationalToFixed3 proportion} Anteile - Tutorium
 CorByProportionExcludingTutorial proportion@Rational: #{rationalToFixed3 proportion} Anteile + Tutorium
@@ -391,6 +399,8 @@ UpdatedAssignedCorrectorSingle num@Int64: #{num} Abgaben wurden dem neuen Korrek
 NoCorrector: Kein Korrektor
 RemovedCorrections num@Int64: Korrektur-Daten wurden von #{num} Abgaben entfernt.
 UpdatedAssignedCorrectorsAuto num@Int64: #{num} Abgaben wurden unter den Korrektoren aufgeteilt.
+UpdatedSheetCorrectorsAutoAssigned n@Int: #{n} #{pluralDE n "Abgabe wurde einem Korrektor" "Abgaben wurden Korrektoren"} zugteilt.
+UpdatedSheetCorrectorsAutoFailed n@Int: #{n} #{pluralDE n "Abgabe konnte" "Abgaben konnten"} nicht automatisch zugewiesen werden.
 CouldNotAssignCorrectorsAuto num@Int64: #{num} Abgaben konnten nicht automatisch zugewiesen werden:
 SelfCorrectors num@Int64: #{num} Abgaben wurden Abgebenden als eigenem Korrektor zugeteilt!
 
@@ -399,16 +409,18 @@ CorrectionSheets: Übersicht Korrekturen nach Blättern
 CorrectionCorrectors: Übersicht Korrekturen nach Korrektoren
 AssignSubmissionExceptionNoCorrectors: Es sind keine Korrektoren eingestellt
 AssignSubmissionExceptionNoCorrectorsByProportion: Es sind keine Korrektoren mit Anteil ungleich Null eingestellt
-AssignSubmissionExceptionSubmissionsNotFound n@Int: #{tshow n} Abgaben konnten nicht gefunden werden
+AssignSubmissionExceptionSubmissionsNotFound n@Int: #{n} Abgaben konnten nicht gefunden werden
 NrSubmittorsTotal: Abgebende
 NrSubmissionsTotal: Abgaben
+NrSubmissionsTotalShort: Abg.
 NrSubmissionsUnassigned: Ohne Korrektor
 NoCorrectorAssigned: Ohne Korrektor
 NrCorrectors: Korrektoren
 NrSubmissionsNewlyAssigned: Neu zugeteilt
 NrSubmissionsNotAssigned: Nicht zugeteilt
 NrSubmissionsNotCorrected: Unkorrigiert
-CorrectionTime: Korrekturdauer (Min/Avg/Max)
+NrSubmissionsNotCorrectedShort: Unkg.
+CorrectionTime: Korrekturdauer
 AssignSubmissionsRandomWarning: Die Zuteilungsvorschau kann von der tatsächlichen Zuteilung abweichen, wenn mehrere Blätter auf einmal zugeteilt werden, da beim Ausgleich der Kontigente nur bereits zugeteilte Abgaben berücksichtigt werden. Da es ein randomisierte Prozess ist, kann es auch bei einzelnen Blättern gerinfgügige Abweichungen geben.
 
 CorrectionsUploaded num@Int64: #{num} Korrekturen wurden gespeichert:
@@ -464,6 +476,7 @@ RatingNegative: Bewertungspunkte dürfen nicht negativ sein
 RatingExceedsMax: Bewertung übersteigt die erlaubte Maximalpunktzahl
 RatingNotExpected: Keine Bewertungen erlaubt
 RatingBinaryExpected: Bewertung muss 0 (=durchgefallen) oder 1 (=bestanden) sein
+RatingPointsRequired: Bewertung erfordert für dieses Blatt eine Punktzahl
 
 SubmissionSinkExceptionDuplicateFileTitle file@FilePath: Dateiname #{show file} kommt mehrfach im Zip-Archiv vor
 SubmissionSinkExceptionDuplicateRating: Mehr als eine Bewertung gefunden.
@@ -642,8 +655,8 @@ MailSubjectTutorInvitation tid@TermId ssh@SchoolId csh@CourseShorthand tutn@Tuto
 MailSubjectSubmissionUserInvitation tid@TermId ssh@SchoolId csh@CourseShorthand shn@SheetName: [#{tid}-#{ssh}-#{csh}] Einladung zu einer Abgabe für #{shn}
 
 SheetGrading: Bewertung
-SheetGradingPoints maxPoints@Points: #{tshow maxPoints} Punkte
+SheetGradingPoints maxPoints@Points: #{maxPoints} Punkte
-SheetGradingPassPoints maxPoints@Points passingPoints@Points: Bestanden ab #{tshow passingPoints} von #{tshow maxPoints} Punkten
+SheetGradingPassPoints maxPoints@Points passingPoints@Points: Bestanden ab #{passingPoints} von #{maxPoints} Punkten
 SheetGradingPassBinary:  Bestanden/Nicht Bestanden
 SheetGradingInfo: "Bestanden nach Punkten" zählt sowohl zur maximal erreichbaren Gesamtpunktzahl also auch zur Anzahl der zu bestehenden Blätter.
 
@@ -831,6 +844,7 @@ MenuCourseDelete: Kurs löschen
 MenuSubmissionNew: Abgabe anlegen
 MenuSubmissionOwn: Abgabe
 MenuCorrectors: Korrektoren
+MenuCorrectorsChange: Korrektoren ändern
 MenuSheetEdit: Übungsblatt editieren
 MenuSheetDelete: Übungsblatt löschen
 MenuSheetClone:  Als neues Übungsblatt klonen
@@ -889,8 +903,8 @@ CommSubject: Betreff
 CommBody: Nachricht
 CommRecipients: Empfänger
 CommRecipientsTip: Sie selbst erhalten immer eine Kopie der Nachricht
-CommDuplicateRecipients n@Int: #{tshow n} #{pluralDE n "doppelter" "doppelte"} Empfänger ignoriert
+CommDuplicateRecipients n@Int: #{n} #{pluralDE n "doppelter" "doppelte"} Empfänger ignoriert
-CommSuccess n@Int: Nachricht wurde an #{tshow n} Empfänger versandt
+CommSuccess n@Int: Nachricht wurde an #{n} Empfänger versandt
 
 CommCourseHeading: Kursmitteilung
 CommTutorialHeading: Tutorium-Mitteilung
@@ -981,7 +995,7 @@ TutorialDelete: Löschen
 
 CourseTutorials: Übungen
 
-ParticipantsN n@Int: #{tshow n} Teilnehmer
+ParticipantsN n@Int: #{n} Teilnehmer
 TutorialDeleteQuestion: Wollen Sie das unten aufgeführte Tutorium wirklich löschen?
 TutorialDeleted: Tutorium gelöscht
 
@@ -1017,9 +1031,9 @@ HealthLDAPAdmins: Anteil der Administratoren, die im LDAP-Verzeichnis gefunden w
 HealthSMTPConnect: SMTP-Server kann erreicht werden
 HealthWidgetMemcached: Memcached-Server liefert Widgets korrekt aus
 
-CourseParticipants n@Int: Derzeit #{tshow n} angemeldete Kursteilnehmer
+CourseParticipants n@Int: Derzeit #{n} angemeldete Kursteilnehmer
-CourseParticipantsInvited n@Int: #{tshow n} #{pluralDE n "Einladung" "Einladungen"} per E-Mail verschickt
+CourseParticipantsInvited n@Int: #{n} #{pluralDE n "Einladung" "Einladungen"} per E-Mail verschickt
-CourseParticipantsAlreadyRegistered n@Int: #{tshow n} Teilnehmer #{pluralDE n "ist" "sind"} bereits angemeldet
+CourseParticipantsAlreadyRegistered n@Int: #{n} Teilnehmer #{pluralDE n "ist" "sind"} bereits angemeldet
-CourseParticipantsRegisteredWithoutField n@Int: #{tshow n} Teilnehmer #{pluralDE n "wurde ohne assoziiertes Hauptfach" "wurden assoziierte Hauptfächer"} angemeldet, da #{pluralDE n "kein eindeutiges Hauptfach bestimmt werden konnte" "keine eindeutigen Hauptfächer bestimmt werden konnten"}
+CourseParticipantsRegisteredWithoutField n@Int: #{n} Teilnehmer #{pluralDE n "wurde ohne assoziiertes Hauptfach" "wurden assoziierte Hauptfächer"} angemeldet, da #{pluralDE n "kein eindeutiges Hauptfach bestimmt werden konnte" "keine eindeutigen Hauptfächer bestimmt werden konnten"}
-CourseParticipantsRegistered n@Int: #{tshow n} Teilnehmer erfolgreich angemeldet
+CourseParticipantsRegistered n@Int: #{n} Teilnehmer erfolgreich angemeldet
 CourseParticipantsRegisterHeading: Kursteilnehmer hinzufügen

shell.nix

@@ -1,8 +1,7 @@
-{ nixpkgs ? import <nixpkgs>, compiler ? null }:
+{ nixpkgs ? import <nixpkgs> }:
 
 let
-  inherit (nixpkgs {}) pkgs;
+  haskellPackages = import ./stackage.nix { inherit nixpkgs; };
-  haskellPackages = if isNull compiler then pkgs.haskellPackages else pkgs.haskell.packages."${compiler}";
 
   drv = haskellPackages.callPackage ./uniworx.nix {};
 
@@ -19,7 +18,7 @@ let
   '';
 
   override = oldAttrs: {
-    nativeBuildInputs = oldAttrs.nativeBuildInputs ++ (with pkgs; [ postgresql pgadmin openldap ]) ++ (with haskellPackages; [ stack yesod-bin hlint cabal-install ]);
+    nativeBuildInputs = oldAttrs.nativeBuildInputs ++ (with pkgs; [ nodejs-8_x postgresql pgadmin openldap ]) ++ (with haskellPackages; [ stack yesod-bin hlint cabal-install ]);
     shellHook = ''
       export PROMPT_INFO="${oldAttrs.name}"
 

src/Database/Esqueleto/Utils.hs

@@ -2,6 +2,7 @@
 
 module Database.Esqueleto.Utils
   ( true, false
+  , isJust
   , isInfixOf, hasInfix
   , any, all
   , SqlIn(..)
@@ -11,7 +12,7 @@ module Database.Esqueleto.Utils
   , anyFilter, allFilter
   ) where
 
-import ClassyPrelude.Yesod hiding (isInfixOf, any, all)
+import ClassyPrelude.Yesod hiding (isInfixOf, any, all, isJust)
 import qualified Data.Set as Set
 import qualified Data.Foldable as F
 import qualified Database.Esqueleto as E
@@ -34,6 +35,10 @@ true  = E.val True
 false :: E.SqlExpr (E.Value Bool)
 false = E.val False
 
+-- | Negation of `isNothing` which is missing
+isJust :: (E.Esqueleto query expr backend, PersistField typ) => expr (E.Value (Maybe typ)) -> expr (E.Value Bool)
+isJust = E.not_ . E.isNothing
+
 -- | Check if the first string is contained in the text derived from the second argument
 isInfixOf :: (E.Esqueleto query expr backend, E.SqlString s2) =>
    Text -> expr (E.Value s2) -> expr (E.Value Bool)

src/Foundation.hs

@@ -191,6 +191,15 @@ noneOneMoreDE num noneText singularForm pluralForm
   | num == 1  = singularForm
   | otherwise = pluralForm
 
+noneMoreDE :: (Eq a, Num a)
+            =>    a -- ^ Count
+            -> Text -- ^ None
+            -> Text -- ^ Some
+            -> Text
+noneMoreDE num noneText someText
+  | num == 0  = noneText
+  | otherwise = someText
+
 -- Convenience Type for Messages, since Yesod messages cannot deal with compound type identifiers
 type IntMaybe  = Maybe Int
 type TextList  = [Text]
@@ -1446,7 +1455,7 @@ instance YesodBreadcrumbs UniWorX where
   breadcrumb (CourseR tid ssh csh CInviteR)   = return ("Einladung", Just $ CourseR tid ssh csh CShowR)
   breadcrumb (CourseR tid ssh csh (CUserR _)) = return ("Teilnehmer" , Just $ CourseR tid ssh csh CUsersR)
   breadcrumb (CourseR tid ssh csh CCorrectionsR) = return ("Abgaben" , Just $ CourseR tid ssh csh CShowR)
-  breadcrumb (CourseR tid ssh csh CAssignR)   = return ("Zuteilung"  , Just $ CourseR tid ssh csh CCorrectionsR)
+  breadcrumb (CourseR tid ssh csh CAssignR)   = return ("Zuteilung Korrekturen"  , Just $ CourseR tid ssh csh CCorrectionsR)
   breadcrumb (CourseR tid ssh csh SheetListR) = return ("Übungen"    , Just $ CourseR tid ssh csh CShowR)
   breadcrumb (CourseR tid ssh csh SheetNewR ) = return ("Neu",         Just $ CourseR tid ssh csh SheetListR)
   breadcrumb (CourseR tid ssh csh SheetCurrentR) = return ("Aktuelles Blatt", Just $ CourseR tid ssh csh SheetListR)
@@ -1464,7 +1473,7 @@ instance YesodBreadcrumbs UniWorX where
   breadcrumb (CSheetR tid ssh csh shn SEditR)   = return ("Bearbeiten"   , Just $ CSheetR tid ssh csh shn SShowR)
   breadcrumb (CSheetR tid ssh csh shn SDelR )   = return ("Löschen"      , Just $ CSheetR tid ssh csh shn SShowR)
   breadcrumb (CSheetR tid ssh csh shn SSubsR)   = return ("Abgaben"      , Just $ CSheetR tid ssh csh shn SShowR)
-  breadcrumb (CSheetR tid ssh csh shn SAssignR) = return ("Zuteilen"     , Just $ CSheetR tid ssh csh shn SSubsR)
+  breadcrumb (CSheetR tid ssh csh shn SAssignR) = return ("Zuteilung Korrekturen"     , Just $ CSheetR tid ssh csh shn SSubsR)
   breadcrumb (CSheetR tid ssh csh shn SubmissionNewR)  = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR)
   breadcrumb (CSheetR tid ssh csh shn SubmissionOwnR)  = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR)
   breadcrumb (CSubmissionR tid ssh csh shn _ SubShowR) = return ("Abgabe", Just $ CSheetR tid ssh csh shn SShowR)

src/Handler/Corrections.hs

@@ -337,13 +337,13 @@ makeCorrectionsTable whereClause dbtColonnade dbtFilterUI psValidator dbtProj' d
       , ( "isassigned"
         , FilterColumn $  \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) criterion -> case getLast (criterion :: Last Bool) of
             Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
-            Just True -> E.not_ . E.isNothing $ submission E.^. SubmissionRatingBy
+            Just True -> E.isJust    $ submission E.^. SubmissionRatingBy
             Just False-> E.isNothing $ submission E.^. SubmissionRatingBy
         )
       , ( "israted"
         , FilterColumn $  \((_ `E.InnerJoin` _ `E.InnerJoin` submission) `E.LeftOuterJoin` _ :: CorrectionTableExpr) criterion -> case getLast (criterion :: Last Bool) of
             Nothing -> E.val True :: E.SqlExpr (E.Value Bool)
-            Just True -> E.not_ . E.isNothing $ submission E.^. SubmissionRatingTime
+            Just True -> E.isJust    $ submission E.^. SubmissionRatingTime
             Just False-> E.isNothing $ submission E.^. SubmissionRatingTime
         )
       , ( "corrector-name-email" -- corrector filter does not work for text-filtering
@@ -710,12 +710,12 @@ postCorrectionR tid ssh csh shn cid = do
   results <- runDB $ correctionData tid ssh csh shn sub
 
   case results of
-    [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ Submission{..}, corrector)] -> do
+    [(Entity _ Course{..}, Entity _ Sheet{..}, Entity _ subm@Submission{..}, corrector)] -> do
       let ratingComment = fmap Text.strip submissionRatingComment >>= (\c -> c <$ guard (not $ null c))
           pointsForm = case sheetType of
             NotGraded  -> pure Nothing
             _otherwise -> aopt  (pointsFieldMax $ preview (_grading . _maxPoints) sheetType)
-                                (fslpI MsgRatingPoints "Punktezahl")
+                                (fslpI MsgRatingPoints "Punktezahl" & setTooltip sheetType)
                                 (Just submissionRatingPoints)
 
       ((corrResult, corrForm'), corrEncoding) <- runFormPost . identifyForm FIDcorrection . renderAForm FormStandard $ (,,)
@@ -734,22 +734,20 @@ postCorrectionR tid ssh csh shn cid = do
             , formEncoding = uploadEncoding
             }
 
-      case corrResult of
+      formResult corrResult $ \(rated, ratingPoints', ratingComment') -> do
-        FormMissing -> return ()
+        uid <- liftHandlerT requireAuthId
-        FormFailure errs -> mapM_ (addMessage Error . toHtml) errs
+        now <- liftIO getCurrentTime
-        FormSuccess (rated, ratingPoints', ratingComment') -> do
-          uid <- liftHandlerT requireAuthId
-          now <- liftIO getCurrentTime
 
-          if
+        if
-            | errs <- validateRating sheetType Rating'
+          | errs <- validateRating sheetType Rating'
-                        { ratingPoints  = ratingPoints'
+                      { ratingPoints  = ratingPoints'
-                        , ratingComment = ratingComment'
+                      , ratingComment = ratingComment'
-                        , ratingTime    = (now <$ guard rated)
+                      , ratingTime    = (now <$ guard rated)
-                        }
+                      }
-            , not $ null errs
+          , not $ null errs
-              -> mapM_ (addMessageI Error) errs
+            -> mapM_ (addMessageI Error) errs
-            | otherwise -> runDBJobs $ do
+          | otherwise -> do
+              runDBJobs $ do
                 update sub  [ SubmissionRatingBy      =. Just uid
                             , SubmissionRatingTime    =. (now <$ guard rated)
                             , SubmissionRatingPoints  =. ratingPoints'
@@ -761,25 +759,29 @@ postCorrectionR tid ssh csh shn cid = do
                 when (rated && isNothing submissionRatingTime) $ do
                   $logDebugS "CorrectionR" [st|Rated #{tshow sub}|]
                   queueDBJob . JobQueueNotification $ NotificationSubmissionRated sub
-
-          redirect $ CSubmissionR tid ssh csh shn cid CorrectionR
-
-      case uploadResult of
-        FormMissing -> return ()
-        FormFailure errs -> mapM_ (addMessage Error . toHtml) errs
-        FormSuccess fileUploads -> do
-          uid <- requireAuthId
-
-          res <- msgSubmissionErrors . runDBJobs . runConduit $ transPipe (lift . lift) fileUploads .| extractRatingsMsg .| sinkSubmission uid (Right sub) True
-          case res of
-            Nothing  -> return () -- ErrorMessages are already added by msgSubmissionErrors
-            (Just _) -> do
-              addMessageI Success MsgRatingFilesUpdated
               redirect $ CSubmissionR tid ssh csh shn cid CorrectionR
 
+      formResult uploadResult $ \fileUploads -> do
+        uid <- requireAuthId
+
+        res <- msgSubmissionErrors . runDBJobs . runConduit $ transPipe (lift . lift) fileUploads .| extractRatingsMsg .| sinkSubmission uid (Right sub) True
+        case res of
+          Nothing  -> return () -- ErrorMessages are already added by msgSubmissionErrors
+          (Just _) -> do
+            addMessageI Success MsgRatingFilesUpdated
+            redirect $ CSubmissionR tid ssh csh shn cid CorrectionR
+
       mr <- getMessageRender
       let sheetTypeDesc = mr sheetType
-      defaultLayout $ do
+          heading = MsgCorrectionHead tid ssh csh shn cid
+          headingWgt = [whamlet|
+              $newline never
+              _{heading}
+              $if not (submissionRatingDone subm)
+                \ ^{isVisibleWidget False}
+            |]
+      siteLayout headingWgt $ do
+        setTitleI heading
         let userCorrection = $(widgetFile "correction-user")
         $(widgetFile "correction")
     _ -> notFound
@@ -1050,11 +1052,8 @@ data SubAssignInfo = SubAssignInfo { saiName :: SheetName, saiSubmissionNr, saiC
 getCAssignR, postCAssignR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
 getCAssignR = postCAssignR
 postCAssignR tid ssh csh = do
-  (shids,cid) <- runDB $ do
+  cid <- runDB $ getKeyBy404 $ TermSchoolCourseShort tid ssh csh
-    cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
+  assignHandler tid ssh csh cid []
-    shids <- selectKeysList [SheetCourse ==. cid] [Asc SheetActiveTo]
-    return (shids,cid)
-  assignHandler tid ssh csh cid shids
 
 getSAssignR, postSAssignR :: TermId -> SchoolId -> CourseShorthand -> SheetName -> Handler Html
 getSAssignR = postSAssignR
@@ -1062,51 +1061,13 @@ postSAssignR tid ssh csh shn = do
   (shid,cid) <- runDB $ fetchSheetIdCourseId tid ssh csh shn
   assignHandler tid ssh csh cid [shid]
 
--- DEPRECATED assignHandler', delete me soonish
+{- TODO: Feature:
-assignHandler' :: TermId -> SchoolId -> CourseShorthand -> CourseId -> [SheetId] -> Handler Html
+  make distivt buttons for each sheet, so that users see which sheet will be assigned.
-assignHandler' tid ssh csh _cid rawSids = do
+  Currently this information is available within the page heading!
-  -- gather data
-  openSubs <- runDB $ (\f -> foldM f Map.empty rawSids) $
-      \acc sid -> maybeT (return acc) $ do
-        Just Sheet{sheetName=saiName} <- lift $ get sid
-        guardM $ lift $ hasWriteAccessTo $ CSheetR tid ssh csh saiName SAssignR  -- we must check, whether the submission is already closed and thus assignable
-        saiUnassignedNr <- lift $ count [SubmissionSheet ==. sid, SubmissionRatingBy ==. Nothing]
-        guard $ 0 < saiUnassignedNr -- only consider sheets with unassigned submissions
-        saiSubmissionNr <- lift $ count [SubmissionSheet ==. sid]
-        saiCorrectorNr  <- lift $ count [SheetCorrectorSheet ==. sid, SheetCorrectorState ==. CorrectorNormal]
-        -- guard $ saiCorrectorNr > 0 -- COMMENTED OUT BECAUSE we should show sheets without possible correctors to inform the user about these problematic sheets
-        return $ Map.insert sid SubAssignInfo{..} acc
-  let sids = Map.keys openSubs
-  linkBack <- simpleLinkI (SomeMessage MsgGenericBack) <$> case sids of
-        [sid] -> do Sheet{sheetName} <- runDB $ getJust sid
-                    return $ CSheetR tid ssh csh sheetName SSubsR
-        _     ->    return $ CourseR tid ssh csh CCorrectionsR
-  -- process form
-  currentRoute <- getCurrentRoute
-  ((btnResult, btnWdgt), btnEnctype) <- runFormPost $ identifyForm FIDAssignSubmissions buttonForm
-  assignmentStatus <- fmap (fromMaybe Map.empty) . formResultMaybe btnResult $ \BtnSubmissionsAssign ->
-      -- Assign submissions
-      fmap Just . runDB $ (\f -> foldM f Map.empty sids) $
-        \acc sid -> flip (Map.insert sid) acc <$> assignSubmissions sid Nothing
-      -- Too much important information for an alert message. Display proper info page instead
-  let btnForm = wrapForm btnWdgt def
-                { formAction = SomeRoute <$> currentRoute
-                , formEncoding = btnEnctype
-                , formSubmit = FormNoSubmit
-                }
-      headingShort = MsgMenuCorrectionsAssign
-      headingLong = prependCourseTitle tid ssh csh MsgMenuCorrectionsAssign
-  siteLayoutMsg headingShort $ do
-    setTitleI headingLong
-    $(widgetFile "corrections-assign")
-    if null sids || not (null assignmentStatus)
-      then linkBack  -- TODO: convenience link might be unnecessary: either via breadcrumb or closing model. Remove, if modal works fine. Otherwise change to PrimaryAction?
-      else btnForm
 
-
+  Stub:
-{- TODO: make buttons for each sheet, so that users see which sheet is assigned
 data ButtonCorrectionsAssign = BtnCorrectionsAssignAll | BtnCorrectionsAssignSheet SheetName
-  deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
+    deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable)
 instance Button UniWorX ButtonCorrectionsAssign
 -- Are those needed any more?
 instance Universe ButtonCorrectionsAssign
@@ -1124,7 +1085,7 @@ assignHandler tid ssh csh cid assignSids = do
   (btnWdgt, btnResult) <- runButtonForm FIDAssignSubmissions
 
   -- gather data
-  (nrParticipants, groupsPossible, infoMap, correctorMap, assignment) <- runDB $ do
+  (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment) <- runDB $ do
       -- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
       nrParticipants <- count [CourseParticipantCourse ==. cid]
 
@@ -1135,33 +1096,40 @@ assignHandler tid ssh csh cid assignSids = do
           groupsPossible =
             let foldFun (Entity _ Sheet{sheetGrouping=sgr}) acc = acc || sgr /= NoGroups
             in  List.foldr foldFun False sheetList
+          assignSheetNames = fmap sheetName $ mapMaybe (\sid -> Map.lookup sid sheets) assignSids
 
       -- plan or assign unassigned submissions for given sheets
-      let buildA :: (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int)) -> SheetId -> DB (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int))
+      let buildA :: (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int, Map UserId Rational)) -> SheetId -> DB (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int, Map UserId Rational))
           buildA acc sid = maybeT (return acc) $ do
             let shn = sheetName $ sheets ! sid
             -- is sheet closed?
             guardM $ lift $ hasWriteAccessTo $ CSheetR tid ssh csh shn SAssignR  -- we must check, whether the submission is already closed and thus assignable
-            -- has at least one uncorrected / unassigned submisison?
+            -- ask for assignment plan
-            [E.Value hasSubmission] <- lift $ E.select $ return $ E.exists $ E.from $ \submission -> do
+            let ignoreExceptions :: AssignSubmissionException -> DB (Map SubmissionId (Maybe UserId), Map UserId Rational) -- silently ignore errors, since we check all sheets and only care about sheets with unassigned corrections
-              E.where_ $ submission E.^. SubmissionSheet    E.==. E.val sid
+                ignoreExceptions NoCorrectors             = return mempty
-              E.where_ $ E.isNothing $ submission E.^. SubmissionRatingBy   -- no corrector
+                ignoreExceptions NoCorrectorsByProportion = return mempty
-              E.where_ $ E.isNothing $ submission E.^. SubmissionRatingTime -- not done
+                ignoreExceptions (SubmissionsNotFound _sids_not_found) = return mempty -- cannot happen, since last argument to planSubmissions is Nothing
-            guard hasSubmission
+            (plan,deficit) <- lift $ handle ignoreExceptions $ planSubmissions sid Nothing
-            -- has at least one active corrector?
+            guard $ not $ null plan -- only proceed if there is a plan for this sheet
-            [E.Value hasCorrector] <- lift $ E.select $ return $ E.exists $ E.from $ \corrector -> do
+            -- implement assignment plan
-              E.where_ $ corrector E.^. SheetCorrectorSheet E.==. E.val sid
-              E.where_ $ corrector E.^. SheetCorrectorState E.==. E.val CorrectorNormal
-              -- E.where_ $ corrector E.^. SheetCorrectorLoad  E./=. E.val (Load {byTutorial = Nothing, byProportion = 0})
-            guard hasCorrector
-            -- TODO: Refactor guards above! We already have these informations, but forcing the maps inside the DB acces might not be a good idea
-            -- TODO: Maybe refactor planSubmissions instead to not throw exceptions, but signal "ok" or "not possible" instead!
-            plan <- lift $ planSubmissions sid Nothing
             status <- lift $ case btnResult of
               Nothing -> return (Set.empty, Set.empty)
-              (Just BtnSubmissionsAssign) -> writeSubmissionPlan plan -- TODO: this comes to late!!
+              (Just BtnSubmissionsAssign) -> do
-            return $ Map.insert shn (status, countMapElems plan) acc
+                status@(sub_ok,sub_fail) <- writeSubmissionPlan plan
-      assignment <- foldM buildA Map.empty assignSids
+                let nr_ok      = olength sub_ok
+                    nr_fail    = olength sub_fail
+                    alert_ok   = toMaybe (nr_ok   > 0) $ SomeMessage $ MsgUpdatedSheetCorrectorsAutoAssigned nr_ok
+                    alert_fail = toMaybe (nr_fail > 0) $ SomeMessage $ MsgUpdatedSheetCorrectorsAutoFailed   nr_fail
+                    msg_status = bool Success Error $ nr_fail > 0
+                    msg_header = SomeMessage $ shn <> ":"
+                when (nr_ok > 0 || nr_fail > 0) $
+                  addMessageI msg_status $ UniWorXMessages $ msg_header : catMaybes [alert_ok, alert_fail]
+                return status
+            return $ Map.insert shn (status, countMapElems plan, deficit) acc
+      assignSids' <- if null assignSids -- assignAll; we distinguish assignSids' here avoid useless Alerts
+                      then selectKeysList [SheetCourse ==. cid] [Asc SheetActiveTo]
+                      else return assignSids
+      assignment <- foldM buildA Map.empty assignSids'
 
       correctors <- E.select . E.from $ \(corrector `E.InnerJoin` user) -> do
           E.on $ corrector E.^. SheetCorrectorUser E.==. user E.^. UserId
@@ -1205,34 +1173,61 @@ assignHandler tid ssh csh cid assignSids = do
                             }
               in Map.insertWith (Map.unionWith (<>)) shnm cinf m
 
-      return (nrParticipants, groupsPossible, infoMap, correctorMap, assignment)
+      return (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment)
 
   let -- infoMap  :: Map SheetName (Map (Maybe UserId) CorrectionInfo) -- repeated here for easier reference
       -- create aggregate maps
+      sheetNames :: [SheetName]
+      sheetNames = Map.keys infoMap
+
       sheetMap :: Map SheetName CorrectionInfo
       sheetMap = Map.map fold infoMap
+
+      sheetLoad :: Map SheetName Load
+      sheetLoad = -- Map.unionsWith (<>) ((Map.filter () ) . snd) <$> Map.elems correctorMap)
+        let buildSL acc (_user,mSnSc) = Map.foldlWithKey buildL acc mSnSc
+            buildL acc s SheetCorrector{sheetCorrectorLoad=l, sheetCorrectorState=CorrectorNormal}
+              = Map.insertWith (<>) s l acc
+            buildL acc _ _ = acc
+        in  Map.foldl buildSL Map.empty correctorMap
+
+      deficitMap :: Map UserId Rational
+      deficitMap = foldMap (view _3) assignment
+
       corrMap  :: Map (Maybe UserId) CorrectionInfo
       corrMap  = Map.unionsWith (<>) $ Map.elems infoMap
-      sheetNames = Map.keys infoMap
+
+      corrMapSum :: CorrectionInfo
+      corrMapSum = fold corrMap
+
   let -- whamlet convenience functions
-      -- avoid nestes hamelt $maybe with duplicated $nothing
+      -- avoid nestes hamlet $maybe with duplicated $nothing
       getCorrector :: Maybe UserId -> (Widget,Map SheetName SheetCorrector)
       getCorrector (Just uid)
         | Just (User{..},loadMap) <- Map.lookup uid correctorMap
         = (nameEmailWidget userEmail userDisplayName userSurname, loadMap)
       getCorrector _ = ([whamlet|_{MsgNoCorrectorAssigned}|], mempty)
-      -- avoid nestes hamelt $maybe with duplicated $nothing
+      -- avoid nestes hamlet $maybe with duplicated $nothing
       getCorrSheetStatus :: Maybe UserId -> SheetName -> Maybe CorrectionInfo
       getCorrSheetStatus corr shn
         | (Just smap) <- Map.lookup shn infoMap
         = Map.lookup corr smap
       getCorrSheetStatus _ _ = Nothing
-      -- avoid nestes hamelt $maybe with duplicated $nothing
+      -- avoid nestes hamlet $maybe with duplicated $nothing
       getCorrNewAssignment :: Maybe UserId -> SheetName -> Maybe Int
       getCorrNewAssignment corr shn
-        | (Just (_,cass)) <- Map.lookup shn assignment
+        | (Just (_,cass,_)) <- Map.lookup shn assignment
         = Map.lookup corr cass
       getCorrNewAssignment _ _ = Nothing
+      -- avoid nestes hamlet $maybe with duplicated $nothing
+      getCorrDeficit :: Maybe UserId -> Maybe Rational
+      getCorrDeficit (Just uid) = Map.lookup uid deficitMap
+      getCorrDeficit _          = Nothing
+
+      getLoadSum :: SheetName -> Text
+      getLoadSum shn | (Just load) <- Map.lookup shn sheetLoad
+                     = showCompactCorrectorLoad load CorrectorNormal
+      getLoadSum  _  = mempty
 
       showDiffDays :: Maybe NominalDiffTime -> Text
       showDiffDays = foldMap formatDiffDays
@@ -1245,6 +1240,10 @@ assignHandler tid ssh csh cid assignSids = do
         | 0 < Map.size assignment = MsgMenuCorrectionsAssignSheet $ Text.intercalate ", " $ fmap CI.original $ Map.keys assignment
         | otherwise               = MsgMenuCorrectionsAssign
       headingLong = prependCourseTitle tid ssh csh MsgMenuCorrectionsAssign
+
+      unassignableSheets = filter (\shn -> Map.notMember shn assignment) assignSheetNames
+  unless (null unassignableSheets) $ addMessageI Warning $ MsgSheetsUnassignable $ Text.intercalate ", " $ fmap CI.original unassignableSheets
+
   siteLayoutMsg headingShort $ do
     setTitleI headingLong
     $(widgetFile "corrections-overview")

src/Handler/Health.hs

@@ -63,7 +63,7 @@ getHealthR = do
                     <dd .deflist__dd>#{boolSymbol passed}
                   $of HealthLDAPAdmins (Just found)
                     <dt .deflist__dt>_{MsgHealthLDAPAdmins}
-                    <dd .deflist__dd>#{textPercent found}
+                    <dd .deflist__dd>#{textPercent found 1}
                   $of HealthSMTPConnect (Just passed)
                     <dt .deflist__dt>_{MsgHealthSMTPConnect}
                     <dd .deflist__dd>#{boolSymbol passed}
@@ -80,7 +80,7 @@ getInstanceR = do
   instanceInfo@(clusterId, instanceId) <- getsYesod $ (,) <$> appClusterID <*> appInstanceID
 
   setWeakEtagHashable (clusterId, instanceId)
-  
+
   selectRep $ do
     provideRep $
       siteLayoutMsg MsgInstanceIdentification $ do

src/Handler/Help.hs

@@ -66,6 +66,6 @@ postHelpR = do
     let formWidget = wrapForm formWidget' def
           { formAction = Just $ SomeRoute HelpR
           , formEncoding = formEnctype
-          , formAttrs = [ ("data-ajax-submit", "") | isModal ]
+          , formAttrs = [ asyncSubmitAttr | isModal ]
           }
     $(widgetFile "help")

src/Handler/Profile.hs

@@ -147,7 +147,7 @@ postProfileR = do
 
   siteLayout [whamlet|_{MsgProfileFor} ^{nameWidget userDisplayName userSurname}|] $ do
     setTitle . toHtml $ "Profil " <> userIdent
-    let settingsForm = 
+    let settingsForm =
           wrapForm formWidget FormSettings
             { formMethod = POST
             , formAction = Just . SomeRoute $ ProfileR :#: ProfileSettings
@@ -593,7 +593,7 @@ postUserNotificationR cID = do
   let formWidget = wrapForm nsInnerWdgt def
         { formAction = Just . SomeRoute $ UserNotificationR cID
         , formEncoding = nsEnc
-        , formAttrs = [ ("data-ajax-submit", "") | isModal ]
+        , formAttrs = [ asyncSubmitAttr | isModal ]
         }
 
   formResultModal nsRes (UserNotificationR cID, [ (toPathPiece GetBearer, toPathPiece jwt) | Just jwt <- pure mJwt ]) $ \ns -> do

src/Handler/Sheet.hs

@@ -257,9 +257,7 @@ getSheetListR tid ssh csh = do
               (Just (Entity _ Submission{submissionRatingPoints=Just sPoints})) ->
                 case preview (_grading . _maxPoints) sType of
                   Just maxPoints
-                    | maxPoints /= 0 ->
+                    | maxPoints /= 0 -> textCell $ textPercent sPoints maxPoints
-                        let percent = sPoints / maxPoints
-                        in textCell $ textPercent $ realToFrac percent
                   _other -> mempty
               _other -> mempty
       ]

src/Handler/Utils/Rating.hs

@@ -56,7 +56,7 @@ instance Pretty SheetGrading where
 
 
 validateRating :: SheetType -> Rating' -> [RatingException]
-validateRating ratingSheetType Rating'{ratingPoints=Just rp, ..}
+validateRating ratingSheetType Rating'{ ratingPoints=Just rp, .. }
   | rp < 0
     = [RatingNegative]
   | NotGraded <- ratingSheetType
@@ -67,6 +67,11 @@ validateRating ratingSheetType Rating'{ratingPoints=Just rp, ..}
   | (Just PassBinary) <- ratingSheetType ^? _grading
   , not (rp == 0 || rp == 1)
     = [RatingBinaryExpected]
+validateRating ratingSheetType Rating'{ .. }
+  | has _grading ratingSheetType
+  , is _Nothing ratingPoints
+  , isn't _Nothing ratingTime
+  = [RatingPointsRequired]
 validateRating _ _ = []
 
 getRating :: SubmissionId -> YesodDB UniWorX (Maybe Rating)

src/Handler/Utils/Submission.hs

@@ -66,7 +66,9 @@ assignSubmissions :: SheetId -- ^ Sheet to distribute to correctors
                   -> YesodDB UniWorX ( Set SubmissionId
                                      , Set SubmissionId
                                      ) -- ^ Returns assigned and unassigned submissions; unassigned submissions occur only if no tutors have an assigned load
-assignSubmissions sid restriction = planSubmissions sid restriction >>= writeSubmissionPlan
+assignSubmissions sid restriction = do
+    (plan,_) <- planSubmissions sid restriction
+    writeSubmissionPlan plan
 
 -- | Assigns all submissions according to an already given assignment plan
 writeSubmissionPlan :: Map SubmissionId (Maybe UserId)
@@ -89,8 +91,8 @@ writeSubmissionPlan newSubmissionData = do
 --   May throw an exception if there are no suitable correctors
 planSubmissions :: SheetId -- ^ Sheet to distribute to correctors
                   -> Maybe (Set SubmissionId) -- ^ Optionally restrict submission to consider
-                  -> YesodDB UniWorX (Map SubmissionId (Maybe UserId))
+                  -> YesodDB UniWorX (Map SubmissionId (Maybe UserId), Map UserId Rational)
-                  -- ^ Return map that assigns submissions to Corrector
+                  -- ^ Return map that assigns submissions to Corrector and another map showing each current correctors _previous_ deficit
 planSubmissions sid restriction = do
     Sheet{..} <- getJust sid
     correctorsRaw <- E.select . E.from $ \(sheet `E.InnerJoin` sheetCorrector) -> do
@@ -171,6 +173,10 @@ planSubmissions sid restriction = do
                          -> m b
       withSubmissionData f = f <$> (mappend <$> ask <*> State.get)
 
+      -- | Old Deficit for protocol purposes, not used here
+      oldDeficit :: Map UserId Rational
+      oldDeficit = Map.mapWithKey (\k _v -> calculateDeficit k submissionData) sheetCorrectors
+
       -- | How many additional submission should the given corrector be assigned, if possible?
       calculateDeficit :: UserId -> Map SubmissionId (Maybe UserId, Map UserId _, SheetId) -> Rational
       calculateDeficit corrector submissionState = getSum $ foldMap Sum deficitBySheet
@@ -235,7 +241,7 @@ planSubmissions sid restriction = do
 
         ix subId . _1 <~ Just <$> liftIO (Rand.uniform bestCorrectors)
 
-    return $ fmap (view _1) newSubmissionData
+    return (fmap (view _1) newSubmissionData, oldDeficit)
   where
     maximumsBy :: (Ord a, Ord b) => (a -> b) -> Set a -> Set a
     maximumsBy f xs = flip Set.filter xs $ \x -> maybe True (((==) `on` f) x . maximumBy (comparing f)) $ fromNullable xs

src/Model/Rating.hs

@@ -31,6 +31,7 @@ data RatingException = RatingNotUnicode UnicodeException -- ^ Rating failed to p
                      | RatingExceedsMax -- ^ Rating point must not exceed maximum points
                      | RatingNotExpected -- ^ Rating not expected
                      | RatingBinaryExpected -- ^ Rating must be 0 or 1
+                     | RatingPointsRequired -- ^ Rating without points for sheet that requires there to be points
   deriving (Show, Eq, Generic, Typeable)
 
 instance Exception RatingException

src/Utils.hs

@@ -2,12 +2,13 @@ module Utils
   ( module Utils
   ) where
 
-import ClassyPrelude.Yesod hiding (foldlM)
+import ClassyPrelude.Yesod hiding (foldlM, Proxy)
 
 -- import Data.Double.Conversion.Text -- faster implementation for textPercent?
 import qualified Data.Foldable as Fold
 import Data.Foldable as Utils (foldlM, foldrM)
 import Data.Monoid (Sum(..))
+import Data.Proxy
 
 import Data.CaseInsensitive (CI)
 import qualified Data.CaseInsensitive as CI
@@ -63,7 +64,7 @@ import qualified Crypto.Saltine.Class as Saltine
 import qualified Crypto.Data.PKCS7 as PKCS7
 
 import Data.Fixed
-import Data.Ratio ((%))
+-- import Data.Ratio ((%))
 
 import Data.Binary (Binary)
 import qualified Data.Binary as Binary
@@ -237,15 +238,28 @@ withFragment form html = flip fmap form $ over _2 (toWidget html >>)
 rationalToFixed3 :: Rational -> Fixed E3
 rationalToFixed3 = fromRational
 
-textPercent :: Real a => a -> Text -- slow, maybe use Data.Double.Conversion.Text.toFixed instead?
+-- | Convert `part` and `whole` into percentage including symbol
-textPercent x = lz <> pack (show rx) <> "%"
+--   showing trailing zeroes and to decimal digits
- where
+textPercent :: Real a => a -> a -> Text
-   rx :: Centi
+textPercent = textPercent' False 2
-   rx = realToFrac (x * 100)
+
-   lz = if rx < 10.0 then "0" else ""
+-- | Convert `part` and `whole` into percentage including symbol
+--   `trailZero` shows trailing Zeros, `precision` is number of decimal digits
+textPercent' :: Real a => Bool -> Int -> a -> a -> Text
+textPercent' trailZero precision part whole
+    | precision == 0 = showPercent (frac :: Uni)
+    | precision == 1 = showPercent (frac :: Deci)
+    | precision == 2 = showPercent (frac :: Centi)
+    | precision == 3 = showPercent (frac :: Milli)
+    | precision == 4 = showPercent (frac :: Micro)
+    | otherwise      = showPercent (frac :: Pico)
+  where
+    frac :: forall a . HasResolution a => Fixed a
+    frac = MkFixed $ round $ (* (fromInteger $ resolution (Proxy :: Proxy a)))  $ (100*) $ toRational part / toRational whole
+
+    showPercent :: HasResolution a => Fixed a -> Text
+    showPercent f = pack $ showFixed trailZero f <> "%"
 
-textPercentInt :: Integral a => a -> a -> Text -- slow, maybe use Data.Double.Conversion.Text.toFixed instead?
-textPercentInt part whole = textPercent $ fromIntegral part % fromIntegral whole
 
 -- | Convert number of bytes to human readable format
 textBytes :: Integral a => a -> Text

src/Utils/Form.hs

@@ -156,6 +156,11 @@ inputReadonly = addAttr "readonly" ""
 addAutosubmit :: FieldSettings site -> FieldSettings site
 addAutosubmit = addAttr "uw-auto-submit-input" ""
 
+-- | Asynchronous Submit, e.g. use with forms in modals
+asyncSubmitAttr :: (Text,Text)
+asyncSubmitAttr = ("uw-async-form", "")
+
+
 ------------------------------------------------
 -- Unique Form Identifiers to avoid accidents --
 ------------------------------------------------

src/index.md

@@ -7,8 +7,7 @@ Utils, Utils.*
   : Hilfsfunktionionen _unabhängig von Foundation_
 
 Utils
-  : Yesod Hilfsfunktionen und Instanzen, Text-HTML-Widget-Konvertierungen
+  : Yesod Hilfsfunktionen und Instanzen, Crud, `NTop`, Utility-Funktionen für `MonadPlus`, `Maybe`,
-    (`DisplayAble`), Crud, `NTop`, Utility-Funktionen für `MonadPlus`, `Maybe`,
     `MaybeT`, `Map`, und Attrs-Lists
 
 Utils.TH

stack.nix

@@ -1,16 +1,11 @@
 { ghc, nixpkgs ? import <nixpkgs> }:
 
 let
-  snapshot = "lts-10.5";
+  haskellPackages = import ./stackage.nix { inherit nixpkgs; };
-  stackage = import (fetchTarball {
+  inherit (nixpkgs {}) pkgs;
-    url = "https://stackage.serokell.io/drczwlyf6mi0ilh3kgv01wxwjfgvq14b-stackage/default.nix.tar.gz";
+in pkgs.haskell.lib.buildStackProject {
-    sha256 = "1bwlbxx6np0jfl6z9gkmmcq22crm0pa07a8zrwhz5gkal64y6jpz";
-  });
-  inherit (nixpkgs { overlays = [ stackage."${snapshot}" ]; }) haskell pkgs;
-
-  haskellPackages = pkgs.haskell.packages."${snapshot}";
-in haskell.lib.buildStackProject {
   inherit ghc;
+  inherit (haskellPackages) stack;
   name = "stackenv";
   buildInputs = (with pkgs;
     [ postgresql zlib libsodium

stack.yaml

@@ -9,20 +9,15 @@ extra-package-dbs: []
 
 packages:
   - .
-  - location:
-      git: https://github.com/pngwjpgh/zip-stream.git
-      commit: 9272bbed000928d500febad1cdc98d1da29d399e
-    extra-dep: true
-  - location:
-      git: https://github.com/pngwjpgh/encoding.git
-      commit: 67bb87ceff53f0178c988dd4e15eeb2daee92b84
-    extra-dep: true
-  - location:
-      git: https://github.com/pngwjpgh/memcached-binary.git
-      commit: b5461747e7be226d3b67daebc3c9aefe8a4490ad
-    extra-dep: true
 
 extra-deps:
+  - git: https://github.com/pngwjpgh/zip-stream.git
+    commit: 9272bbed000928d500febad1cdc98d1da29d399e
+  - git: https://github.com/pngwjpgh/encoding.git
+    commit: 67bb87ceff53f0178c988dd4e15eeb2daee92b84
+  - git: https://github.com/pngwjpgh/memcached-binary.git
+    commit: b5461747e7be226d3b67daebc3c9aefe8a4490ad
+  
   - colonnade-1.2.0
   - yesod-colonnade-1.2.0
 

stackage.nix

@@ -0,0 +1,30 @@
+{ nixpkgs ? import <nixpkgs>
+, snapshot ? "lts-10.5"
+}:
+
+let
+  stackage = import (fetchTarball {
+    url = "https://stackage.serokell.io/drczwlyf6mi0ilh3kgv01wxwjfgvq14b-stackage/default.nix.tar.gz";
+    sha256 = "1bwlbxx6np0jfl6z9gkmmcq22crm0pa07a8zrwhz5gkal64y6jpz";
+  });
+
+  overlays =
+    [ stackage."${snapshot}"
+      (self: super: {
+          haskell = super.haskell // {
+            packages = super.haskell.packages // {
+              "${snapshot}" = super.haskell.packages."${snapshot}".override {
+                overrides = hself: hsuper: {
+                  zip-archive = self.haskell.lib.overrideCabal hsuper.zip-archive (old: {
+                    testToolDepends = old.testToolDepends ++ (with self; [ unzip ]);
+                  });
+                };
+              };
+            };
+          };
+        }
+      )
+    ];
+
+  inherit (nixpkgs { inherit overlays; }) pkgs;
+in pkgs.haskell.packages."${snapshot}"

templates/corrections-overview.hamlet

@@ -3,20 +3,26 @@
   _{MsgCourseParticipants nrParticipants}
   <table .table .table--striped .table--hover>
     <tr .table__row .table__row--head>
-      <th .table__th>_{MsgSheet}
+      <th .table__th rowspan=2>_{MsgSheet}
       $if groupsPossible
-        <th .table__th>_{MsgNrSubmittorsTotal}
+        <th .table__th rowspan=2>_{MsgNrSubmittorsTotal}
-      <th .table__th >_{MsgNrSubmissionsTotal}
+      <th .table__th rowspan=2>_{MsgNrSubmissionsTotal}
       <th .table__th colspan=2>_{MsgNrSubmissionsNotAssigned}
-      <th .table__th>_{MsgNrSubmissionsNotCorrected}
+      <th .table__th rowspan=2>_{MsgNrSubmissionsNotCorrected}
       <th .table__th colspan=3>_{MsgCorrectionTime}
+    <tr .table__row .table__row--head>
+      <th .table__th>
+      <th .table__th>_{MsgGenericNumChange}
+      <th .table__th>_{MsgGenericMin}
+      <th .table__th>_{MsgGenericAvg}
+      <th .table__th>_{MsgGenericMax}
     $forall (sheetName, CorrectionInfo{ciSubmittors, ciSubmissions, ciAssigned, ciCorrected, ciMin, ciTot, ciMax}) <- Map.toList sheetMap
       <tr .table__row>
         <td .table__td>^{simpleLink (toWidget sheetName) (CSheetR tid ssh csh sheetName SSubsR)}
         $if groupsPossible
           <td .table__td>#{ciSubmittors}
         <td .table__td>#{ciSubmissions}
-        $maybe ((splus,sfailed),_) <- Map.lookup sheetName assignment
+        $maybe ((splus,sfailed),_,_) <- Map.lookup sheetName assignment
           $if 0 < Set.size sfailed
             <td .table__td>#{ciSubmissions - ciAssigned}
             <td .table__td .alert-danger>(-#{show (Set.size splus)}, failed: #{show (Set.size sfailed)})
@@ -24,9 +30,11 @@
             <td .table__td>#{ciSubmissions - ciAssigned}
             <td .table__td .alert-info>(-#{show (Set.size splus)})
           $else
-            <td .table__td colspan=2>#{ciSubmissions - ciAssigned}
+            <td .table__td>#{ciSubmissions - ciAssigned}
+            <td .table__td>
         $nothing
-          <td .table__td colspan=2>#{ciSubmissions - ciAssigned}
+          <td .table__td>#{ciSubmissions - ciAssigned}
+          <td .table__td>
         <td .table__td>#{ciSubmissions - ciCorrected}
         <td .table__td>#{showDiffDays ciMin}
         <td .table__td>#{showAvgsDays ciTot ciCorrected}
@@ -35,43 +43,78 @@
   <h2>_{MsgCorrectionCorrectors}
   <table .table .table--striped .table--hover>
     <tr .table__row .table__row--head>
-      <th .table__th>_{MsgCorrector}
+      <th .table__th rowspan=2>_{MsgCorrector}
-      <th .table__th>_{MsgNrSubmissionsTotal}
+      <th .table__th colspan=2>_{MsgGenericAll}
-      <th .table__th>_{MsgNrSubmissionsNotCorrected}
+      <th .table__th rowspan=2>_{MsgCorDeficitProportion}
       <th .table__th colspan=3>_{MsgCorrectionTime}
       $forall shn <- sheetNames
         <th .table__th colspan=5>#{shn}
         $# ^{simpleLinkI (SomeMessage MsgMenuCorrectors) (CSheetR tid ssh csh shn SCorrR)}
-    $forall (CorrectionInfo{ciCorrector, ciSubmissions, ciCorrected, ciMin, ciTot, ciMax}) <- Map.elems corrMap
+    <tr .table__row .table__row--head>
+      <th .table__th>_{MsgNrSubmissionsTotal}
+      <th .table__th>_{MsgNrSubmissionsNotCorrected}
+      <th .table__th>_{MsgGenericMin}
+      <th .table__th>_{MsgGenericAvg}
+      <th .table__th>_{MsgGenericMax}
+      $forall _shn <- sheetNames
+        <th .table__th>_{MsgCorProportion}
+        <th .table__th>_{MsgNrSubmissionsTotalShort}
+        <th .table__th>_{MsgGenericNumChange}
+        <th .table__th>_{MsgNrSubmissionsNotCorrectedShort}
+        <th .table__th>_{MsgGenericAvg}
+    $forall (CorrectionInfo{ciCorrector, ciSubmissions=ciSubmissionsNr, ciCorrected, ciMin, ciTot, ciMax}) <- Map.elems corrMap
       $with (nameW,loadM) <- getCorrector ciCorrector
         <tr .table__row>
           <td .table__td>^{nameW}
-          <td .table__td>#{ciSubmissions}
+          <td .table__td>#{ciSubmissionsNr}
-          <td .table__td .heated style="--hotness: #{heat ciSubmissions ciCorrected}">#{ciSubmissions - ciCorrected}
+            $with total <- ciSubmissions corrMapSum
+              $if total > 0
+                \ (#{textPercent' True 0 ciSubmissionsNr total})
+          <td .table__td .heated style="--hotness: #{heat ciSubmissionsNr ciCorrected}">#{ciSubmissionsNr - ciCorrected}
+          <td .table__td>
+              $maybe deficit <- getCorrDeficit ciCorrector
+                #{rationalToFixed3 deficit}
           <td .table__td>#{showDiffDays ciMin}
           <td .table__td>#{showAvgsDays ciTot ciCorrected}
           <td .table__td>#{showDiffDays ciMax}
-          $forall shn <- sheetNames
+          $forall (shn, CorrectionInfo{ciSubmissions=sheetSubmissionsNr}) <- Map.toList sheetMap
-            $maybe SheetCorrector{sheetCorrectorLoad, sheetCorrectorState} <- Map.lookup shn loadM
+            <td .table__td>
-              <td .table__td>#{showCompactCorrectorLoad sheetCorrectorLoad sheetCorrectorState}
+              $maybe SheetCorrector{sheetCorrectorLoad, sheetCorrectorState} <- Map.lookup shn loadM
-            $nothing
+                #{showCompactCorrectorLoad sheetCorrectorLoad sheetCorrectorState}
-              <td .table__td>
+                $if sheetCorrectorState == CorrectorNormal
+                  $maybe Load{byProportion=total} <- Map.lookup shn sheetLoad
+                    $if total > 0
+                      \ (#{textPercent' True 0 (byProportion sheetCorrectorLoad) total})
             $maybe CorrectionInfo{ciSubmissions,ciCorrected,ciTot} <- getCorrSheetStatus ciCorrector shn
+              <td .table__td>#{ciSubmissions}
+                $if sheetSubmissionsNr > 0
+                  \ (#{textPercent' True 0 ciSubmissions sheetSubmissionsNr})
               $maybe nrNew <- getCorrNewAssignment ciCorrector shn
-                <td .table__td>#{ciSubmissions}
                 $# <td .table__td>#{ciAssigned} `ciSubmissions` is here always identical to `ciAssigned` and also works for `ciCorrector == Nothing`. ciAssigned only useful in aggregate maps like `sheetMap`
                 <td .table__td .alert-info>(+#{nrNew})
               $nothing
-                <td .table__td colspan=2>#{ciSubmissions}
+                <td .table__td>
               <td .table__td .heated style="--hotness: #{heat ciSubmissions ciCorrected}">#{ciSubmissions - ciCorrected}
               <td .table__td>#{showAvgsDays ciTot ciCorrected}
             $nothing
-              <td .table__td colspan=4>
+              <td .table__td>
+              <td .table__td>
+              <td .table__td>
+              <td .table__td>
     $if 0 < length sheetNames
       <tr .table__row>
-        <td colspan=6>
+        <td .table__th>Σ
+        $with ciSubmissionsNr <- ciSubmissions corrMapSum
+          $with ciCorrectedNr <- ciCorrected   corrMapSum
+            <td .table__th>#{ciSubmissionsNr}
+            <td .table__td .heated style="--hotness: #{heat ciSubmissionsNr ciCorrectedNr}">#{ciSubmissionsNr - ciCorrectedNr}
+        <td .table__th>#{ciCorrected   corrMapSum}
+        <td .table__th>#{showDiffDays (ciMin corrMapSum)}
+        <td .table__th>#{showAvgsDays (ciTot corrMapSum) (ciCorrected corrMapSum)}
+        <td .table__th>#{showDiffDays (ciMax corrMapSum)}
         $forall shn <- sheetNames
-          <td .table__td colspan=5>^{simpleLinkI (SomeMessage MsgMenuCorrectors) (CSheetR tid ssh csh shn SCorrR)}
+          <td .table__th>#{getLoadSum shn}
+          <td .table__td colspan=4>^{simpleLinkI (SomeMessage MsgMenuCorrectorsChange) (CSheetR tid ssh csh shn SCorrR)}
   ^{btnWdgt}
  <div>
   <p>_{MsgAssignSubmissionsRandomWarning}

templates/default-layout.lucius

@@ -502,7 +502,7 @@ ul.list--inline {
 @media (min-width: 768px) {
 
   .deflist {
-    grid-template-columns: max-content minmax(auto, max-content);
+    grid-template-columns: max-content minmax(0, max-content);
 
     .deflist {
       margin-top: -10px;
@@ -580,7 +580,7 @@ section {
     justify-content: center;
   }
 }
-  
+
 .form-group__input > .notification {
   margin: 0;
 }

templates/widgets/grading-summary/grading-summary-row.hamlet

@@ -19,7 +19,7 @@ $#
             $with Sum pacv <- summary ^. _achievedPasses
               <td .table__td>
                 $if pmax > 0
-                  #{textPercentInt pacv pmax}
+                  #{textPercent pacv pmax}
               <td .table__td>
                 _{pacv} / _{pmax}
           $else
@@ -35,7 +35,7 @@ $#
           $with Sum pacv <- summary ^. _achievedPoints
             <td .table__td>
               $if pmax > 0
-                #{textPercent $ realToFrac $ pacv / pmax}
+                #{textPercent pacv pmax}
             <td .table__td>
               _{pacv} / _{pmax}
               $if ((summary ^. _numMarkedPoints) /= (summary ^. _numSheets))