fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source 
Fixes #651
This commit is contained in:
Gregor Kleen 2020-11-17 13:30:18 +01:00
parent 3c322af49e
commit ef1411efdb
1 changed files with 7 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Handler/ExternalExam/Form.hs
View File

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