Merge branch 'master' of gitlab2.rz.ifi.lmu.de:uni2work/uni2work into master

This commit is contained in:
Gregor Kleen 2020-09-28 12:45:38 +02:00
commit 35737902b7
34 changed files with 734 additions and 25 deletions

View File

@ -12,6 +12,7 @@
- ignore: { name: "Use ***" }
- ignore: { name: "Redundant void" }
- ignore: { name: "Too strict maybe" }
- ignore: { name: "Use Just" }
- arguments:
- -XQuasiQuotes

View File

@ -628,6 +628,11 @@ section
&.notification--broad
max-width: none
&:first-child
margin-top: 0
&:last-child
margin-bottom: 0
.form-section-notification
display: grid
grid-template-columns: 1fr 3fr

View File

@ -1829,6 +1829,39 @@ ExamFormOccurrences: Prüfungstermine/Räume
ExamFormAutomaticFunctions: Automatische Funktionen
ExamFormCorrection: Korrektur
ExamFormParts: Teile
ExamFormMode: Ausgestaltung der Prüfung
ExamModeFormNone: Keine Angabe
ExamModeFormCustom: Benutzerdefiniert
ExamModeFormAids: Erlaubte Hilfsmittel
ExamModeFormOnline: Online/Offline
ExamModeFormSynchronicity: Synchron/Asynchron
ExamModeFormRequiredEquipment: Erforderliche Hilfsmittel
ExamModeFormRequiredEquipmentIdentificationTip: Es wird stets ein Hinweis angezeigt, dass Teilnehmer sich ausweisen können müssen.
ExamShowAids: Erlaubte Hilfsmittel
ExamShowOnline: Online/Offline
ExamShowSynchronicity: Synchron/Asynchron
ExamShowRequiredEquipment: Erforderliche Hilfsmittel
ExamShowRequiredEquipmentNoneSet: Keine Angabe durch die Kursverwalter
ExamShowIdentificationRequired: Prüfungsteilnehmer müssen sich ausweisen können. Halten Sie dafür einen amtlichen Lichtbildausweis (Personalausweis, Reisepass, Aufenthaltstitel) und Ihren Studierendenausweis bereit.
ExamOpenBook: Open Book
ExamClosedBook: Closed Book
ExamOnline: Online
ExamOffline: Offline
ExamSynchronous: Synchron
ExamAsynchronous: Asynchron
ExamRequiredEquipmentNone: Nichts
ExamRequiredEquipmentPen: Stift
ExamRequiredEquipmentPaperPen: Stift & Papier
ExamRequiredEquipmentCalculatorPen: Stift & Taschenrechner
ExamRequiredEquipmentCalculatorPaperPen: Stift, Papier & Taschenrechner
ExamRequiredEquipmentWebcamMicrophoneInternet: Webcam & Mikrophon
ExamRequiredEquipmentMicrophoneInternet: Mikrophon
ExamCorrectors: Korrektoren
ExamCorrectorsTip: Hier eingetragene Korrektoren können zwischen Beginn der Prüfung und "Bewertung abgeschlossen ab" Ergebnisse für alle Teilprüfungen und alle Teilnehmer im System hinterlegen.
@ -1881,6 +1914,10 @@ ExamFinishedMustBeAfterStart: "Ergebnisse sichtbar ab" muss nach Beginn liegen
ExamClosedMustBeAfterFinished: "Noten stehen fest ab" muss nach "Ergebnisse sichtbar ab" liegen
ExamClosedMustBeAfterStart: "Noten stehen fest ab" muss nach Beginn liegen
ExamClosedMustBeAfterEnd: "Noten stehen fest ab" muss nach Ende liegen
ExamRegistrationMustFollowSchoolSeparationFromStart dayCount@Int: Nach Regeln des Instituts #{pluralDE dayCount "muss" "müssen"} zwischen "Anmeldung ab" und "Beginn" mindestens #{dayCount} #{pluralDE dayCount "Tag" "Tage"} liegen.
ExamRegistrationMustFollowSchoolDuration dayCount@Int: Nach Regeln des Instituts #{pluralDE dayCount "muss" "müssen"} zwischen "Anmeldung ab" und "Anmeldung bis" mindestens #{dayCount} #{pluralDE dayCount "Tag" "Tage"} liegen.
ExamModeRequiredForRegistration: Nach Regeln des Institus muss die "Ausgestaltung der Prüfung" vollständig angegeben sein, bevor "Anmeldung ab" festgelegt werden kann.
ExamModeSchoolDiscouraged: Nach Regeln des Instituts wird von der angegebenen "Ausgestaltung der Prüfung" abgeraten
ExamOccurrenceEndMustBeAfterStart eoName@ExamOccurrenceName: Beginn des Termins #{eoName} muss vor seinem Ende liegen
ExamOccurrenceStartMustBeAfterExamStart eoName@ExamOccurrenceName: Beginn des Termins #{eoName} muss nach Beginn der Prüfung liegen
@ -2230,6 +2267,13 @@ SchoolName: Name
SchoolLdapOrganisations: Assoziierte LDAP-Fragmente
SchoolLdapOrganisationsTip: Beim Login via LDAP werden dem Nutzer alle Institute zugeordnet deren assoziierte LDAP-Fragmente im Eintrag des Nutzer gefunden werden
SchoolLdapOrganisationMissing: LDAP-Fragment wird benötigt
SchoolExamMinimumRegisterBeforeStart: Minimale Tage zwischen Anmeldebeginn und Termin für Prüfungen
SchoolExamMinimumRegisterBeforeStartTip: Wenn angegeben werden Dozenten gezwungen Anmeldezeitraum und Prüfungstermin stets zusammen einzustellen.
SchoolExamMinimumRegisterDuration: Minimale Anmeldedauer für Prüfungen
SchoolExamMinimumRegisterDurationTip: Wenn angegeben werden Dozenten daran gehindert Anmeldefristen von weniger als der minimalen Dauer für ihre Prüfungen einzustellen.
SchoolExamRequireModeForRegistration: Prüfungsmodus erforderlich für Anmeldung
SchoolExamRequireModeForRegistrationTip: Sollen Dozenten gezwungen werden Prüfungsmodus und Anmeldefrist stets zusammen einzustellen?
SchoolExamDiscouragedModes: Prüfungsmodi mit Warnung
SchoolUpdated ssh@SchoolId: #{ssh} erfolgreich angepasst
SchoolTitle ssh@SchoolId: Institut „#{ssh}“

View File

