From d07f53e1d8db10407d26d4fdd6e7c4c8a34b973d Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 27 Jun 2019 16:51:38 +0200 Subject: [PATCH 1/4] fix(corrector assignment): sheet tabel mixed up columns sorted some columns did not belong to each other. --- src/Handler/Corrections.hs | 15 ++++++++++++--- src/Model.hs | 9 +++++++++ templates/corrections-overview.hamlet | 26 ++++++++++++++++++-------- 3 files changed, 39 insertions(+), 11 deletions(-) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 446b93273..ddf820d18 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -1177,8 +1177,10 @@ assignHandler tid ssh csh cid assignSids = do let -- infoMap :: Map SheetName (Map (Maybe UserId) CorrectionInfo) -- repeated here for easier reference -- create aggregate maps - sheetNames :: [SheetName] - sheetNames = Map.keys infoMap + + -- Always iterate over sheetList for consistent sorting! + sheetList :: [(SheetName, CorrectionInfo)] + sheetList = Map.toDescList sheetMap -- newest Sheet first, except for CorrectionSheetTable sheetMap :: Map SheetName CorrectionInfo sheetMap = Map.map fold infoMap @@ -1197,6 +1199,11 @@ assignHandler tid ssh csh cid assignSids = do corrMap :: Map (Maybe UserId) CorrectionInfo corrMap = Map.unionsWith (<>) $ Map.elems infoMap + corrInfos :: [CorrectionInfo] + corrInfos = sortBy (compare `on` (byName . ciCorrector) ) $ Map.elems corrMap + where byName Nothing = Nothing + byName (Just uid) = Map.lookup uid correctorMap + corrMapSum :: CorrectionInfo corrMapSum = fold corrMap @@ -1235,7 +1242,9 @@ assignHandler tid ssh csh cid assignSids = do showAvgsDays Nothing _ = mempty showAvgsDays (Just dt) n = formatDiffDays $ dt / fromIntegral n heat :: Integer -> Integer -> Double - heat full achieved = roundToDigits 3 $ cutOffPercent 0.4 (fromIntegral full) (fromIntegral achieved) + heat = heat' 0.3 + heat' :: Double -> Integer -> Integer -> Double + heat' cut full achieved = roundToDigits 3 $ cutOffPercent cut (fromIntegral full^2) (fromIntegral achieved^2) let headingShort | 0 < Map.size assignment = MsgMenuCorrectionsAssignSheet $ Text.intercalate ", " $ fmap CI.original $ Map.keys assignment | otherwise = MsgMenuCorrectionsAssign diff --git a/src/Model.hs b/src/Model.hs index 45ce97e6d..ee5a8bbd8 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -37,5 +37,14 @@ deriving instance Eq (Unique Material) -- instance Eq UniqueMaterial deriving instance Eq (Unique Tutorial) -- instance Eq Tutorial deriving instance Eq (Unique Exam) +instance Ord User where + compare User{userSurname=surnameA, userDisplayName=displayNameA, userEmail=emailA} + User{userSurname=surnameB, userDisplayName=displayNameB, userEmail=emailB} + = compare surnameA surnameB + <> compare displayNameA displayNameB + <> compare emailA emailB -- userEmail is unique, so this suffices + + + submissionRatingDone :: Submission -> Bool submissionRatingDone Submission{..} = isJust submissionRatingTime diff --git a/templates/corrections-overview.hamlet b/templates/corrections-overview.hamlet index 94ada0543..61e75f123 100644 --- a/templates/corrections-overview.hamlet +++ b/templates/corrections-overview.hamlet @@ -1,5 +1,6 @@

_{MsgCorrectionSheets} + _{MsgCourseParticipants nrParticipants} @@ -16,7 +17,8 @@
_{MsgGenericMin} _{MsgGenericAvg} _{MsgGenericMax} - $forall (sheetName, CorrectionInfo{ciSubmittors, ciSubmissions, ciAssigned, ciCorrected, ciMin, ciTot, ciMax}) <- Map.toList sheetMap + $# Always iterate over sheetList for consistent sorting! Newest first, except in this table + $forall (sheetName, CorrectionInfo{ciSubmittors, ciSubmissions, ciAssigned, ciCorrected, ciMin, ciTot, ciMax}) <- reverse sheetList
^{simpleLink (toWidget sheetName) (CSheetR tid ssh csh sheetName SSubsR)} $if groupsPossible @@ -39,15 +41,19 @@ #{showDiffDays ciMin} #{showAvgsDays ciTot ciCorrected} #{showDiffDays ciMax} + +

