diff --git a/.directory b/.directory index 59c2c250d..9e958424d 100644 --- a/.directory +++ b/.directory @@ -1,5 +1,5 @@ [Dolphin] -Timestamp=2018,3,14,10,57,55 +Timestamp=2019,6,26,19,32,25 Version=4 [Settings] diff --git a/.vscode/tasks.json b/.vscode/tasks.json index fabc6a5d5..4c18542ba 100644 --- a/.vscode/tasks.json +++ b/.vscode/tasks.json @@ -14,6 +14,7 @@ "reveal": "always", "focus": false, "panel": "dedicated", + "clear": true, "showReuseMessage": false } }, diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index 88ebae84c..a50886c4e 100644 --- a/messages/uniworx/de.msg +++ b/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 -SheetGradingPassPoints maxPoints@Points passingPoints@Points: Bestanden ab #{tshow passingPoints} von #{tshow maxPoints} Punkten +SheetGradingPoints maxPoints@Points: #{maxPoints} Punkte +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 -CommSuccess n@Int: Nachricht wurde an #{tshow n} Empfänger versandt +CommDuplicateRecipients n@Int: #{n} #{pluralDE n "doppelter" "doppelte"} Empfänger ignoriert +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 -CourseParticipantsInvited n@Int: #{tshow n} #{pluralDE n "Einladung" "Einladungen"} per E-Mail verschickt -CourseParticipantsAlreadyRegistered n@Int: #{tshow 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"} -CourseParticipantsRegistered n@Int: #{tshow n} Teilnehmer erfolgreich angemeldet +CourseParticipants n@Int: Derzeit #{n} angemeldete Kursteilnehmer +CourseParticipantsInvited n@Int: #{n} #{pluralDE n "Einladung" "Einladungen"} per E-Mail verschickt +CourseParticipantsAlreadyRegistered n@Int: #{n} Teilnehmer #{pluralDE n "ist" "sind"} bereits angemeldet +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: #{n} Teilnehmer erfolgreich angemeldet CourseParticipantsRegisterHeading: Kursteilnehmer hinzufügen \ No newline at end of file diff --git a/shell.nix b/shell.nix index f98506e41..94ef0ba00 100644 --- a/shell.nix +++ b/shell.nix @@ -1,8 +1,7 @@ -{ nixpkgs ? import , compiler ? null }: +{ nixpkgs ? import }: let - inherit (nixpkgs {}) pkgs; - haskellPackages = if isNull compiler then pkgs.haskellPackages else pkgs.haskell.packages."${compiler}"; + haskellPackages = import ./stackage.nix { inherit nixpkgs; }; 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}" diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 38105a37a..bd8120ba7 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/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) diff --git a/src/Foundation.hs b/src/Foundation.hs index 82b078bcd..d23853227 100644 --- a/src/Foundation.hs +++ b/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) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 7dc79ae4f..5a9ee8a3c 100644 --- a/src/Handler/Corrections.hs +++ b/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 - FormMissing -> return () - FormFailure errs -> mapM_ (addMessage Error . toHtml) errs - FormSuccess (rated, ratingPoints', ratingComment') -> do - uid <- liftHandlerT requireAuthId - now <- liftIO getCurrentTime + formResult corrResult $ \(rated, ratingPoints', ratingComment') -> do + uid <- liftHandlerT requireAuthId + now <- liftIO getCurrentTime - if - | errs <- validateRating sheetType Rating' - { ratingPoints = ratingPoints' - , ratingComment = ratingComment' - , ratingTime = (now <$ guard rated) - } - , not $ null errs - -> mapM_ (addMessageI Error) errs - | otherwise -> runDBJobs $ do + if + | errs <- validateRating sheetType Rating' + { ratingPoints = ratingPoints' + , ratingComment = ratingComment' + , ratingTime = (now <$ guard rated) + } + , not $ null errs + -> mapM_ (addMessageI Error) errs + | 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 <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh - shids <- selectKeysList [SheetCourse ==. cid] [Asc SheetActiveTo] - return (shids,cid) - assignHandler tid ssh csh cid shids + cid <- runDB $ getKeyBy404 $ TermSchoolCourseShort tid ssh csh + assignHandler tid ssh csh cid [] 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 -assignHandler' :: TermId -> SchoolId -> CourseShorthand -> CourseId -> [SheetId] -> Handler Html -assignHandler' tid ssh csh _cid rawSids = do - -- 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 +{- TODO: Feature: + make distivt buttons for each sheet, so that users see which sheet will be assigned. + Currently this information is available within the page heading! - -{- TODO: make buttons for each sheet, so that users see which sheet is assigned + Stub: 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? - [E.Value hasSubmission] <- lift $ E.select $ return $ E.exists $ E.from $ \submission -> do - E.where_ $ submission E.^. SubmissionSheet E.==. E.val sid - E.where_ $ E.isNothing $ submission E.^. SubmissionRatingBy -- no corrector - E.where_ $ E.isNothing $ submission E.^. SubmissionRatingTime -- not done - guard hasSubmission - -- has at least one active corrector? - [E.Value hasCorrector] <- lift $ E.select $ return $ E.exists $ E.from $ \corrector -> do - 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 + -- ask for assignment plan + 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 + ignoreExceptions NoCorrectors = return mempty + ignoreExceptions NoCorrectorsByProportion = return mempty + ignoreExceptions (SubmissionsNotFound _sids_not_found) = return mempty -- cannot happen, since last argument to planSubmissions is Nothing + (plan,deficit) <- lift $ handle ignoreExceptions $ planSubmissions sid Nothing + guard $ not $ null plan -- only proceed if there is a plan for this sheet + -- implement assignment plan status <- lift $ case btnResult of Nothing -> return (Set.empty, Set.empty) - (Just BtnSubmissionsAssign) -> writeSubmissionPlan plan -- TODO: this comes to late!! - return $ Map.insert shn (status, countMapElems plan) acc - assignment <- foldM buildA Map.empty assignSids + (Just BtnSubmissionsAssign) -> do + status@(sub_ok,sub_fail) <- writeSubmissionPlan plan + 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") diff --git a/src/Handler/Health.hs b/src/Handler/Health.hs index 046c16aff..7b29e2bbd 100644 --- a/src/Handler/Health.hs +++ b/src/Handler/Health.hs @@ -63,7 +63,7 @@ getHealthR = do
#{boolSymbol passed} $of HealthLDAPAdmins (Just found)
_{MsgHealthLDAPAdmins} -
#{textPercent found} +
#{textPercent found 1} $of HealthSMTPConnect (Just passed)
_{MsgHealthSMTPConnect}
#{boolSymbol passed} @@ -80,7 +80,7 @@ getInstanceR = do instanceInfo@(clusterId, instanceId) <- getsYesod $ (,) <$> appClusterID <*> appInstanceID setWeakEtagHashable (clusterId, instanceId) - + selectRep $ do provideRep $ siteLayoutMsg MsgInstanceIdentification $ do diff --git a/src/Handler/Help.hs b/src/Handler/Help.hs index bf33da8d5..5380d9880 100644 --- a/src/Handler/Help.hs +++ b/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") diff --git a/src/Handler/Profile.hs b/src/Handler/Profile.hs index 4bb679ec3..783752808 100644 --- a/src/Handler/Profile.hs +++ b/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 diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 94b00334d..946e0395f 100644 --- a/src/Handler/Sheet.hs +++ b/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 -> - let percent = sPoints / maxPoints - in textCell $ textPercent $ realToFrac percent + | maxPoints /= 0 -> textCell $ textPercent sPoints maxPoints _other -> mempty _other -> mempty ] diff --git a/src/Handler/Utils/Rating.hs b/src/Handler/Utils/Rating.hs index 2e980312f..472e49950 100644 --- a/src/Handler/Utils/Rating.hs +++ b/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) diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index 7cb28cfa5..0a1e04e9c 100644 --- a/src/Handler/Utils/Submission.hs +++ b/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)) - -- ^ Return map that assigns submissions to Corrector + -> YesodDB UniWorX (Map SubmissionId (Maybe UserId), Map UserId Rational) + -- ^ 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 diff --git a/src/Model/Rating.hs b/src/Model/Rating.hs index c7b4e910f..295d275eb 100644 --- a/src/Model/Rating.hs +++ b/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 diff --git a/src/Utils.hs b/src/Utils.hs index 35ca18bcc..0b761d6f1 100644 --- a/src/Utils.hs +++ b/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? -textPercent x = lz <> pack (show rx) <> "%" - where - rx :: Centi - rx = realToFrac (x * 100) - lz = if rx < 10.0 then "0" else "" +-- | Convert `part` and `whole` into percentage including symbol +-- showing trailing zeroes and to decimal digits +textPercent :: Real a => a -> a -> Text +textPercent = textPercent' False 2 + +-- | 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 diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs index 69eb65254..b189485a5 100644 --- a/src/Utils/Form.hs +++ b/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 -- ------------------------------------------------ diff --git a/src/index.md b/src/index.md index d90c78eb2..4dceca669 100644 --- a/src/index.md +++ b/src/index.md @@ -7,8 +7,7 @@ Utils, Utils.* : Hilfsfunktionionen _unabhängig von Foundation_ Utils - : Yesod Hilfsfunktionen und Instanzen, Text-HTML-Widget-Konvertierungen - (`DisplayAble`), Crud, `NTop`, Utility-Funktionen für `MonadPlus`, `Maybe`, + : Yesod Hilfsfunktionen und Instanzen, Crud, `NTop`, Utility-Funktionen für `MonadPlus`, `Maybe`, `MaybeT`, `Map`, und Attrs-Lists Utils.TH diff --git a/stack.nix b/stack.nix index e986ba349..a9a2af3de 100644 --- a/stack.nix +++ b/stack.nix @@ -1,16 +1,11 @@ { ghc, nixpkgs ? import }: let - snapshot = "lts-10.5"; - stackage = import (fetchTarball { - url = "https://stackage.serokell.io/drczwlyf6mi0ilh3kgv01wxwjfgvq14b-stackage/default.nix.tar.gz"; - sha256 = "1bwlbxx6np0jfl6z9gkmmcq22crm0pa07a8zrwhz5gkal64y6jpz"; - }); - inherit (nixpkgs { overlays = [ stackage."${snapshot}" ]; }) haskell pkgs; - - haskellPackages = pkgs.haskell.packages."${snapshot}"; -in haskell.lib.buildStackProject { + haskellPackages = import ./stackage.nix { inherit nixpkgs; }; + inherit (nixpkgs {}) pkgs; +in pkgs.haskell.lib.buildStackProject { inherit ghc; + inherit (haskellPackages) stack; name = "stackenv"; buildInputs = (with pkgs; [ postgresql zlib libsodium diff --git a/stack.yaml b/stack.yaml index 02b25ee57..67b72469b 100644 --- a/stack.yaml +++ b/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 diff --git a/stackage.nix b/stackage.nix new file mode 100644 index 000000000..4fb2c4623 --- /dev/null +++ b/stackage.nix @@ -0,0 +1,30 @@ +{ nixpkgs ? import +, 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}" diff --git a/templates/corrections-overview.hamlet b/templates/corrections-overview.hamlet index 621ffd51e..72775316f 100644 --- a/templates/corrections-overview.hamlet +++ b/templates/corrections-overview.hamlet @@ -3,20 +3,26 @@ _{MsgCourseParticipants nrParticipants} - +
_{MsgSheet} + _{MsgSheet} $if groupsPossible - _{MsgNrSubmittorsTotal} - _{MsgNrSubmissionsTotal} + _{MsgNrSubmittorsTotal} + _{MsgNrSubmissionsTotal} _{MsgNrSubmissionsNotAssigned} - _{MsgNrSubmissionsNotCorrected} + _{MsgNrSubmissionsNotCorrected} _{MsgCorrectionTime} +
+ _{MsgGenericNumChange} + _{MsgGenericMin} + _{MsgGenericAvg} + _{MsgGenericMax} $forall (sheetName, CorrectionInfo{ciSubmittors, ciSubmissions, ciAssigned, ciCorrected, ciMin, ciTot, ciMax}) <- Map.toList sheetMap
^{simpleLink (toWidget sheetName) (CSheetR tid ssh csh sheetName SSubsR)} $if groupsPossible #{ciSubmittors} #{ciSubmissions} - $maybe ((splus,sfailed),_) <- Map.lookup sheetName assignment + $maybe ((splus,sfailed),_,_) <- Map.lookup sheetName assignment $if 0 < Set.size sfailed #{ciSubmissions - ciAssigned} (-#{show (Set.size splus)}, failed: #{show (Set.size sfailed)}) @@ -24,9 +30,11 @@ #{ciSubmissions - ciAssigned} (-#{show (Set.size splus)}) $else - #{ciSubmissions - ciAssigned} + #{ciSubmissions - ciAssigned} + $nothing - #{ciSubmissions - ciAssigned} + #{ciSubmissions - ciAssigned} + #{ciSubmissions - ciCorrected} #{showDiffDays ciMin} #{showAvgsDays ciTot ciCorrected} @@ -35,43 +43,78 @@