@ -1828,6 +1828,39 @@ ExamFormOccurrences: Occurrences/rooms
ExamFormAutomaticFunctions: Automatic functions
ExamFormCorrection: Correction
ExamFormParts: Exam parts
ExamFormMode: Exam design
ExamModeFormNone: Not specified
ExamModeFormCustom: Custom
ExamModeFormAids: Permitted exam aids
ExamModeFormOnline: Online/Offline
ExamModeFormSynchronicity: Synchronous/Asynchronous
ExamModeFormRequiredEquipment: Required equipment
ExamModeFormRequiredEquipmentIdentificationTip: There will always be a note informing participants that they will need photo identification.
ExamShowAids: Permitted exam aids
ExamShowOnline: Online/Offline
ExamShowSynchronicity: Synchronous/Asynchronous
ExamShowRequiredEquipment: Required equipment
ExamShowRequiredEquipmentNoneSet: Not specified
ExamShowIdentificationRequired: Exam participants need to be able to identify themselves. Therefor please ensure that you have official photo identification („Personalausweis“, passport, residence permit) and your student identification at hand during the exam.
ExamOpenBook: Open book
ExamClosedBook: Closed book
ExamOnline: Online
ExamOffline: Offline
ExamSynchronous: Synchronous
ExamAsynchronous: Asynchronous
ExamRequiredEquipmentNone: Nothing
ExamRequiredEquipmentPen: Pen
ExamRequiredEquipmentPaperPen: Pen & paper
ExamRequiredEquipmentCalculatorPen: Pen & calculator
ExamRequiredEquipmentCalculatorPaperPen: Pen, paper & calculator
ExamRequiredEquipmentWebcamMicrophoneInternet: Webcam & microphone
ExamRequiredEquipmentMicrophoneInternet: Microphone
ExamCorrectors: Correctors
ExamCorrectorsTip: Correctors configured here may, after the start of the exam and until "Results visible from", enter exam part results for all exam parts and participants.
@ -1880,6 +1913,10 @@ ExamFinishedMustBeAfterStart: "Results visible from" must be after "start"
ExamClosedMustBeAfterFinished: "Exam achievements registered" must be after "results visible from"
ExamClosedMustBeAfterStart: "Exam achievements registered" must be after "start"
ExamClosedMustBeAfterEnd: "Exam achievements registered" must be after "end"
ExamRegistrationMustFollowSchoolSeparationFromStart dayCount: As per school rules there #{pluralEN dayCount "needs" "need"} to be at least #{dayCount} #{pluralEN dayCount "day" "days"} between "Register from" and "Start".
ExamRegistrationMustFollowSchoolDuration dayCount: As per school rules there #{pluralEN dayCount "needs" "need"} to be at least #{dayCount} #{pluralEN dayCount "day" "days"} between "Register from" and "Register to".
ExamModeRequiredForRegistration: As per school rules "Exam design" needs to be fully specified before "Register from" may be set.
ExamModeSchoolDiscouraged: As per school rules the specified "Exam design" is discouraged
ExamOccurrenceEndMustBeAfterStart eoName: End of the occurrence #{eoName} must be after it's start
ExamOccurrenceStartMustBeAfterExamStart eoName: Start of the occurrence #{eoName} must be after the exam start
@ -2230,6 +2267,13 @@ SchoolName: Name
SchoolLdapOrganisations: Associated LDAP fragments
SchoolLdapOrganisationsTip: When logging in users are associated with any departments whose associated LDAP fragments are found in the users LDAP entry
SchoolLdapOrganisationMissing: LDAP-fragment is required
SchoolExamMinimumRegisterBeforeStart: Minimum number of days between start of registration period and start of exams
SchoolExamMinimumRegisterBeforeStartTip: If specified course administrators will be forced to specify the start of the registration period and the start of the exam at the same time.
SchoolExamMinimumRegisterDuration: Minimum duration of registration period for exams
SchoolExamMinimumRegisterDurationTip: If specified course administrators will be prevented from setting a registration period of less than the specified number of days.
SchoolExamRequireModeForRegistration: Exam design required for registration
SchoolExamRequireModeForRegistrationTip: Should course administrators be forced to fully specify their exam design when setting a registration period?
SchoolExamDiscouragedModes: Exam designs to warn against
SchoolUpdated ssh: Successfully edited #{ssh}
SchoolTitle ssh: Department „#{ssh}“

View File

@ -17,6 +17,7 @@ Exam
publicStatistics Bool
gradingMode ExamGradingMode
description Html Maybe
examMode ExamMode
UniqueExam course name
ExamPart
exam ExamId

View File

@ -3,6 +3,10 @@
School json
name (CI Text)
shorthand (CI Text) -- SchoolKey :: SchoolShorthand -> SchoolId
examMinimumRegisterBeforeStart NominalDiffTime Maybe
examMinimumRegisterDuration NominalDiffTime Maybe
examRequireModeForRegistration Bool default=false
examDiscouragedModes ExamModeDNF
UniqueSchool name
UniqueSchoolShorthand shorthand -- required for Normalisation of CI Text
Primary shorthand -- newtype Key School = SchoolKey { unSchoolKey :: SchoolShorthand }

View File

@ -158,6 +158,7 @@ other-extensions:
- IncoherentInstances
- OverloadedLists
- UndecidableInstances
- ApplicativeDo
default-extensions:
- OverloadedStrings

View File

@ -14,7 +14,10 @@ import Data.Universe.Helpers (interleave)
import Control.Monad (unless)
import Data.List (elemIndex)
import Data.List (elemIndex, nub)
import Control.Lens hiding (universe)
import Data.Generics.Product.Types
-- | Get type var bind name
@ -52,26 +55,37 @@ finiteEnum tName = do
|]
deriveUniverse, deriveFinite :: Name -> DecsQ
deriveUniverse = deriveUniverse' [e|interleave|] [e|universe|]
deriveFinite tName = fmap concat . sequence $
[ deriveUniverse' [e|concat|] [e|universeF|] tName
, do
DatatypeInfo{..} <- reifyDatatype tName
[d|instance Finite $(foldl appT (conT datatypeName) $ map (varT . getTVBName) datatypeVars)|]
]
deriveUniverse tName = view _1 <$> deriveUniverse' [e|interleave|] [e|universe|] ([t|Universe|] `appT`) tName
deriveFinite tName = do
(decs, iCxt) <- deriveUniverse' [e|concat|] [e|universeF|] ([t|Finite|] `appT`) tName
fmap concat . sequence $
[ pure decs
, do
DatatypeInfo{..} <- reifyDatatype tName
pure <$> instanceD (pure iCxt) (appT [t|Finite|] . foldl appT (conT datatypeName) $ map (varT . getTVBName) datatypeVars) []
]
deriveUniverse' :: ExpQ -> ExpQ -> Name -> DecsQ
deriveUniverse' interleaveExp universeExp tName = do
deriveUniverse' :: ExpQ -> ExpQ -> (TypeQ -> TypeQ) -> Name -> Q ([Dec], Cxt)
deriveUniverse' interleaveExp universeExp mkCxt tName = do
DatatypeInfo{..} <- reifyDatatype tName
let datatype = foldl appT (conT datatypeName) $ map (varT . getTVBName) datatypeVars
consUniverse ConstructorInfo{..} = do
let consUniverse ConstructorInfo{..} = do
unless (null constructorVars) $
fail "Constructors with variables no supported"
foldl (\f t -> [e|ap|] `appE` f `appE` sigE universeExp (listT `appT` t)) [e|pure $(conE constructorName)|] $ map pure constructorFields
pure <$> instanceD (cxt []) [t|Universe $(datatype)|]
typ = foldl (\t bndr -> t `appT` varT (getTVBName bndr)) (conT tName) datatypeVars
iCxt = map (mkCxt . pure) $ filter (\t -> any (flip (elemOf types) t) usedTVars) fieldTypes
where usedTVars = filter (\n -> any (`usesVar` n) datatypeCons) $ map getTVBName datatypeVars
usesVar ConstructorInfo{..} n
| n `elem` map getTVBName constructorVars = False
| otherwise = any (elemOf types n) constructorFields
fieldTypes = nub $ concatMap constructorFields datatypeCons
iCxt' <- cxt iCxt
(, iCxt') . pure <$> instanceD (pure iCxt') [t|Universe $(typ)|]
[ funD 'universe
[ clause [] (normalB . appE interleaveExp . listE $ map consUniverse datatypeCons) []
]

View File

@ -221,6 +221,10 @@ embedRenderMessage ''UniWorX ''Quoting ("Csv" <>)
embedRenderMessage ''UniWorX ''FavouriteReason id
embedRenderMessage ''UniWorX ''Sex id
embedRenderMessage ''UniWorX ''ExamGradingMode id
embedRenderMessage ''UniWorX ''ExamAidsPreset id
embedRenderMessage ''UniWorX ''ExamOnlinePreset id
embedRenderMessage ''UniWorX ''ExamSynchronicityPreset id
embedRenderMessage ''UniWorX ''ExamRequiredEquipmentPreset id
embedRenderMessage ''UniWorX ''AuthenticationMode id

View File

@ -25,7 +25,7 @@ postEEditR tid ssh csh examn = do
return (cid, exam, template)
((editExamResult, editExamWidget), editExamEnctype) <- runFormPost . validateForm validateExam . examForm $ Just template
((editExamResult, editExamWidget), editExamEnctype) <- runFormPost . validateForm (validateExam cid $ Just oldExam) . examForm $ Just template
formResult editExamResult $ \ExamForm{..} -> do
insertRes <- runDBJobs $ do
@ -48,6 +48,7 @@ postEEditR tid ssh csh examn = do
, examPublicStatistics = efPublicStatistics
, examGradingMode = efGradingMode
, examDescription = efDescription
, examExamMode = efExamMode
}
when (is _Nothing insertRes) $ do