_{MsgCorrectionCorrectors} + @@ -56,13 +62,14 @@
_{MsgCorrector} _{MsgGenericAll} _{MsgCorDeficitProportion} _{MsgCorrectionTime} - $forall shn <- sheetNames + $# Always iterate over sheetList for consistent sorting! Newest first, except in this table + $forall (shn,_) <- sheetList #{shn} $# ^{simpleLinkI (SomeMessage MsgMenuCorrectors) (CSheetR tid ssh csh shn SCorrR)}
_{MsgGenericMin} _{MsgGenericAvg} _{MsgGenericMax} - $forall _shn <- sheetNames + $# Always iterate over sheetList for consistent sorting! Newest first, except in this table + $forall _shn <- sheetList _{MsgCorProportion} _{MsgNrSubmissionsTotalShort} _{MsgGenericNumChange} _{MsgNrSubmissionsNotCorrectedShort} _{MsgGenericAvg} - $forall (CorrectionInfo{ciCorrector, ciSubmissions=ciSubmissionsNr, ciCorrected, ciMin, ciTot, ciMax}) <- Map.elems corrMap + $forall (CorrectionInfo{ciCorrector, ciSubmissions=ciSubmissionsNr, ciCorrected, ciMin, ciTot, ciMax}) <- corrInfos $with (nameW,loadM) <- getCorrector ciCorrector
^{nameW} @@ -77,7 +84,8 @@ #{showDiffDays ciMin} #{showAvgsDays ciTot ciCorrected} #{showDiffDays ciMax} - $forall (shn, CorrectionInfo{ciSubmissions=sheetSubmissionsNr}) <- Map.toList sheetMap + $# Always iterate over sheetList for consistent sorting! Newest first, except in this table + $forall (shn, CorrectionInfo{ciSubmissions=sheetSubmissionsNr}) <- sheetList $maybe SheetCorrector{sheetCorrectorLoad, sheetCorrectorState} <- Map.lookup shn loadM #{showCompactCorrectorLoad sheetCorrectorLoad sheetCorrectorState} @@ -101,7 +109,7 @@ - $if 0 < length sheetNames + $if not (null sheetList)
Σ $with ciSubmissionsNr <- ciSubmissions corrMapSum @@ -112,9 +120,11 @@ #{showDiffDays (ciMin corrMapSum)} #{showAvgsDays (ciTot corrMapSum) (ciCorrected corrMapSum)} #{showDiffDays (ciMax corrMapSum)} - $forall shn <- sheetNames + $# Always iterate over sheetList for consistent sorting! Newest first, except in this table + $forall (shn, CorrectionInfo{ciSubmissions}) <- sheetList #{getLoadSum shn} - ^{simpleLinkI (SomeMessage MsgMenuCorrectorsChange) (CSheetR tid ssh csh shn SCorrR)} + #{ciSubmissions} + ^{simpleLinkI (SomeMessage MsgMenuCorrectorsChange) (CSheetR tid ssh csh shn SCorrR)} ^{btnWdgt}