_{MsgCorrectionCorrectors} - + -
_{MsgCorrector} - _{MsgNrSubmissionsTotal} - _{MsgNrSubmissionsNotCorrected} + _{MsgCorrector} + _{MsgGenericAll} + _{MsgCorDeficitProportion} _{MsgCorrectionTime} $forall shn <- sheetNames #{shn} $# ^{simpleLinkI (SomeMessage MsgMenuCorrectors) (CSheetR tid ssh csh shn SCorrR)} - $forall (CorrectionInfo{ciCorrector, ciSubmissions, ciCorrected, ciMin, ciTot, ciMax}) <- Map.elems corrMap +
_{MsgNrSubmissionsTotal} + _{MsgNrSubmissionsNotCorrected} + _{MsgGenericMin} + _{MsgGenericAvg} + _{MsgGenericMax} + $forall _shn <- sheetNames + _{MsgCorProportion} + _{MsgNrSubmissionsTotalShort} + _{MsgGenericNumChange} + _{MsgNrSubmissionsNotCorrectedShort} + _{MsgGenericAvg} + $forall (CorrectionInfo{ciCorrector, ciSubmissions=ciSubmissionsNr, ciCorrected, ciMin, ciTot, ciMax}) <- Map.elems corrMap $with (nameW,loadM) <- getCorrector ciCorrector
^{nameW} - #{ciSubmissions} - #{ciSubmissions - ciCorrected} + #{ciSubmissionsNr} + $with total <- ciSubmissions corrMapSum + $if total > 0 + \ (#{textPercent' True 0 ciSubmissionsNr total}) + #{ciSubmissionsNr - ciCorrected} + + $maybe deficit <- getCorrDeficit ciCorrector + #{rationalToFixed3 deficit} #{showDiffDays ciMin} #{showAvgsDays ciTot ciCorrected} #{showDiffDays ciMax} - $forall shn <- sheetNames - $maybe SheetCorrector{sheetCorrectorLoad, sheetCorrectorState} <- Map.lookup shn loadM - #{showCompactCorrectorLoad sheetCorrectorLoad sheetCorrectorState} - $nothing - + $forall (shn, CorrectionInfo{ciSubmissions=sheetSubmissionsNr}) <- Map.toList sheetMap + + $maybe SheetCorrector{sheetCorrectorLoad, sheetCorrectorState} <- Map.lookup shn loadM + #{showCompactCorrectorLoad sheetCorrectorLoad sheetCorrectorState} + $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 + #{ciSubmissions} + $if sheetSubmissionsNr > 0 + \ (#{textPercent' True 0 ciSubmissions sheetSubmissionsNr}) $maybe nrNew <- getCorrNewAssignment ciCorrector shn - #{ciSubmissions} $# #{ciAssigned} `ciSubmissions` is here always identical to `ciAssigned` and also works for `ciCorrector == Nothing`. ciAssigned only useful in aggregate maps like `sheetMap` (+#{nrNew}) $nothing - #{ciSubmissions} + #{ciSubmissions - ciCorrected} #{showAvgsDays ciTot ciCorrected} $nothing - + + + + $if 0 < length sheetNames
+ Σ + $with ciSubmissionsNr <- ciSubmissions corrMapSum + $with ciCorrectedNr <- ciCorrected corrMapSum + #{ciSubmissionsNr} + #{ciSubmissionsNr - ciCorrectedNr} + #{ciCorrected corrMapSum} + #{showDiffDays (ciMin corrMapSum)} + #{showAvgsDays (ciTot corrMapSum) (ciCorrected corrMapSum)} + #{showDiffDays (ciMax corrMapSum)} $forall shn <- sheetNames - ^{simpleLinkI (SomeMessage MsgMenuCorrectors) (CSheetR tid ssh csh shn SCorrR)} + #{getLoadSum shn} + ^{simpleLinkI (SomeMessage MsgMenuCorrectorsChange) (CSheetR tid ssh csh shn SCorrR)} ^{btnWdgt}

_{MsgAssignSubmissionsRandomWarning} \ No newline at end of file diff --git a/templates/default-layout.lucius b/templates/default-layout.lucius index 9db97efb6..2fdc1b3de 100644 --- a/templates/default-layout.lucius +++ b/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; } diff --git a/templates/widgets/grading-summary/grading-summary-row.hamlet b/templates/widgets/grading-summary/grading-summary-row.hamlet index 47d8d51fd..9e536fbc8 100644 --- a/templates/widgets/grading-summary/grading-summary-row.hamlet +++ b/templates/widgets/grading-summary/grading-summary-row.hamlet @@ -19,7 +19,7 @@ $# $with Sum pacv <- summary ^. _achievedPasses

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