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/messages/uniworx/de.msg b/messages/uniworx/de.msg index 66a159c18..1b460503d 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -203,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 @@ -323,7 +324,7 @@ Correctors: Korrektoren CorState: Status CorByTut: Zuteilung nach Tutorium CorProportion: Anteil -CorDeficit: Defizit +CorDeficitProportion: Defizit Anteile CorByProportionOnly proportion@Rational: #{display proportion} Anteile CorByProportionIncludingTutorial proportion@Rational: #{display proportion} Anteile - Tutorium CorByProportionExcludingTutorial proportion@Rational: #{display proportion} Anteile + Tutorium @@ -404,6 +405,7 @@ UpdatedSheetCorrectorsAutoFailed n@Int: #{display n} #{pluralDE n "Abgabe konnte CouldNotAssignCorrectorsAuto num@Int64: #{display num} Abgaben konnten nicht automatisch zugewiesen werden: SelfCorrectors num@Int64: #{display num} Abgaben wurden Abgebenden als eigenem Korrektor zugeteilt! + CorrectionSheets: Übersicht Korrekturen nach Blättern CorrectionCorrectors: Übersicht Korrekturen nach Korrektoren AssignSubmissionExceptionNoCorrectors: Es sind keine Korrektoren eingestellt diff --git a/src/Foundation.hs b/src/Foundation.hs index 21349c919..ba5336f14 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -160,6 +160,7 @@ deriving instance Generic SheetR deriving instance Generic SubmissionR deriving instance Generic MaterialR deriving instance Generic TutorialR +deriving instance Generic ExamR deriving instance Generic (Route UniWorX) -- | Convenient Type Synonyms: @@ -1494,7 +1495,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) @@ -1518,7 +1519,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/Admin.hs b/src/Handler/Admin.hs index 6f13dba0c..1b6242611 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -165,7 +165,7 @@ postAdminTestR = do -- | Make a form for adding a point/line/plane/hyperplane/... (in this case: cell) -- - -- This /needs/ to replace all occurences of @mreq@ with @mpreq@ (no fields should be /actually/ required) + -- This /needs/ to replace all occurrences of @mreq@ with @mpreq@ (no fields should be /actually/ required) mkAddForm :: ListPosition -- ^ Approximate position of the add-widget -> Natural -- ^ Dimension Index, outermost dimension ist 0 i.e. if dimension is 3 hyperplane-adders get passed 0, planes get passed 1, lines get 2, and points get 3 -> (Text -> Text) -- ^ Nudge deterministic field ids so they're unique diff --git a/src/Handler/Corrections.hs b/src/Handler/Corrections.hs index 81335f4ac..446b93273 100644 --- a/src/Handler/Corrections.hs +++ b/src/Handler/Corrections.hs @@ -1052,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 @@ -1064,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 @@ -1126,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] @@ -1137,6 +1096,7 @@ 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, Map UserId Rational)) -> SheetId -> DB (Map SheetName ((Set SubmissionId, Set SubmissionId), Map (Maybe UserId) Int, Map UserId Rational)) @@ -1166,7 +1126,10 @@ assignHandler tid ssh csh cid assignSids = do addMessageI msg_status $ UniWorXMessages $ msg_header : catMaybes [alert_ok, alert_fail] return status return $ Map.insert shn (status, countMapElems plan, deficit) acc - assignment <- foldM buildA Map.empty assignSids + 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 @@ -1210,10 +1173,13 @@ 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 @@ -1230,7 +1196,10 @@ assignHandler tid ssh csh cid assignSids = do 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 hamlet $maybe with duplicated $nothing getCorrector :: Maybe UserId -> (Widget,Map SheetName SheetCorrector) @@ -1256,10 +1225,9 @@ assignHandler tid ssh csh cid assignSids = do getCorrDeficit _ = Nothing getLoadSum :: SheetName -> Text - getLoadSum shn - | (Just load) <- Map.lookup shn sheetLoad - = "Σ" <> showCompactCorrectorLoad load CorrectorNormal - getLoadSum _ = mempty + getLoadSum shn | (Just load) <- Map.lookup shn sheetLoad + = showCompactCorrectorLoad load CorrectorNormal + getLoadSum _ = mempty showDiffDays :: Maybe NominalDiffTime -> Text showDiffDays = foldMap formatDiffDays @@ -1272,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
| - ^{fvInput (delButtons ! coord)} - | ||
| - ^{addWidget} - | - ^{fvInput submitView} diff --git a/templates/widgets/occurrence/cell/except-no-occur.hamlet b/templates/widgets/occurrence/cell/except-no-occur.hamlet new file mode 100644 index 000000000..0019439a5 --- /dev/null +++ b/templates/widgets/occurrence/cell/except-no-occur.hamlet @@ -0,0 +1,2 @@ +$newline never +_{MsgExceptionKindNoOccur}: #{exceptTime'} diff --git a/templates/widgets/occurrence/cell/except-occur.hamlet b/templates/widgets/occurrence/cell/except-occur.hamlet new file mode 100644 index 000000000..2d8147d8b --- /dev/null +++ b/templates/widgets/occurrence/cell/except-occur.hamlet @@ -0,0 +1,2 @@ +$newline never +_{MsgExceptionKindOccur}: #{exceptStart'}–#{exceptEnd'} diff --git a/test/Database.hs b/test/Database.hs index f339ee6d0..f59df7ec2 100755 --- a/test/Database.hs +++ b/test/Database.hs @@ -605,7 +605,7 @@ fillDb = do , tutorialCapacity = Just 30 , tutorialRoom = "Hilbert-Raum" , tutorialTime = Occurrences - { occurrencesScheduled = Set.singleton $ ScheduleWeekly Tuesday (TimeOfDay 10 15 00) (TimeOfDay 12 00 00) + { occurrencesScheduled = Set.singleton $ ScheduleWeekly Tuesday (TimeOfDay 10 15 00) (TimeOfDay 12 00 00) , occurrencesExceptions = Set.empty } , tutorialRegGroup = Just "tutorium" diff --git a/test/FoundationSpec.hs b/test/FoundationSpec.hs index b7af14fe9..1edc9baa2 100644 --- a/test/FoundationSpec.hs +++ b/test/FoundationSpec.hs @@ -38,6 +38,10 @@ instance Arbitrary TutorialR where arbitrary = genericArbitrary shrink = genericShrink +instance Arbitrary ExamR where + arbitrary = genericArbitrary + shrink = genericShrink + instance Arbitrary (Route UniWorX) where arbitrary = genericArbitrary shrink = genericShrink diff --git a/test/Model/TypesSpec.hs b/test/Model/TypesSpec.hs index 833369af2..da1f578d0 100644 --- a/test/Model/TypesSpec.hs +++ b/test/Model/TypesSpec.hs @@ -26,7 +26,7 @@ import Time.Types (WeekDay(..)) instance (Arbitrary a, MonoFoldable a) => Arbitrary (NonNull a) where arbitrary = arbitrary `suchThatMap` fromNullable - + instance Arbitrary Season where arbitrary = genericArbitrary shrink = genericShrink @@ -71,7 +71,7 @@ instance Arbitrary SheetGradeSummary where instance Arbitrary SheetGroup where arbitrary = genericArbitrary shrink = genericShrink - + instance Arbitrary SheetTypeSummary where arbitrary = genericArbitrary shrink = genericShrink @@ -79,7 +79,7 @@ instance Arbitrary SheetTypeSummary where instance Arbitrary SheetFileType where arbitrary = genericArbitrary shrink = genericShrink - + instance Arbitrary SubmissionFileType where arbitrary = genericArbitrary shrink = genericShrink @@ -147,7 +147,7 @@ instance Arbitrary AuthTag where shrink = genericShrink instance CoArbitrary AuthTag where coarbitrary = genericCoarbitrary - + instance Arbitrary AuthTagActive where arbitrary = AuthTagActive <$> arbitrary shrink = genericShrink @@ -176,7 +176,7 @@ instance Arbitrary AuthenticationMode where authPWHash = unsafePerformIO . fmap decodeUtf8 $ makePasswordWith pwHashAlgorithm pw (pwHashStrength `div` 2) return $ AuthPWHash{..} ] - + shrink AuthLDAP = [] shrink (AuthPWHash _) = [AuthLDAP] @@ -195,18 +195,18 @@ instance Arbitrary Html where instance Arbitrary WeekDay where arbitrary = oneof $ map pure [minBound..maxBound] -instance Arbitrary OccurenceSchedule where +instance Arbitrary OccurrenceSchedule where arbitrary = genericArbitrary shrink = genericShrink -instance Arbitrary OccurenceException where +instance Arbitrary OccurrenceException where arbitrary = genericArbitrary shrink = genericShrink -instance Arbitrary Occurences where +instance Arbitrary Occurrences where arbitrary = genericArbitrary shrink = genericShrink - + spec :: Spec spec = do | |