feat(external-exams): open defaults wrt. external exam schools

Fixes #651
This commit is contained in:
Gregor Kleen 2020-11-17 13:30:18 +01:00
parent 3c322af49e
commit ef1411efdb

View File

@ -13,6 +13,8 @@ import Data.Map ((!))
import qualified Control.Monad.State.Class as State
import qualified Database.Esqueleto as E
data ExternalExamForm = ExternalExamForm
{ eefTerm :: TermId
@ -32,6 +34,7 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do
uid <- requireAuthId
cRoute <- fromMaybe (error "tutorialForm called from 404-Handler") <$> getCurrentRoute
MsgRenderer mr <- getMsgRenderer
allSchoolIds <- fmap (map E.unValue) . liftHandler . runDBRead . E.select . E.from $ return . (E.^. SchoolId)
let termsField = case template of
Just template' -> termsSetField [eefTerm template']
@ -44,6 +47,9 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do
let oldSchool = eefSchool <$> template
return (lecturerSchools, adminSchools, oldSchool)
let userSchools = nub . maybe id (:) oldSchool $ lecturerSchools ++ adminSchools
templateSchool = eefSchool <$> template <|> case userSchools of
[ssh] -> pure ssh
_ -> mzero
flip (renderAForm FormStandard) html $ ExternalExamForm
<$> areq termsField (fslI MsgExternalExamSemester) (eefTerm <$> template)
@ -52,7 +58,7 @@ externalExamForm template = validateForm validateExternalExam $ \html -> do
<*> areq (textField & cfStrip & cfCI) (fslI MsgExternalExamExamName & setTooltip MsgExternalExamExamNameTip & addPlaceholder (mr MsgExternalExamExamNamePlaceholder)) (eefExamName <$> template)
<*> aopt utcTimeField (fslI MsgExternalExamDefaultTime & setTooltip MsgExternalExamDefaultTimeTip & addPlaceholder (mr MsgExternalExamDefaultTimePlaceholder)) (eefDefaultTime <$> template)
<*> apopt (selectField optionsFinite) (fslI MsgExamGradingMode & setTooltip MsgExamGradingModeTip) (eefGradingMode <$> template <|> Just ExamGradingMixed)
<*> (Set.fromList <$> officeSchoolForm cRoute (Set.toList . eefOfficeSchools <$> template))
<*> (Set.fromList <$> officeSchoolForm cRoute (Set.toList . eefOfficeSchools <$> template <|> Just (filter ((/= templateSchool) . Just) allSchoolIds)))
<*> (Set.fromList <$> staffForm cRoute ((Set.toList . eefStaff <$> template) <|> pure (pure $ Right uid)))
where
officeSchoolForm cRoute = massInputAccumA miAdd miCell miButtonAction miLayout miIdent fSettings fRequired