View File

@ -12,12 +12,14 @@ import Handler.Exam.CorrectorInvite ()
import Handler.Utils
import Handler.Utils.Invitations
import Handler.Utils.Exam (evalExamModeDNF)
import Data.Map ((!))
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Database.Esqueleto as E
import qualified Database.Esqueleto.Utils as E
import qualified Control.Monad.State.Class as State
import Text.Blaze.Html.Renderer.String (renderHtml)
@ -40,6 +42,7 @@ data ExamForm = ExamForm
, efGradingRule :: Maybe ExamGradingRule
, efBonusRule :: Maybe ExamBonusRule
, efOccurrenceRule :: ExamOccurrenceRule
, efExamMode :: ExamMode
, efCorrectors :: Set (Either UserEmail UserId)
, efExamParts :: Set ExamPartForm
}
@ -117,6 +120,8 @@ examForm template html = do
<*> optionalActionA (examGradingRuleForm $ efGradingRule =<< template) (fslI MsgExamAutomaticGrading & setTooltip MsgExamAutomaticGradingTip) (is _Just . efGradingRule <$> template)
<*> optionalActionA (examBonusRuleForm $ efBonusRule =<< template) (fslI MsgExamBonus) (is _Just . efBonusRule <$> template)
<*> examOccurrenceRuleForm (efOccurrenceRule <$> template)
<* aformSection MsgExamFormMode
<*> examModeForm (efExamMode <$> template)
<* aformSection MsgExamFormCorrection
<*> examCorrectorsForm (efCorrectors <$> template)
<* aformSection MsgExamFormParts
@ -302,6 +307,7 @@ examFormTemplate (Entity eId Exam{..}) = do
Entity _ ExamCorrector{..} <- correctors
return examCorrectorUser
]
, efExamMode = examExamMode
}
examTemplate :: CourseId -> DB (Maybe ExamForm)
@ -347,11 +353,12 @@ examTemplate cid = runMaybeT $ do
, efOccurrences = Set.empty
, efExamParts = Set.empty
, efCorrectors = Set.empty
, efExamMode = examExamMode oldExam
}
validateExam :: (MonadHandler m, HandlerSite m ~ UniWorX) => FormValidator ExamForm m ()
validateExam = do
validateExam :: (MonadHandler m, HandlerSite m ~ UniWorX) => CourseId -> Maybe Exam -> FormValidator ExamForm m ()
validateExam cId oldExam = do
ExamForm{..} <- State.get
guardValidation MsgExamRegisterToMustBeAfterRegisterFrom $ NTop efRegisterTo >= NTop efRegisterFrom
@ -377,3 +384,50 @@ validateExam = do
]
guardValidation (MsgExamOccurrenceDuplicateName $ eofName a) $ ((/=) `on` eofName) a b
mSchool <- liftHandler . runDB . E.selectMaybe . E.from $ \(course `E.InnerJoin` school) -> do
E.on $ course E.^. CourseSchool E.==. school E.^. SchoolId
E.where_ $ course E.^. CourseId E.==. E.val cId
return school
whenIsJust mSchool $ \(Entity _ School{..}) -> do
whenIsJust schoolExamMinimumRegisterBeforeStart $ \minSep -> do
let doValidation
| Just Exam{..} <- oldExam
, not . fromMaybe True $ (>=) <$> examStart <*> (addUTCTime minSep <$> examRegisterFrom)
= warnValidation
| otherwise
= guardValidation
doValidation (MsgExamRegistrationMustFollowSchoolSeparationFromStart . ceiling $ minSep / nominalDay)
. fromMaybe True $ (>=) <$> efStart <*> (addUTCTime minSep <$> efRegisterFrom)
whenIsJust schoolExamMinimumRegisterDuration $ \minDur -> do
let doValidation
| Just Exam{..} <- oldExam
, not . fromMaybe True $ (>=) <$> examRegisterTo <*> (addUTCTime minDur <$> examRegisterFrom)
= warnValidation
| otherwise
= guardValidation
doValidation (MsgExamRegistrationMustFollowSchoolDuration . ceiling $ minDur / nominalDay)
. fromMaybe True $ (>=) <$> efRegisterTo <*> (addUTCTime minDur <$> efRegisterFrom)
when schoolExamRequireModeForRegistration $ do
let doValidation
| Just Exam{ examExamMode = ExamMode{..}, .. } <- oldExam
, or [ is _Nothing examAids
, is _Nothing examOnline
, is _Nothing examSynchronicity
, is _Nothing examRequiredEquipment
]
, is _Just examRegisterFrom
= warnValidation
| otherwise
= guardValidation
let ExamMode{..} = efExamMode
doValidation MsgExamModeRequiredForRegistration
$ is _Nothing efRegisterFrom
|| and [ is _Just examAids
, is _Just examOnline
, is _Just examSynchronicity
, is _Just examRequiredEquipment
]
warnValidation MsgExamModeSchoolDiscouraged . not $ evalExamModeDNF schoolExamDiscouragedModes efExamMode

View File

@ -24,7 +24,7 @@ postCExamNewR tid ssh csh = do
template <- examTemplate cid
return (cid, template)
((newExamResult, newExamWidget), newExamEnctype) <- runFormPost . validateForm validateExam $ examForm template
((newExamResult, newExamWidget), newExamEnctype) <- runFormPost . validateForm (validateExam cid Nothing) $ examForm template
formResult newExamResult $ \ExamForm{..} -> do
insertRes <- runDBJobs $ do
@ -49,6 +49,7 @@ postCExamNewR tid ssh csh = do
, examGradingMode = efGradingMode
, examPublicStatistics = efPublicStatistics
, examDescription = efDescription
, examExamMode = efExamMode
}
whenIsJust insertRes $ \examid -> do
insertMany_

View File

