diff --git a/messages/uniworx/de.msg b/messages/uniworx/de.msg index e66535980..fefe2075f 100644 --- a/messages/uniworx/de.msg +++ b/messages/uniworx/de.msg @@ -285,3 +285,7 @@ DummyLoginTitle: Development-Login CorrectorNormal: Normal CorrectorMissing: Abwesend CorrectorExcused: Entschuldigt + +DayIsAHoliday tid@TermId date@Text: #{date} ist ein Feiertag +DayIsOutOfLecture tid@TermId date@Text: #{date} ist außerhalb der Vorlesungszeit des #{display tid} +DayIsOutOfTerm tid@TermId date@Text: #{date} liegt nicht im #{display tid} diff --git a/models b/models index 341499e8f..7bc1477f0 100644 --- a/models +++ b/models @@ -61,7 +61,7 @@ DegreeCourse json degree StudyDegreeId terms StudyTermsId UniqueDegreeCourse course degree terms -Course +Course name (CI Text) description Html Maybe linkExternal Text Maybe diff --git a/src/Foundation.hs b/src/Foundation.hs index 5f78d7f56..233db9e21 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -677,7 +677,7 @@ instance YesodBreadcrumbs UniWorX where breadcrumb TermCurrentR = return ("Aktuell" , Just TermShowR) breadcrumb TermEditR = return ("Neu" , Just TermCurrentR) breadcrumb (TermEditExistR tid) = return ("Editieren" , Just $ TermCourseListR tid) - breadcrumb (TermCourseListR (unTermKey -> tid)) = getMessageRender <&> \mr -> (mr $ ShortTermIdentifier tid, Just TermShowR) + breadcrumb (TermCourseListR (unTermKey -> tid)) = getMessageRender <&> \mr -> (mr $ ShortTermIdentifier tid, Nothing) breadcrumb (TermSchoolCourseListR tid ssh) = return (CI.original $ unSchoolKey ssh, Just $ TermCourseListR tid) diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index efaacf2e1..f1aa48b5f 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -106,11 +106,11 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do mr <- getMsgRenderer ctime <- liftIO $ getCurrentTime (result, widget) <- flip (renderAForm FormStandard) html $ SheetForm - <$> areq (ciField textField) (fslI MsgSheetName) (sfName <$> template) + <$> areq (ciField textField) (fslI MsgSheetName) (sfName <$> template) <*> aopt htmlField (fslI MsgSheetDescription) (sfDescription <$> template) - <*> sheetTypeAFormReq (fslI MsgSheetType) (sfType <$> template) - <*> sheetGroupAFormReq (fslI MsgSheetGroup) (sfGrouping <$> template) - <*> aopt htmlField (fslI MsgSheetMarking) (sfMarkingText <$> template) + <*> sheetTypeAFormReq (fslI MsgSheetType) (sfType <$> template) + <*> sheetGroupAFormReq (fslI MsgSheetGroup) (sfGrouping <$> template) + <*> aopt htmlField (fslI MsgSheetMarking) (sfMarkingText <$> template) <*> aopt utcTimeField (fslI MsgSheetVisibleFrom & setTooltip MsgSheetVisibleFromTip) ((sfVisibleFrom <$> template) <|> pure (Just ctime)) @@ -120,8 +120,7 @@ makeSheetForm msId template = identForm FIDsheet $ \html -> do <*> areq utcTimeField (fslI MsgSheetActiveTo) (sfActiveTo <$> template) <*> aopt (multiFileField $ oldFileIds SheetExercise) (fslI MsgSheetExercise) (sfSheetF <$> template) <*> aopt utcTimeField (fslpI MsgSheetHintFrom "Datum, sonst nur für Korrektoren" - & setTooltip MsgSheetHintFromTip) - (sfHintFrom <$> template) + & setTooltip MsgSheetHintFromTip) (sfHintFrom <$> template) <*> aopt (multiFileField $ oldFileIds SheetHint) (fslI MsgSheetHint) (sfHintF <$> template) <*> aopt utcTimeField (fslpI MsgSheetSolutionFrom "Datum, sonst nur für Korrektoren" & setTooltip MsgSheetSolutionFromTip) @@ -442,7 +441,7 @@ handleSheetEdit tid ssh csh msId template dbAction = do } mbsid <- dbAction newSheet case mbsid of - Nothing -> False <$ addMessageI "danger" (MsgSheetNameDup tid ssh csh sfName) + Nothing -> False <$ addMessageI "error" (MsgSheetNameDup tid ssh csh sfName) (Just sid) -> do -- save files in DB: whenIsJust sfSheetF $ insertSheetFile' sid SheetExercise whenIsJust sfHintF $ insertSheetFile' sid SheetHint @@ -450,12 +449,16 @@ handleSheetEdit tid ssh csh msId template dbAction = do whenIsJust sfMarkingF $ insertSheetFile' sid SheetMarking insert_ $ SheetEdit aid actTime sid addMessageI "info" $ MsgSheetEditOk tid ssh csh sfName + -- Sanity checks generating warnings only, but not errors! + warnTermDays tid [sfVisibleFrom, Just sfActiveFrom, Just sfActiveTo, sfHintFrom, sfSolutionFrom] return True when saveOkay $ redirect $ case msId of Just _ -> CSheetR tid ssh csh sfName SShowR -- redirect must happen outside of runDB Nothing -> CSheetR tid ssh csh sfName SCorrR - (FormFailure msgs) -> forM_ msgs $ (addMessage "warning") . toHtml - _ -> return () + (FormFailure msgs) -> forM_ msgs $ (addMessage "error") . toHtml + _ -> runDB $ warnTermDays tid $ (join . (flip fmap template)) + <$> [sfVisibleFrom, Just . sfActiveFrom, Just . sfActiveTo, sfHintFrom, sfSolutionFrom] + let pageTitle = maybe (MsgSheetTitleNew tid ssh csh) (MsgSheetTitle tid ssh csh) mbshn -- let formTitle = pageTitle -- no longer used in template diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index 8e51adff9..002163a6d 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -12,6 +12,8 @@ module Handler.Utils import Import import qualified Data.Text as T +import qualified Data.Set (Set) +import qualified Data.Set as Set import Handler.Utils.DateTime as Handler.Utils import Handler.Utils.Form as Handler.Utils @@ -52,3 +54,17 @@ nameWidget displayName surname |] [] -> error "Data.Text.splitOn returned empty list in violation of specification." + +warnTermDays :: TermId -> [Maybe UTCTime] -> DB () +warnTermDays tid times = do + Term{..} <- get404 tid + let alldays = Set.map utctDay $ Set.fromList $ catMaybes times + warnholidays = Set.intersection alldays $ Set.fromList termHolidays + outoftermdays = Set.filter (\d -> d < termStart || d > termEnd ) alldays + outoflecture = Set.filter (\d -> d < termLectureStart || d > termLectureEnd) alldays + `Set.difference` outoftermdays + warnI msg d = formatTime SelFormatDate d >>= \dt -> addMessageI "warning" $ msg tid dt + forM_ warnholidays $ warnI MsgDayIsAHoliday + forM_ outoflecture $ warnI MsgDayIsOutOfLecture + forM_ outoftermdays $ warnI MsgDayIsOutOfTerm + diff --git a/templates/profile.hamlet b/templates/profile.hamlet index f5bfae509..c2ae2bb18 100644 --- a/templates/profile.hamlet +++ b/templates/profile.hamlet @@ -3,8 +3,9 @@
_{MsgName}
^{nameWidget userDisplayName userSurname} -
_{MsgMatrikelNr} -
#{display userMatrikelnummer} + $maybe matnr <- userMatrikelnummer +
_{MsgMatrikelNr} +
#{matnr}
_{MsgEMail}
#{display userEmail}
_{MsgIdent}