_{MsgAssignSubmissionsRandomWarning} \ No newline at end of file From 16c556b852501a5e6c88094556f5054c4d4f352b Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 27 Jun 2019 18:48:15 +0200 Subject: [PATCH 2/4] fix(correction assignment): correcting lecturer's names are shown now Table only shows sheet correctors, but lecturers may occasionally correct too --- src/Handler/Corrections.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index ddf820d18..c3a2574fe 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -1085,7 +1085,7 @@ assignHandler tid ssh csh cid assignSids = do (btnWdgt, btnResult) <- runButtonForm FIDAssignSubmissions -- gather data - (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment) <- runDB $ do + (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment, lecturerNames) <- runDB $ do -- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh nrParticipants <- count [CourseParticipantCourse ==. cid] @@ -1141,6 +1141,12 @@ assignHandler tid ssh csh cid assignSids = do in Map.insertWith (\(usr, ma) (_, mb) -> (usr, Map.union ma mb)) uid (user, Map.singleton shn sheetcorr) acc ) + -- lecturerNames :: Map UserId User + lecturerNames <- fmap entities2map $ E.select $ E.from $ \(user `E.InnerJoin` lecturer) -> do + E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser + E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid + return user + submissions <- E.select . E.from $ \submission -> do E.where_ $ submission E.^. SubmissionSheet `E.in_` E.valList sheetIds let numSubmittors = E.sub_select . E.from $ \subUser -> do @@ -1173,7 +1179,7 @@ assignHandler tid ssh csh cid assignSids = do } in Map.insertWith (Map.unionWith (<>)) shnm cinf m - return (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment) + return (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment, lecturerNames) let -- infoMap :: Map SheetName (Map (Maybe UserId) CorrectionInfo) -- repeated here for easier reference -- create aggregate maps @@ -1203,7 +1209,6 @@ assignHandler tid ssh csh cid assignSids = do corrInfos = sortBy (compare `on` (byName . ciCorrector) ) $ Map.elems corrMap where byName Nothing = Nothing byName (Just uid) = Map.lookup uid correctorMap - corrMapSum :: CorrectionInfo corrMapSum = fold corrMap @@ -1213,6 +1218,8 @@ assignHandler tid ssh csh cid assignSids = do getCorrector (Just uid) | Just (User{..},loadMap) <- Map.lookup uid correctorMap = (nameEmailWidget userEmail userDisplayName userSurname, loadMap) + | Just (User{..} ) <- Map.lookup uid lecturerNames + = (nameEmailWidget userEmail userDisplayName userSurname, mempty) -- lecturers may also correct in rare cases getCorrector _ = ([whamlet|_{MsgNoCorrectorAssigned}|], mempty) -- avoid nestes hamlet $maybe with duplicated $nothing getCorrSheetStatus :: Maybe UserId -> SheetName -> Maybe CorrectionInfo From 8476314a46fa093231e6b0664a96e94284ff506f Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Thu, 27 Jun 2019 19:53:26 +0200 Subject: [PATCH 3/4] Better fix for lecturer names --- src/Handler/Corrections.hs | 18 +++++++++--------- src/Handler/Utils/Corrections.hs | 2 ++ 2 files changed, 11 insertions(+), 9 deletions(-) diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index c3a2574fe..851c1b1c4 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -1085,7 +1085,7 @@ assignHandler tid ssh csh cid assignSids = do (btnWdgt, btnResult) <- runButtonForm FIDAssignSubmissions -- gather data - (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment, lecturerNames) <- runDB $ do + (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment) <- runDB $ do -- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh nrParticipants <- count [CourseParticipantCourse ==. cid] @@ -1141,11 +1141,11 @@ assignHandler tid ssh csh cid assignSids = do in Map.insertWith (\(usr, ma) (_, mb) -> (usr, Map.union ma mb)) uid (user, Map.singleton shn sheetcorr) acc ) - -- lecturerNames :: Map UserId User - lecturerNames <- fmap entities2map $ E.select $ E.from $ \(user `E.InnerJoin` lecturer) -> do - E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser - E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid - return user + -- -- lecturerNames :: Map UserId User + -- lecturerNames <- fmap entities2map $ E.select $ E.from $ \(user `E.InnerJoin` lecturer) -> do + -- E.on $ user E.^. UserId E.==. lecturer E.^. LecturerUser + -- E.where_ $ lecturer E.^. LecturerCourse E.==. E.val cid + -- return user submissions <- E.select . E.from $ \submission -> do E.where_ $ submission E.^. SubmissionSheet `E.in_` E.valList sheetIds @@ -1179,7 +1179,7 @@ assignHandler tid ssh csh cid assignSids = do } in Map.insertWith (Map.unionWith (<>)) shnm cinf m - return (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment, lecturerNames) + return (assignSheetNames, nrParticipants, groupsPossible, infoMap, correctorMap, assignment) let -- infoMap :: Map SheetName (Map (Maybe UserId) CorrectionInfo) -- repeated here for easier reference -- create aggregate maps @@ -1218,8 +1218,8 @@ assignHandler tid ssh csh cid assignSids = do getCorrector (Just uid) | Just (User{..},loadMap) <- Map.lookup uid correctorMap = (nameEmailWidget userEmail userDisplayName userSurname, loadMap) - | Just (User{..} ) <- Map.lookup uid lecturerNames - = (nameEmailWidget userEmail userDisplayName userSurname, mempty) -- lecturers may also correct in rare cases + -- | Just (User{..} ) <- Map.lookup uid lecturerNames + -- = (nameEmailWidget userEmail userDisplayName userSurname, mempty) -- lecturers may also correct in rare cases getCorrector _ = ([whamlet|_{MsgNoCorrectorAssigned}|], mempty) -- avoid nestes hamlet $maybe with duplicated $nothing getCorrSheetStatus :: Maybe UserId -> SheetName -> Maybe CorrectionInfo diff --git a/src/Handler/Utils/Corrections.hs b/src/Handler/Utils/Corrections.hs index ca5d433d7..2fd58de80 100644 --- a/src/Handler/Utils/Corrections.hs +++ b/src/Handler/Utils/Corrections.hs @@ -30,6 +30,8 @@ instance Semigroup CorrectionInfo where mergeWith prj f = on f prj corrA corrB keepEqual (Just x) (Just y) | x==y = Just x + keepEqual Nothing other = other + keepEqual other Nothing = other keepEqual _ _ = Nothing instance Monoid CorrectionInfo where From 2073130867ffa10c3f9469643355b8dfb67fa413 Mon Sep 17 00:00:00 2001 From: Felix Hamann Date: Fri, 28 Jun 2019 22:27:22 +0200 Subject: [PATCH 4/4] fix(datepicker): hide number input spinners in datepicker --- frontend/vendor/flatpickr.css | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/frontend/vendor/flatpickr.css b/frontend/vendor/flatpickr.css index 64e91f696..ffab7ba7e 100644 --- a/frontend/vendor/flatpickr.css +++ b/frontend/vendor/flatpickr.css @@ -1,3 +1,18 @@ +/* + custom code + hides the up/down arrows in time (number) inputs +*/ +/* webkit */ +.flatpickr-calendar input[type=number]::-webkit-inner-spin-button, +.flatpickr-calendar input[type=number]::-webkit-outer-spin-button { + -webkit-appearance: none; + margin: 0; +} +/* firefox */ +.flatpickr-calendar input[type=number] { + -moz-appearance:textfield; +} +/* vendor code */ .flatpickr-calendar { background: transparent; opacity: 0;