@ -26,8 +26,9 @@ getEShowR tid ssh csh examn = do
cTime <- liftIO getCurrentTime
mUid <- maybeAuthId
(Entity eId Exam{..}, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), registeredCount, lecturerInfoShown) <- runDB $ do
(Entity eId Exam{..}, School{..}, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), registeredCount, lecturerInfoShown) <- runDB $ do
exam@(Entity eId Exam{..}) <- fetchExam tid ssh csh examn
school <- getJust examCourse >>= belongsToJust courseSchool
let examVisible = NTop (Just cTime) >= NTop examVisibleFrom
@ -82,7 +83,7 @@ getEShowR tid ssh csh examn = do
lecturerInfoShown <- hasReadAccessTo $ CExamR tid ssh csh examn EEditR
return (exam, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), registeredCount, lecturerInfoShown)
return (exam, school, examParts, examVisible, (gradingVisible, gradingShown), (occurrenceAssignmentsVisible, occurrenceAssignmentsShown), results, result, bonus, occurrences, (registered, mayRegister), registeredCount, lecturerInfoShown)
let occurrenceNamesShown = lecturerInfoShown
partNumbersShown = lecturerInfoShown
@ -174,6 +175,11 @@ getEShowR tid ssh csh examn = do
let heading = prependCourseTitle tid ssh csh $ CI.original examName
notificationDiscouragedExamMode <- runMaybeT $ do
guard $ evalExamModeDNF schoolExamDiscouragedModes examExamMode
guardM . hasWriteAccessTo $ CExamR tid ssh csh examn EEditR
return $ notification NotificationBroad =<< messageI Warning MsgExamModeSchoolDiscouraged
siteLayoutMsg heading $ do
setTitleI heading
let
@ -190,4 +196,6 @@ getEShowR tid ssh csh examn = do
occurrenceMapping :: ExamOccurrenceName -> Maybe Widget
occurrenceMapping occName = examOccurrenceMappingDescriptionWidget <$> fmap examOccurrenceMappingRule examExamOccurrenceMapping <*> (examExamOccurrenceMapping >>= Map.lookup occName . examOccurrenceMappingMapping)
notificationPersonalIdentification = notification NotificationBroad =<< messageIconI Info IconPersonalIdentification MsgExamShowIdentificationRequired
$(widgetFile "exam-show")

View File

