Breadcrumbs shortened; Term warning added to sheet edit page.
This commit is contained in:
SJost
parent
1095bc8a6f
commit
0e6596889a
@ -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}
|
||||
|
||||
2
models
2
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
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
|
||||
@ -3,8 +3,9 @@
|
||||
<dl .deflist.profile-dl>
|
||||
<dt .deflist__dt> _{MsgName}
|
||||
<dd .deflist__dd> ^{nameWidget userDisplayName userSurname}
|
||||
<dt .deflist__dt> _{MsgMatrikelNr}
|
||||
<dd .deflist__dd> #{display userMatrikelnummer}
|
||||
$maybe matnr <- userMatrikelnummer
|
||||
<dt .deflist__dt> _{MsgMatrikelNr}
|
||||
<dd .deflist__dd> #{matnr}
|
||||
<dt .deflist__dt> _{MsgEMail}
|
||||
<dd .deflist__dd> #{display userEmail}
|
||||
<dt .deflist__dt> _{MsgIdent}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user