From 640326ca5de12c21f87fe728bde69c21d8444320 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 20 Oct 2019 11:02:32 +0200 Subject: [PATCH 01/12] fix(assign-submissions): avoid division by zero --- src/Handler/Utils/Submission.hs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index 4df32cd24..8304c1ec8 100644 --- a/src/Handler/Utils/Submission.hs +++ b/src/Handler/Utils/Submission.hs @@ -197,6 +197,10 @@ planSubmissions sid restriction = do proportionSum = getSum . foldMap corrProportion . fromMaybe Map.empty $ correctors !? sheetId where corrProportion (_, CorrectorExcused) = mempty corrProportion (Load{..}, _) = Sum byProportion + relativeProportion :: Rational -> Rational + relativeProportion prop + | proportionSum == 0 = 0 + | otherwise = prop / proportionSum extra | Just (Load{..}, corrState) <- correctors !? sheetId >>= Map.lookup corrector = sum @@ -208,7 +212,7 @@ planSubmissions sid restriction = do return . negate . fromIntegral . Map.size $ Map.filter (\(mCorr, tutors, sheetId') -> mCorr == Just corrector && sheetId == sheetId' && Map.member corrector tutors) submissionState , fromMaybe 0 $ do guard $ corrState /= CorrectorExcused - return . negate $ (byProportion / proportionSum) * fromIntegral sheetSize + return . negate $ relativeProportion byProportion * fromIntegral sheetSize ] | otherwise = assigned From 3d3179d9fe86a4fa67c9397255299db7055eb469 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 20 Oct 2019 11:03:21 +0200 Subject: [PATCH 02/12] chore(release): 7.18.1 --- CHANGELOG.md | 9 +++++++++ package-lock.json | 2 +- package.json | 2 +- package.yaml | 2 +- 4 files changed, 12 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index c98e50ecd..8502b8709 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,15 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +### [7.18.1](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v7.18.0...v7.18.1) (2019-10-20) + + +### Bug Fixes + +* **assign-submissions:** avoid division by zero ([640326c](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/commit/640326c)) + + + ## [7.18.0](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v7.17.14...v7.18.0) (2019-10-17) diff --git a/package-lock.json b/package-lock.json index 5afa89724..0160ea0ad 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "7.18.0", + "version": "7.18.1", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index c52d819fc..afa38008c 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "7.18.0", + "version": "7.18.1", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index 45137e732..a54fa1d4a 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 7.18.0 +version: 7.18.1 dependencies: - base >=4.9.1.0 && <5 From c443ee4e0d88394978d83091b9f62ea27613f7bd Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 20 Oct 2019 12:04:46 +0200 Subject: [PATCH 03/12] style(corrections-overview): better present tutorial assignments --- src/Model/Types/Sheet.hs | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/Model/Types/Sheet.hs b/src/Model/Types/Sheet.hs index c1e9ab72e..d545c5bbb 100644 --- a/src/Model/Types/Sheet.hs +++ b/src/Model/Types/Sheet.hs @@ -316,11 +316,12 @@ derivePersistField "CorrectorState" showCompactCorrectorLoad :: Load -> CorrectorState -> Text showCompactCorrectorLoad load CorrectorMissing = "[" <> showCompactCorrectorLoad load CorrectorNormal <> "]" showCompactCorrectorLoad load CorrectorExcused = "{" <> showCompactCorrectorLoad load CorrectorNormal <> "}" -showCompactCorrectorLoad Load{..} CorrectorNormal = proportionText <> tutorialText +showCompactCorrectorLoad Load{..} CorrectorNormal | byProportion == 0 = tutorialText + | otherwise = proportionText <> " + " <> tutorialText where proportionText = let propDbl :: Double propDbl = fromRational byProportion in tshow $ roundToDigits 2 propDbl tutorialText = case byTutorial of Nothing -> mempty - Just True -> " (T)" - Just False -> " +T " + Just True -> "(T)" + Just False -> "T" From 38e511291e431c9f8b19455607fa3f0f2e075ec6 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Sun, 20 Oct 2019 12:06:12 +0200 Subject: [PATCH 04/12] chore(release): 7.18.2 --- CHANGELOG.md | 4 ++++ package-lock.json | 2 +- package.json | 2 +- package.yaml | 2 +- 4 files changed, 7 insertions(+), 3 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 8502b8709..2774095a9 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,10 @@ All notable changes to this project will be documented in this file. See [standard-version](https://github.com/conventional-changelog/standard-version) for commit guidelines. +### [7.18.2](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v7.18.1...v7.18.2) (2019-10-20) + + + ### [7.18.1](https://gitlab.cip.ifi.lmu.de/jost/UniWorX/compare/v7.18.0...v7.18.1) (2019-10-20) diff --git a/package-lock.json b/package-lock.json index 0160ea0ad..103e8599d 100644 --- a/package-lock.json +++ b/package-lock.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "7.18.1", + "version": "7.18.2", "lockfileVersion": 1, "requires": true, "dependencies": { diff --git a/package.json b/package.json index afa38008c..9a8223b87 100644 --- a/package.json +++ b/package.json @@ -1,6 +1,6 @@ { "name": "uni2work", - "version": "7.18.1", + "version": "7.18.2", "description": "", "keywords": [], "author": "", diff --git a/package.yaml b/package.yaml index a54fa1d4a..fad8d8f54 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: uniworx -version: 7.18.1 +version: 7.18.2 dependencies: - base >=4.9.1.0 && <5 From b67819d061fb3409fa9978a31cb94b700e9e86fb Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Wed, 23 Oct 2019 11:57:27 +0200 Subject: [PATCH 05/12] fix(submission-form): fix display of all courseParticipants --- src/Handler/Submission.hs | 26 +++++++++++++++++++++----- src/Handler/Utils/Form.hs | 7 ++++--- 2 files changed, 25 insertions(+), 8 deletions(-) diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index a925753dd..8e5ca85c1 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -155,9 +155,24 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident E.where_ $ participant E.^. CourseParticipantCourse E.==. E.val cid E.orderBy [E.asc $ user E.^. UserEmail] return user + previousCoSubmittors :: UserId -> E.SqlQuery (E.SqlExpr (Entity User)) + previousCoSubmittors uid = E.from $ \(user `E.InnerJoin` submissionUser `E.InnerJoin` submission `E.InnerJoin` sheet) -> do + E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet + E.&&. sheet E.^. SheetCourse E.==. E.val cid + E.on $ submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission + E.on $ user E.^. UserId E.==. submissionUser E.^. SubmissionUserUser + E.where_ . E.exists . E.from $ \submissionUser' -> + E.where_ $ submissionUser' E.^. SubmissionUserUser E.==. E.val uid + E.&&. submissionUser' E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId + E.orderBy [E.asc $ user E.^. UserEmail] + return user - addField :: (MonadHandler m, HandlerSite m ~ UniWorX) => Bool -> Field m (Set (Either UserEmail UserId)) - addField isAdmin = multiUserField True $ courseUsers <$ guard isAdmin + addField, addFieldLecturer :: (MonadHandler m, HandlerSite m ~ UniWorX) => UserId -> Field m (Set (Either UserEmail UserId)) + addField = addField' False + addFieldLecturer = addField' True + addField' isAdmin uid = multiUserField True . Just $ if + | isAdmin -> courseUsers + | otherwise -> previousCoSubmittors uid addFieldSettings, submittorSettings, singleSubSettings :: FieldSettings UniWorX addFieldSettings = fslI MsgSubmissionMembers @@ -176,12 +191,13 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident miButtonAction' mCurrent frag = mCurrent <&> \current -> SomeRoute (current :#: frag) submittorsForm - | isLecturer = do-- Form is being used by lecturer; allow Everything™ + | isLecturer = do -- Form is being used by lecturer; allow Everything™ + uid <- liftHandler requireAuthId let miAdd :: (Text -> Text) -> FieldView UniWorX -> Form ([Either UserEmail UserId] -> FormResult [Either UserEmail UserId]) miAdd nudge btn csrf = do MsgRenderer mr <- getMsgRenderer - (addRes, addView) <- mpreq (addField True) (addFieldSettings & addName (nudge "emails")) Nothing + (addRes, addView) <- mpreq (addFieldLecturer uid) (addFieldSettings & addName (nudge "emails")) Nothing let addRes' = addRes <&> \newData oldData -> if | existing <- newData `Set.intersection` Set.fromList oldData , not $ Set.null existing @@ -208,7 +224,7 @@ makeSubmissionForm cid msmid uploadMode grouping isLecturer prefillUsers = ident -> Maybe (Form (Map ListPosition (Either UserEmail UserId) -> FormResult (Map ListPosition (Either UserEmail UserId)))) miAdd _ _ nudge btn = Just $ \csrf -> do MsgRenderer mr <- getMsgRenderer - (addRes, addView) <- mpreq (addField True) (addFieldSettings & addName (nudge "emails")) Nothing + (addRes, addView) <- mpreq (addField uid) (addFieldSettings & addName (nudge "emails")) Nothing let addRes' = addRes <&> \newData oldData -> if | existing <- newData `Set.intersection` setOf folded oldData , not $ Set.null existing diff --git a/src/Handler/Utils/Form.hs b/src/Handler/Utils/Form.hs index 937d3eec3..9f132d2dd 100644 --- a/src/Handler/Utils/Form.hs +++ b/src/Handler/Utils/Form.hs @@ -1126,14 +1126,15 @@ multiUserField onlySuggested suggestions = Field{..} |] whenIsJust suggestions $ \suggestions' -> do - suggestedEmails <- fmap (Set.fromList . map E.unValue) . liftHandler . runDB . E.select $ do + suggestedEmails <- fmap (Set.fromList . map (over _2 E.unValue . over _1 E.unValue)) . liftHandler . runDB . E.select $ do user <- suggestions' - return $ user E.^. UserEmail + return $ (user E.^. UserEmail, user E.^. UserDisplayName) [whamlet| $newline never - $forall email <- suggestedEmails + $forall (email, dName) <- suggestedEmails