@ -62,6 +62,10 @@ data SchoolForm = SchoolForm
{ sfShorthand :: CI Text
, sfName :: CI Text
, sfOrgUnits :: Set (CI Text)
, sfExamMinimumRegisterBeforeStart
, sfExamMinimumRegisterDuration :: Maybe NominalDiffTime
, sfExamRequireModeForRegistration :: Bool
, sfExamDiscouragedModes :: ExamModeDNF
}
mkSchoolForm :: Maybe SchoolId -> Maybe SchoolForm -> Form SchoolForm
@ -69,6 +73,10 @@ mkSchoolForm mSsh template = renderAForm FormStandard $ SchoolForm
<$> maybe (\f fs -> areq f fs (sfShorthand <$> template)) (\ssh f fs -> aforced f fs (unSchoolKey ssh)) mSsh (textField & cfStrip & cfCI) (fslI MsgSchoolShort)
<*> areq (textField & cfStrip & cfCI) (fslI MsgSchoolName) (sfName <$> template)
<*> (Set.fromList . mapMaybe (fmap CI.mk . assertM' (not . Text.null) . Text.strip . CI.original) <$> massInputListA (ciField & addDatalist ldapOrgs) (const "") MsgSchoolLdapOrganisationMissing (const Nothing) ("ldap-organisations" :: Text) (fslI MsgSchoolLdapOrganisations & setTooltip MsgSchoolLdapOrganisationsTip) False (Set.toList . sfOrgUnits <$> template))
<*> aopt daysField (fslI MsgSchoolExamMinimumRegisterBeforeStart & setTooltip MsgSchoolExamMinimumRegisterBeforeStartTip) (sfExamMinimumRegisterBeforeStart <$> template)
<*> aopt daysField (fslI MsgSchoolExamMinimumRegisterDuration & setTooltip MsgSchoolExamMinimumRegisterDurationTip) (sfExamMinimumRegisterDuration <$> template)
<*> apopt checkBoxField (fslI MsgSchoolExamRequireModeForRegistration & setTooltip MsgSchoolExamRequireModeForRegistration) (sfExamRequireModeForRegistration <$> template)
<*> areq pathPieceField (fslI MsgSchoolExamDiscouragedModes) (sfExamDiscouragedModes <$> template <|> pure (ExamModeDNF predDNFFalse))
where
ldapOrgs :: HandlerFor UniWorX (OptionList (CI Text))
ldapOrgs = fmap (mkOptionList . map (\t -> Option (CI.original t) t (CI.original t)) . Set.toAscList) . runDB $
@ -82,6 +90,10 @@ schoolToForm ssh = do
{ sfShorthand = schoolShorthand
, sfName = schoolName
, sfOrgUnits = setOf (folded . _entityVal . _schoolLdapOrgUnit) ldapFrags
, sfExamMinimumRegisterBeforeStart = schoolExamMinimumRegisterBeforeStart
, sfExamMinimumRegisterDuration = schoolExamMinimumRegisterDuration
, sfExamRequireModeForRegistration = schoolExamRequireModeForRegistration
, sfExamDiscouragedModes = schoolExamDiscouragedModes
}
@ -94,7 +106,13 @@ postSchoolEditR ssh = do
formResult sfResult $ \SchoolForm{..} -> do
runDB $ do
update ssh [ SchoolName =. sfName ]
update ssh
[ SchoolName =. sfName
, SchoolExamMinimumRegisterBeforeStart =. sfExamMinimumRegisterBeforeStart
, SchoolExamMinimumRegisterDuration =. sfExamMinimumRegisterDuration
, SchoolExamRequireModeForRegistration =. sfExamRequireModeForRegistration
, SchoolExamDiscouragedModes =. sfExamDiscouragedModes
]
forM_ sfOrgUnits $ \schoolLdapOrgUnit ->
void $ upsert SchoolLdap
{ schoolLdapSchool = Just ssh
@ -131,6 +149,10 @@ postSchoolNewR = do
didInsert <- is _Just <$> insertUnique School
{ schoolShorthand = sfShorthand
, schoolName = sfName
, schoolExamMinimumRegisterBeforeStart = sfExamMinimumRegisterBeforeStart
, schoolExamMinimumRegisterDuration = sfExamMinimumRegisterDuration
, schoolExamRequireModeForRegistration = sfExamRequireModeForRegistration
, schoolExamDiscouragedModes = sfExamDiscouragedModes
}
when didInsert $ do
insert_ UserFunction

View File

@ -11,6 +11,8 @@ module Handler.Utils.Exam
, _eaocMinimizeRooms, _eaocFinenessCost, _eaocNudge, _eaocNudgeSize
, examAutoOccurrence
, deregisterExamUsersCount, deregisterExamUsers
, examAidsPresetWidget, examOnlinePresetWidget, examSynchronicityPresetWidget, examRequiredEquipmentPresetWidget
, evalExamModeDNF
) where
import Import
@ -50,6 +52,8 @@ import qualified Data.Char as Char
import qualified Data.RFC5051 as RFC5051
import Handler.Utils.I18n
fetchExamAux :: ( SqlBackendCanRead backend
, E.SqlSelect b a
@ -641,3 +645,38 @@ deregisterExamUsersCount eId uids = do
deregisterExamUsers :: (MonadIO m, HandlerSite m ~ UniWorX, MonadHandler m, MonadCatch m) => ExamId -> [UserId] -> SqlPersistT m ()
deregisterExamUsers eId uids = void $ deregisterExamUsersCount eId uids
examAidsPresetWidget :: ExamAidsPreset -> Widget
examAidsPresetWidget preset = $(i18nWidgetFile "exam-mode/aids")
examOnlinePresetWidget :: ExamOnlinePreset -> Widget
examOnlinePresetWidget preset = $(i18nWidgetFile "exam-mode/online")
examSynchronicityPresetWidget :: ExamSynchronicityPreset -> Widget
examSynchronicityPresetWidget preset = $(i18nWidgetFile "exam-mode/synchronicity")
examRequiredEquipmentPresetWidget :: ExamRequiredEquipmentPreset -> Widget
examRequiredEquipmentPresetWidget preset = $(i18nWidgetFile "exam-mode/requiredEquipment")
evalExamModeDNF :: ExamModeDNF -> ExamMode -> Bool
evalExamModeDNF (ExamModeDNF PredDNF{..}) ExamMode{..}
= dnfTerms
& map (Set.toList . toNullable) . Set.toList
& map ( maybe True (ofoldr1 (&&))
. fromNullable
. map (\pl -> bool id not (is _PLNegated pl) . evalPred $ plVar pl)
)
& maybe False (ofoldr1 (||)) . fromNullable
where
evalPred :: ExamModePredicate -> Bool
evalPred = \case
ExamModePredAids p
-> examAids == Just (ExamAidsPreset p)
ExamModePredOnline p
-> examOnline == Just (ExamOnlinePreset p)
ExamModePredSynchronicity p
-> examSynchronicity == Just (ExamSynchronicityPreset p)
ExamModePredRequiredEquipment p
-> examRequiredEquipment == Just (ExamRequiredEquipmentPreset p)

View File

@ -19,6 +19,8 @@ import Handler.Utils.I18n
import Handler.Utils.Files
import Handler.Utils.Exam
import Import
import Data.Char ( chr, ord, isDigit )
import qualified Data.Char as Char
@ -1944,3 +1946,97 @@ courseParticipantStateIsActiveField optMsg = hoistField liftHandler . isoField (
userOptionsE :: E.SqlQuery (E.SqlExpr (Entity User))
-> Handler (OptionList UserId)
userOptionsE = fmap (fmap entityKey) . flip optionsCryptoIdE userDisplayName
data CustomPresetFormOption p
= CPFONone
| CPFOPreset p
| CPFOCustom
deriving (Eq, Ord, Read, Show, Generic, Typeable)
deriveFinite ''CustomPresetFormOption
derivePathPiece ''CustomPresetFormOption (camelToPathPiece' 1) "--"
customPresetForm :: forall a custom preset msg.
( Finite preset, Ord preset, PathPiece preset
, RenderMessage UniWorX msg
)
=> Iso' a (Either custom preset)
-> Maybe (SomeMessage UniWorX, Maybe Widget) -- ^ Label for none option
-> Maybe (SomeMessage UniWorX, Maybe Widget) -- ^ Label for custom option
-> (preset -> (msg, Maybe Widget))
-> (Maybe custom -> AForm Handler custom)
-> FieldSettings UniWorX
-> Maybe (Maybe a)
-> AForm Handler (Maybe a)
customPresetForm cpL noneOption customOption toOption customForm fs mPrev
= explainedMultiActionA actionMap options fs mPrev'
where
mPrev' = flip fmap mPrev $ preview (_Just . cpL) >>> \case
Nothing -> CPFONone
Just (Left _) -> CPFOCustom
Just (Right p) -> CPFOPreset p
options = explainOptionList options' $ hoistMaybe . optionToWidget
where options' = do
MsgRenderer mr <- getMsgRenderer
let olReadExternal t = do
opt <- fromPathPiece t
case opt of
CPFONone -> opt <$ hoistMaybe noneOption
CPFOCustom -> opt <$ hoistMaybe customOption
CPFOPreset _ -> pure opt
olOptions = do
optionInternalValue <- universeF
optionDisplay <- case optionInternalValue of
CPFONone -> views _1 mr <$> hoistMaybe noneOption
CPFOCustom -> views _1 mr <$> hoistMaybe customOption
CPFOPreset p -> return . views _1 mr $ toOption p
let optionExternalValue = toPathPiece optionInternalValue
return Option{..}
return OptionList{..}
optionToWidget = \case
CPFONone -> noneOption ^? _Just . _2 . _Just
CPFOCustom -> customOption ^? _Just . _2 . _Just
CPFOPreset p -> toOption p ^. _2
actionMap :: Map (CustomPresetFormOption preset) (AForm Handler (Maybe a))
actionMap = Map.fromList $ do
opt <- universeF
return . (opt, ) $ case opt of
CPFONone -> pure Nothing
CPFOPreset p -> pure . Just $ cpL # Right p
CPFOCustom -> reviews cpL Just . Left <$> customForm (mPrev ^? _Just . _Just . cpL . _Left)
examModeForm :: Maybe ExamMode -> AForm Handler ExamMode
examModeForm mPrev = examMode
<$> customPresetForm examSynchronicityEither (Just (SomeMessage MsgExamModeFormNone, Nothing)) (Just (SomeMessage MsgExamModeFormCustom, Nothing)) (id &&& Just . examSynchronicityPresetWidget) (apreq htmlField (fslI MsgExamModeFormSynchronicity)) (fslI MsgExamModeFormSynchronicity) (examSynchronicity <$> mPrev)
<*> customPresetForm examOnlineEither (Just (SomeMessage MsgExamModeFormNone, Nothing)) (Just (SomeMessage MsgExamModeFormCustom, Nothing)) (id &&& Just . examOnlinePresetWidget) (apreq htmlField (fslI MsgExamModeFormOnline)) (fslI MsgExamModeFormOnline) (examOnline <$> mPrev)
<*> customPresetForm examAidsEither (Just (SomeMessage MsgExamModeFormNone, Nothing)) (Just (SomeMessage MsgExamModeFormCustom, Nothing)) (id &&& Just . examAidsPresetWidget) (apreq htmlField (fslI MsgExamModeFormAids)) (fslI MsgExamModeFormAids) (examAids <$> mPrev)
<*> customPresetForm examRequiredEquipmentEither (Just (SomeMessage MsgExamModeFormNone, Nothing)) (Just (SomeMessage MsgExamModeFormCustom, Nothing)) (id &&& Just . examRequiredEquipmentPresetWidget) (apreq htmlField (fslI MsgExamModeFormRequiredEquipment)) (fslI MsgExamModeFormRequiredEquipment & setTooltip MsgExamModeFormRequiredEquipmentIdentificationTip) (examRequiredEquipment <$> mPrev)
where
examMode examSynchronicity examOnline examAids examRequiredEquipment = ExamMode{..}
examAidsEither :: Iso' ExamAids (Either Html ExamAidsPreset)
examAidsEither = iso examAidsToEither examAidsFromEither
where examAidsToEither (ExamAidsPreset p) = Right p
examAidsToEither (ExamAidsCustom c) = Left c
examAidsFromEither (Right p) = ExamAidsPreset p
examAidsFromEither (Left c) = ExamAidsCustom c
examOnlineEither :: Iso' ExamOnline (Either Html ExamOnlinePreset)
examOnlineEither = iso examOnlineToEither examOnlineFromEither
where examOnlineToEither (ExamOnlinePreset p) = Right p
examOnlineToEither (ExamOnlineCustom c) = Left c
examOnlineFromEither (Right p) = ExamOnlinePreset p
examOnlineFromEither (Left c) = ExamOnlineCustom c
examSynchronicityEither :: Iso' ExamSynchronicity (Either Html ExamSynchronicityPreset)
examSynchronicityEither = iso examSynchronicityToEither examSynchronicityFromEither
where examSynchronicityToEither (ExamSynchronicityPreset p) = Right p
examSynchronicityToEither (ExamSynchronicityCustom c) = Left c
examSynchronicityFromEither (Right p) = ExamSynchronicityPreset p
examSynchronicityFromEither (Left c) = ExamSynchronicityCustom c
examRequiredEquipmentEither :: Iso' ExamRequiredEquipment (Either Html ExamRequiredEquipmentPreset)
examRequiredEquipmentEither = iso examRequiredEquipmentToEither examRequiredEquipmentFromEither
where examRequiredEquipmentToEither (ExamRequiredEquipmentPreset p) = Right p
examRequiredEquipmentToEither (ExamRequiredEquipmentCustom c) = Left c
examRequiredEquipmentFromEither (Right p) = ExamRequiredEquipmentPreset p
examRequiredEquipmentFromEither (Left c) = ExamRequiredEquipmentCustom c

View File

@ -950,6 +950,17 @@ customMigrations = Map.fromListWith (>>)
INSERT INTO file_content_entry (hash, chunk_hash, ix) (SELECT hash, hash as chunk_hash, 0 as ix FROM file_content_chunk);
|]
)
, ( AppliedMigrationKey [migrationVersion|41.0.0|] [version|42.0.0|]
, do
whenM (tableExists "exam")
[executeQQ|
ALTER TABLE exam ADD COLUMN "exam_mode" jsonb NOT NULL DEFAULT #{ExamMode Nothing Nothing Nothing Nothing};
|]
whenM (tableExists "school")
[executeQQ|
ALTER TABLE school ADD COLUMN "exam_discouraged_modes" jsonb NOT NULL DEFAULT #{ExamModeDNF predDNFFalse};
|]
)
]

View File

@ -32,6 +32,12 @@ module Model.Types.Exam
, hasExamGradingPass, hasExamGradingGrades
, ExamPartNumber
, _ExamPartNumber, _ExamPartNumber'
, ExamAids(..), ExamAidsPreset(..)
, ExamOnline(..), ExamOnlinePreset(..)
, ExamSynchronicity(..), ExamSynchronicityPreset(..)
, ExamRequiredEquipment(..), ExamRequiredEquipmentPreset(..)
, ExamMode(..)
, ExamModePredicate(..), ExamModeDNF(..)
) where
import Import.NoModel
@ -59,6 +65,8 @@ import qualified Data.Foldable
import Data.Aeson (genericToJSON, genericParseJSON)
import Model.Types.Security
{-# ANN module ("HLint: ignore Use newtype instead of data" :: String) #-}
@ -427,3 +435,125 @@ pathPieceJSONKey ''ExamPartNumber
instance Enum ExamPartNumber where
toEnum = review _ExamPartNumber' . toEnum
fromEnum = maybe (error "Converting non-numeric ExamPartNumber to Int") fromEnum . preview _ExamPartNumber'
data ExamAids
= ExamAidsPreset { examAidsPreset :: ExamAidsPreset }
| ExamAidsCustom { examAidsCustom :: Html }
deriving (Eq, Ord, Read, Show, Generic, Typeable)
data ExamAidsPreset
= ExamOpenBook
| ExamClosedBook
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
deriving anyclass (Universe, Finite)
deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece' 2
, fieldLabelModifier = camelToPathPiece' 2
, sumEncoding = TaggedObject "mode" "data"
} ''ExamAids
derivePersistFieldJSON ''ExamAids
nullaryPathPiece' ''ExamAidsPreset $ nameToPathPiece' 1
pathPieceJSON ''ExamAidsPreset
data ExamOnline
= ExamOnlinePreset { examOnlinePreset :: ExamOnlinePreset }
| ExamOnlineCustom { examOnlineCustom :: Html }
deriving (Eq, Ord, Read, Show, Generic, Typeable)
data ExamOnlinePreset
= ExamOnline
| ExamOffline
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
deriving anyclass (Universe, Finite)
deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece' 2
, fieldLabelModifier = camelToPathPiece' 2
, sumEncoding = TaggedObject "mode" "data"
} ''ExamOnline
derivePersistFieldJSON ''ExamOnline
nullaryPathPiece' ''ExamOnlinePreset $ nameToPathPiece' 1
pathPieceJSON ''ExamOnlinePreset
data ExamSynchronicity
= ExamSynchronicityPreset { examSynchronicityPreset :: ExamSynchronicityPreset }
| ExamSynchronicityCustom { examSynchronicityCustom :: Html }
deriving (Eq, Ord, Read, Show, Generic, Typeable)
data ExamSynchronicityPreset
= ExamSynchronous
| ExamAsynchronous
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
deriving anyclass (Universe, Finite)
deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece' 2
, fieldLabelModifier = camelToPathPiece' 2
, sumEncoding = TaggedObject "mode" "data"
} ''ExamSynchronicity
derivePersistFieldJSON ''ExamSynchronicity
nullaryPathPiece' ''ExamSynchronicityPreset $ nameToPathPiece' 1
pathPieceJSON ''ExamSynchronicityPreset
data ExamRequiredEquipment
= ExamRequiredEquipmentPreset { examRequiredEquipmentPreset :: ExamRequiredEquipmentPreset }
| ExamRequiredEquipmentCustom { examRequiredEquipmentCustom :: Html }
deriving (Eq, Ord, Read, Show, Generic, Typeable)
data ExamRequiredEquipmentPreset
= ExamRequiredEquipmentNone
| ExamRequiredEquipmentPen
| ExamRequiredEquipmentPaperPen
| ExamRequiredEquipmentCalculatorPen
| ExamRequiredEquipmentCalculatorPaperPen
| ExamRequiredEquipmentWebcamMicrophoneInternet
| ExamRequiredEquipmentMicrophoneInternet
deriving (Eq, Ord, Read, Show, Enum, Bounded, Generic, Typeable)
deriving anyclass (Universe, Finite)
deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece' 2
, fieldLabelModifier = camelToPathPiece' 2
, sumEncoding = TaggedObject "mode" "data"
} ''ExamRequiredEquipment
derivePersistFieldJSON ''ExamRequiredEquipment
nullaryPathPiece' ''ExamRequiredEquipmentPreset $ nameToPathPiece' 3
pathPieceJSON ''ExamRequiredEquipmentPreset
data ExamMode = ExamMode
{ examAids :: Maybe ExamAids
, examOnline :: Maybe ExamOnline
, examSynchronicity :: Maybe ExamSynchronicity
, examRequiredEquipment :: Maybe ExamRequiredEquipment
}
deriveJSON defaultOptions
{ fieldLabelModifier = camelToPathPiece' 1
, sumEncoding = UntaggedValue
} ''ExamMode
derivePersistFieldJSON ''ExamMode
data ExamModePredicate
= ExamModePredAids ExamAidsPreset
| ExamModePredOnline ExamOnlinePreset
| ExamModePredSynchronicity ExamSynchronicityPreset
| ExamModePredRequiredEquipment ExamRequiredEquipmentPreset
deriving (Eq, Ord, Read, Show, Generic, Typeable)
deriveJSON defaultOptions
{ constructorTagModifier = camelToPathPiece' 3
, sumEncoding = TaggedObject "setting" "preset"
} ''ExamModePredicate
derivePathPiece ''ExamModePredicate (camelToPathPiece' 3) "--"
deriveFinite ''ExamModePredicate
newtype ExamModeDNF = ExamModeDNF { examModeDNF :: PredDNF ExamModePredicate }
deriving (Eq, Ord, Read, Show, Generic, Typeable)
deriving newtype (Semigroup, Monoid, ToJSON, FromJSON, PathPiece)
derivePersistFieldJSON ''ExamModeDNF

View File

@ -184,6 +184,9 @@ dnfAssumeValue var val
disagrees PLNegated{..} = plVar == var && val
disagrees PLVariable{..} = plVar == var && not val
predDNFFalse :: PredDNF a
predDNFFalse = PredDNF Set.empty
data UserGroupName
= UserGroupMetrics

View File

@ -86,6 +86,7 @@ data Icon
| IconFileUploadSession
| IconStandaloneFieldError
| IconFileUser
| IconPersonalIdentification
deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Typeable)
iconText :: Icon -> Text
@ -150,6 +151,7 @@ iconText = \case
IconFileUploadSession -> "file-upload"
IconStandaloneFieldError -> "exclamation"
IconFileUser -> "file-user"
IconPersonalIdentification -> "id-card"
instance Universe Icon
instance Finite Icon

View File

@ -27,7 +27,7 @@ import qualified Data.HashMap.Strict as HashMap
import Numeric.Natural
import Data.List (foldl)
import Data.List (nub, foldl)
import Data.Aeson.Types
import qualified Data.Aeson.Types as Aeson
@ -37,6 +37,9 @@ import Control.Monad.Fail
import Data.Binary (Binary)
import qualified Data.Binary as Binary
import Control.Lens
import Data.Generics.Product.Types
mkFiniteFromPathPiece :: Name -> Q ([Dec], Exp)
mkFiniteFromPathPiece finiteType = do
@ -105,7 +108,7 @@ derivePathPiece adt mangle joinPP = do
[]
finDecs =
[ pragInlD mapName NoInline FunLike AllPhases
, sigD mapName [t|HashMap Text ([Text] -> Maybe $(conT adt))|]
, sigD mapName $ forallT [] (cxt iCxt) [t|HashMap Text ([Text] -> Maybe $(typ))|]
, funD mapName
[ clause [] (normalB finClause) [] ]
]
@ -123,8 +126,17 @@ derivePathPiece adt mangle joinPP = do
, match wildP (normalB [e|Nothing|]) []
]
]
typ = foldl (\t bndr -> t `appT` varT (tvarName bndr)) (conT adt) datatypeVars
iCxt = map (appT [t|PathPiece|] . pure) $ filter (\t -> any (flip (elemOf types) t) usedTVars) fieldTypes
where usedTVars = filter (\n -> any (`usesVar` n) datatypeCons) $ map tvarName datatypeVars
usesVar ConstructorInfo{..} n
| n `elem` map tvarName constructorVars = False
| otherwise = any (elemOf types n) constructorFields
fieldTypes = nub $ concatMap constructorFields datatypeCons
tvarName (PlainTV n) = n
tvarName (KindedTV n _) = n
sequence . (finDecs ++ ) . pure $
instanceD (cxt []) [t|PathPiece $(conT adt)|]
instanceD (cxt iCxt) [t|PathPiece $(typ)|]
[ funD 'toPathPiece
(map toClause datatypeCons)
, funD 'fromPathPiece

View File

@ -20,6 +20,9 @@ $maybe desc <- examDescription
#{desc}
<section>
$maybe warn <- notificationDiscouragedExamMode
^{warn}
<dl .deflist>
$if not examVisible
<dt .deflist__dt>_{MsgExamVisibleFrom}
@ -41,6 +44,41 @@ $maybe desc <- examDescription
$maybe publishAssignments <- examPublishOccurrenceAssignments
<dt .deflist__dt>_{MsgExamPublishOccurrenceAssignmentsParticipant}
<dd .deflist__dd>^{formatTimeW SelFormatDateTime publishAssignments}
$maybe online <- examOnline examExamMode
<dt .deflist__dt>_{MsgExamShowOnline}
<dd .deflist__dd>
$case online
$of ExamOnlinePreset p
^{examOnlinePresetWidget p}
$of ExamOnlineCustom c
#{c}
$maybe synchronicity <- examSynchronicity examExamMode
<dt .deflist__dt>_{MsgExamShowSynchronicity}
<dd .deflist__dd>
$case synchronicity
$of ExamSynchronicityPreset p
^{examSynchronicityPresetWidget p}
$of ExamSynchronicityCustom c
#{c}
$maybe aids <- examAids examExamMode
<dt .deflist__dt>_{MsgExamShowAids}
<dd .deflist__dd>
$case aids
$of ExamAidsPreset p
^{examAidsPresetWidget p}
$of ExamAidsCustom c
#{c}
$maybe requiredEquipment <- examRequiredEquipment examExamMode
<dt .deflist__dt>_{MsgExamShowRequiredEquipment}
<dd .deflist__dd>
<p>
$case requiredEquipment
$of ExamRequiredEquipmentPreset p
^{examRequiredEquipmentPresetWidget p}
$of ExamRequiredEquipmentCustom c
#{c}
^{notificationPersonalIdentification}
$maybe room <- examRoom
<dt .deflist__dt>_{MsgExamRoom}
<dd .deflist__dd>#{room}
@ -89,6 +127,8 @@ $maybe desc <- examDescription
_{MsgExamRegistration}
<dd .deflist__dd>
^{registerWdgt}
$if is _Nothing (examRequiredEquipment examExamMode)
^{notificationPersonalIdentification}
$if showCloseWidget && is _Nothing examClosed
<section>

View File

@ -1,5 +1,12 @@
$newline never
<dl .deflist>
<dt .deflist__dt>
^{formatGregorianW 2020 09 16}
<dd .deflist__dd>
<ul>
<li>
Es kann nun die Ausgestaltung von Prüfungen angegeben werden.
<dt .deflist__dt>
^{formatGregorianW 2020 08 28}
<dd .deflist__dd>

View File

@ -1,5 +1,12 @@
$newline never
<dl .deflist>
<dt .deflist__dt>
^{formatGregorianW 2020 09 16}
<dd .deflist__dd>
<ul>
<li>
Exam design can now be specified.
<dt .deflist__dt>
^{formatGregorianW 2020 08 28}
<dd .deflist__dd>

View File

@ -0,0 +1,9 @@
$newline never
$case preset
$of ExamOpenBook
Alle Offline-Hilfsmittel (z.B. Bücher, Notizen) sind zugelassen (“open book”).
<br />
Online-Hilfsmittel (z.B. Internet-Browser, Kommunikationsmedien jeder Form) sind nicht gestattet.
$of ExamClosedBook
Es sind keine Hilsfmittel erlaubt, die über jene, die zur Teilnahme an der Prüfung erforderlich sind (siehe unten), hinausgehen (“closed book”)

View File

@ -0,0 +1,9 @@
$newline never
$case preset
$of ExamOpenBook
All offline aids (e.g. books, notes) are allowed (“open book”).
<br />
Online aids (e.g. internet browser, communication media of any kind) are not permitted.
$of ExamClosedBook
No exam aids, beyond the required equipment (see below), are permitted (“closed book”).

View File

@ -0,0 +1,7 @@
$newline never
$case preset
$of ExamOnline
Die Prüfung findet aussschließlich online statt oder hat Teile, die ausschließlich online stattfinden
$of ExamOffline
Die Prüfung findet offline in Person statt

View File

@ -0,0 +1,7 @@
$newline never
$case preset
$of ExamOnline
The exam is held entirely online or has parts that are held entirely online
$of ExamOffline
The exam is held offline in person

View File

@ -0,0 +1,40 @@
$newline never
$case preset
$of ExamRequiredEquipmentNone
Es sind keinerlei eigene Hilfsmittel erforderlich; etwaige benötigte Werkzeuge werden von den Veranstaltern gestellt.
$of ExamRequiredEquipmentPen
<ul>
<li>Dokumentenechter Stift; nicht rot oder grün
$of ExamRequiredEquipmentPaperPen
<ul>
<li>Dokumentenechter Stift; nicht rot oder grün
<li>Ausreichend viel unbeschriebenes weißes Paper (A4)
$of ExamRequiredEquipmentCalculatorPen
<ul>
<li>Dokumentenechter Stift; nicht rot oder grün
<li>Nicht-programmierbarer Taschenrechner
$of ExamRequiredEquipmentCalculatorPaperPen
<ul>
<li>Dokumentenechter Stift; nicht rot oder grün
<li>Ausreichend viel unbeschriebenes weißes Paper (A4)
<li>Nicht-programmierbarer Taschenrechner
$of ExamRequiredEquipmentWebcamMicrophoneInternet
<ul>
<li>Webcam mit hinreichender Bildqualität um z.B. Ausweisdokumente lesen zu können
<li>
<p>
Mikrophon
<p>
Es ist Sorge zu tragen, dass die Prüfung nicht von elektronischen oder anderweitigen Störgeräuschen (Lärm, Mitbewohner, Elektronisches Feedback, etc.) gestört wird
<li>
Für die Dauer der Prüfung hinreichend zuverlässige und performante Anbindung ans Internet (idealerweise Kabelgebunden)
$of ExamRequiredEquipmentMicrophoneInternet
<ul>
<li>
<p>
Mikrophon
<p>
Es ist Sorge zu tragen, dass die Prüfung nicht von elektronischen oder anderweitigen Störgeräuschen (Lärm, Mitbewohner, Elektronisches Feedback, etc.) gestört wird
<li>
Für die Dauer der Prüfung hinreichend zuverlässige und performante Anbindung ans Internet (idealerweise Kabelgebunden)

View File

@ -0,0 +1,40 @@
$newline never
$case preset
$of ExamRequiredEquipmentNone
No equipment is required; all tools necessary for participating in the exam are provided by the course administrators.
$of ExamRequiredEquipmentPen
<ul>
<li>Pen writing in indelible ink; not red or green
$of ExamRequiredEquipmentPaperPen
<ul>
<li>Pen writing in indelible ink; not red or green
<li>Sufficient unmarked white paper (A4)
$of ExamRequiredEquipmentCalculatorPen
<ul>
<li>Pen writing in indelible ink; not red or green
<li>Non-programmable calculator
$of ExamRequiredEquipmentCalculatorPaperPen
<ul>
<li>Pen writing in indelible ink; not red or green
<li>Sufficient unmarked white paper (A4)
<li>Non-programmable calculator
$of ExamRequiredEquipmentWebcamMicrophoneInternet
<ul>
<li>Webcam with sufficient image quality to be able to verify photo identification
<li>
<p>
Microphone
<p>
The participant is required to ensure that the exam is not disturbed by electrical or other kinds of noise (housemates, electronic feedback, etc.)
<li>
Connection to the internet of sufficient performance and reliability for the duration of the exam (ideally wired)
$of ExamRequiredEquipmentMicrophoneInternet
<ul>
<li>
<p>
Microphone
<p>
The participant is required to ensure that the exam is not disturbed by electrical or other kinds of noise (housemates, electronic feedback, etc.)
<li>
Connection to the internet of sufficient performance and reliability for the duration of the exam (ideally wired)

View File

@ -0,0 +1,11 @@
$newline never
$case preset
$of ExamSynchronous
Die Teilnehmer der Prüfung erhalten zu einem festen, kurzen Zeitintervall die Möglichkeit, an ihrer Prüfungsleistung zu arbeiten.
<br />
Beispiele für synchrone Prüfungsformen sind Klausuren, mündliche Prüfungen und Praktikumsabnahmen.
$of ExamAsynchronous
Die Teilnehmer der Prüfung können bis zum Abgabezeitpunkt über einen längeren Zeitraum prinzipiell asynchron an ihrer Prüfungsleistung arbeiten.
<br />
Beispiele für asynchrone Prüfungsformen sind Hausarbeiten und Seminararbeiten.

View File

@ -0,0 +1,11 @@
$newline never
$case preset
$of ExamSynchronous
The participants are given a fixed, short interval of time during which they are given the opportunity to work on their exam performance.
<br />
Examples of synchronous exams are written exams, oral examinations.
$of ExamAsynchronous
The participants can work on their exam performance over a longer period of time in an asynchronous fashion.
<br />
Examples of asynchronous exams are term papers and seminar papers.

View File

@ -365,8 +365,8 @@ fillDb = do
, termLectureEnd
, termActive = term >= currentTerm
}
ifi <- insert' $ School "Institut für Informatik" "IfI"
mi <- insert' $ School "Institut für Mathematik" "MI"
ifi <- insert' $ School "Institut für Informatik" "IfI" (Just $ 14 * nominalDay) (Just $ 10 * nominalDay) True (ExamModeDNF predDNFFalse)
mi <- insert' $ School "Institut für Mathematik" "MI" Nothing Nothing False (ExamModeDNF predDNFFalse)
void . insert' $ UserFunction gkleen ifi SchoolAdmin
void . insert' $ UserFunction gkleen mi SchoolAdmin
void . insert' $ UserFunction fhamann ifi SchoolAdmin
@ -665,6 +665,12 @@ fillDb = do
, examPublicStatistics = True
, examGradingMode = ExamGradingGrades
, examDescription = Nothing
, examExamMode = ExamMode
{ examAids = Just $ ExamAidsPreset ExamClosedBook
, examOnline = Just $ ExamOnlinePreset ExamOffline
, examSynchronicity = Just $ ExamSynchronicityPreset ExamSynchronous
, examRequiredEquipment = Just $ ExamRequiredEquipmentPreset ExamRequiredEquipmentNone
}
}
void . insertMany $ map (\u -> ExamRegistration examFFP u Nothing now)
[ fhamann

View File

@ -39,6 +39,8 @@ import qualified Data.Conduit.Combinators as C
import Data.Ratio ((%))
import Data.Universe
instance Arbitrary EmailAddress where
arbitrary = do
@ -167,6 +169,18 @@ instance Monad m => Arbitrary (File m) where
| otherwise
= False
instance Arbitrary ExamModePredicate where
arbitrary = elements universeF
instance Arbitrary p => Arbitrary (PredLiteral p) where
arbitrary = elements [PLVariable, PLNegated] <*> arbitrary
instance (Arbitrary p, Ord p) => Arbitrary (PredDNF p) where
arbitrary = PredDNF . Set.fromList . mapMaybe (fromNullable . Set.fromList) <$> arbitrary
shrink = fmap (PredDNF . Set.fromList . mapMaybe (fromNullable . Set.fromList)) . shrink . map otoList . otoList . dnfTerms
deriving newtype instance Arbitrary ExamModeDNF
instance Arbitrary School where
arbitrary = do
names <- listOf1 $ pack . getPrintableString <$> arbitrary
@ -174,6 +188,10 @@ instance Arbitrary School where
name = Text.toTitle $ unwords names
schoolShorthand = CI.mk $ Text.filter Char.isUpper name
schoolName = CI.mk name
schoolExamMinimumRegisterBeforeStart <- arbitrary
schoolExamMinimumRegisterDuration <- arbitrary
schoolExamRequireModeForRegistration <- arbitrary
schoolExamDiscouragedModes <- arbitrary
return School{..}
instance Arbitrary Term where