Gregor Kleen
parent
d5b65a1b06
commit
bf64eafd08
@ -1790,6 +1790,7 @@ CourseUserExamResultDoesNotMatchMode examn@ExamName: Gewähtes Ergebnis passt ni
|
||||
CourseUserSetSubmissionGroup: Feste Abgabegruppe setzen/entfernen
|
||||
CourseUsersSubmissionGroupSetNew count@Int64: #{show count} Benutzer der festen Abgabegruppe zugeordnet
|
||||
CourseUsersSubmissionGroupUnset count@Int64: #{show count} Benutzer aus ihren jeweiligen festen Abgabegruppen entfernt
|
||||
CourseUsersStateSet count@Int64: Zustand von #{show count} #{pluralDE count "Benutzer" "Benutzern"} angepasst
|
||||
|
||||
SubmissionGroup: Feste Abgabegruppe
|
||||
NoSubmissionGroup: Keine feste Abgabegruppe
|
||||
@ -2253,8 +2254,13 @@ CourseNewsDeleteQuestion: Wollen Sie die unten aufgeführte Nachricht wirklich l
|
||||
CourseNewsDeleted: Kursnachricht erfolgreich gelöscht
|
||||
|
||||
CourseDeregistrationAllocationLog: Ihr Platz in diesem Kurs stammt aus einer Zentralanmeldung. Wenn Sie sich vom Kurs abmelden wird dieser Umstand permanent im System gespeichert und kann Sie u.U. bei zukünftigen Zentralanmeldungen benachteiligen. Wenn Sie gute Gründe vorzuweisen haben, warum Ihre Abmeldung nicht selbstverschuldet ist, kontaktieren Sie bitte einen Kursverwalter. Diese haben die Möglichkeit Sie ohne permanente Eintragung im System abzumelden.
|
||||
CourseDeregistrationNoShow: Wenn Sie sich vom Kurs abmelden, wird für alle Prüfungen des Kurses „nicht erschienen“ gemeldet. Wenn Sie gute Gründe vorzuweisen haben, warum Ihre Abmeldung nicht selbstverschuldet ist, kontaktieren Sie bitte einen Kursverwalter. Diese haben die Möglichkeit Sie ohne permanente Eintragung im System abzumelden.
|
||||
CourseDeregistrationAllocationReason: Grund
|
||||
CourseDeregistrationAllocationReasonTip: Der angegebene Grund wird permanent im System hinterlegt und ist i.A. einziger Anhaltspunkt zur Schlichtung etwaiger Konflikte
|
||||
CourseDeregistrationAllocationNoShow: „Nicht erschienen“ eintragen
|
||||
CourseDeregistrationAllocationNoShowTip: Soll für alle Prüfungen dieses Kurses „nicht erschienen“ als Prüfungsleistung eingetragen werden? Dies geschieht einmalig bei der Abmeldung (sofern nicht bereits eine Prüfungsleistung existiert) und automatisch beim Anlegen von neuen Prüfungen.
|
||||
CourseDeregisterNoShow: „Nicht erschienen“ bei Abmeldung
|
||||
CourseDeregisterNoShowTip: Soll, wenn sich Teilnehmer selbstständig abmelden, für alle Prüfungen dieses Kurses „nicht erschienen“ als Prüfungsleistung eingetragen werden? Dies geschieht einmalig bei der Abmeldung (sofern nicht bereits eine Prüfungsleistung existiert) und automatisch beim Anlegen von neuen Prüfungen.
|
||||
CourseDeregistrationAllocationShouldLog: Selbstverschuldet
|
||||
CourseDeregistrationAllocationShouldLogTip: Falls der Platz des Studierenden, der abgemeldet wird, aus einer Zentralanmeldung stammt, ist vorgesehen einen permanenten Eintrag im System zu speichern, der den Studierenden u.U. bei zukünftigen Zentralanmeldungen benachteiligt. Als Kursverwalter haben Sie die Möglichkeit dies zu unterbinden, wenn der Studierende gute Gründe vorweisen kann, warum seine Abmeldung nicht selbstverschuldet ist.
|
||||
|
||||
@ -2516,4 +2522,9 @@ MultiActionUnknownAction: In einem von einem Eingabefeld abhängigen Formular wu
|
||||
|
||||
CourseParticipantStateIsActive: Aktive Teilnehmer
|
||||
CourseParticipantStateIsInactive: Ehemalige Teilnehmer
|
||||
CourseParticipantStateIsActiveFilter: Ansicht
|
||||
CourseParticipantStateIsActiveFilter: Ansicht
|
||||
CourseUserReRegister: Wieder anmelden
|
||||
CourseParticipantActive: Teilnehmer
|
||||
CourseParticipantInactive: Abgemeldet
|
||||
CourseParticipantNoShow: Nicht erschienen
|
||||
CourseUserState: Zustand
|
||||
@ -15,6 +15,7 @@ Course -- Information about a single course; contained info is always visible
|
||||
registerFrom UTCTime Maybe -- enrolement allowed from a given day onwwards or prohibited
|
||||
registerTo UTCTime Maybe -- enrolement may be prohibited from a given date onwards
|
||||
deregisterUntil UTCTime Maybe -- unenrolement may be prohibited from a given date onwards
|
||||
deregisterNoShow Bool default=false
|
||||
registerSecret Text Maybe -- enrolement maybe protected by a simple common passphrase
|
||||
materialFree Bool -- False: only enrolled users may see course materials not stored in this table
|
||||
applicationsRequired Bool default=false
|
||||
|
||||
@ -277,6 +277,15 @@ instance RenderMessage UniWorX (Either ExamPassed ExamGrade) where
|
||||
mr :: RenderMessage UniWorX msg => msg -> Text
|
||||
mr = renderMessage foundation ls
|
||||
|
||||
instance RenderMessage UniWorX CourseParticipantState where
|
||||
renderMessage foundation ls = \case
|
||||
CourseParticipantActive -> mr MsgCourseParticipantActive
|
||||
CourseParticipantInactive False -> mr MsgCourseParticipantInactive
|
||||
CourseParticipantInactive True -> mr MsgCourseParticipantNoShow
|
||||
where
|
||||
mr :: RenderMessage UniWorX msg => msg -> Text
|
||||
mr = renderMessage foundation ls
|
||||
|
||||
-- ToMessage instances for converting raw numbers to Text (no internationalization)
|
||||
|
||||
instance ToMessage Int where
|
||||
|
||||
@ -55,10 +55,11 @@ data CourseForm = CourseForm
|
||||
data AllocationCourseForm = AllocationCourseForm
|
||||
{ acfAllocation :: AllocationId
|
||||
, acfMinCapacity :: Int
|
||||
, acfDeregisterNoShow :: Bool
|
||||
}
|
||||
|
||||
courseToForm :: Entity Course -> [Lecturer] -> Map UserEmail (InvitationDBData Lecturer) -> Maybe (Entity AllocationCourse) -> CourseForm
|
||||
courseToForm (Entity cid Course{..}) lecs lecInvites alloc = CourseForm
|
||||
courseToForm cEnt@(Entity cid Course{..}) lecs lecInvites alloc = CourseForm
|
||||
{ cfCourseId = Just cid
|
||||
, cfName = courseName
|
||||
, cfDesc = courseDescription
|
||||
@ -69,7 +70,7 @@ courseToForm (Entity cid Course{..}) lecs lecInvites alloc = CourseForm
|
||||
, cfCapacity = courseCapacity
|
||||
, cfSecret = courseRegisterSecret
|
||||
, cfMatFree = courseMaterialFree
|
||||
, cfAllocation = allocationCourseToForm <$> alloc
|
||||
, cfAllocation = allocationCourseToForm cEnt <$> alloc
|
||||
, cfAppRequired = courseApplicationsRequired
|
||||
, cfAppInstructions = courseApplicationsInstructions
|
||||
, cfAppInstructionFiles
|
||||
@ -89,10 +90,11 @@ courseToForm (Entity cid Course{..}) lecs lecInvites alloc = CourseForm
|
||||
return $ courseAppInstructionFile E.^. CourseAppInstructionFileFile
|
||||
|
||||
|
||||
allocationCourseToForm :: Entity AllocationCourse -> AllocationCourseForm
|
||||
allocationCourseToForm (Entity _ AllocationCourse{..}) = AllocationCourseForm
|
||||
allocationCourseToForm :: Entity Course -> Entity AllocationCourse -> AllocationCourseForm
|
||||
allocationCourseToForm (Entity _ Course{..}) (Entity _ AllocationCourse{..}) = AllocationCourseForm
|
||||
{ acfAllocation = allocationCourseAllocation
|
||||
, acfMinCapacity = allocationCourseMinCapacity
|
||||
, acfDeregisterNoShow = courseDeregisterNoShow
|
||||
}
|
||||
|
||||
makeCourseForm :: (forall p. PathPiece p => p -> Maybe (SomeRoute UniWorX)) -> Maybe CourseForm -> Form CourseForm
|
||||
@ -251,6 +253,7 @@ makeCourseForm miButtonAction template = identifyForm FIDcourse . validateFormDB
|
||||
in AllocationCourseForm
|
||||
<$> ainp (selectField' Nothing $ return allocationOptions) (fslI MsgCourseAllocation) (fmap acfAllocation $ template >>= cfAllocation)
|
||||
<*> ainp (natFieldI MsgCourseAllocationMinCapacityMustBeNonNegative) (fslI MsgCourseAllocationMinCapacity & setTooltip MsgCourseAllocationMinCapacityTip) (fmap acfMinCapacity $ template >>= cfAllocation)
|
||||
<*> apopt checkBoxField (fslI MsgCourseDeregisterNoShow & setTooltip MsgCourseDeregisterNoShowTip) ((<|> Just True) . fmap acfDeregisterNoShow $ template >>= cfAllocation)
|
||||
|
||||
optionalActionW' (bool mforcedJust mpopt mayChange) allocationForm' (fslI MsgCourseAllocationParticipate & setTooltip MsgCourseAllocationParticipateTip) (is _Just . cfAllocation <$> template)
|
||||
|
||||
@ -459,6 +462,7 @@ courseEditHandler miButtonAction mbCourseForm = do
|
||||
, courseRegisterFrom = cfRegFrom
|
||||
, courseRegisterTo = cfRegTo
|
||||
, courseDeregisterUntil = cfDeRegUntil
|
||||
, courseDeregisterNoShow = maybe False acfDeregisterNoShow cfAllocation
|
||||
}
|
||||
whenIsJust insertOkay $ \cid -> do
|
||||
let (invites, adds) = partitionEithers $ cfLecturers res
|
||||
@ -506,6 +510,7 @@ courseEditHandler miButtonAction mbCourseForm = do
|
||||
, courseRegisterFrom = cfRegFrom
|
||||
, courseRegisterTo = cfRegTo
|
||||
, courseDeregisterUntil = cfDeRegUntil
|
||||
, courseDeregisterNoShow = maybe False acfDeregisterNoShow cfAllocation
|
||||
}
|
||||
case updOkay of
|
||||
(Just _) -> addMessageI Warning (MsgCourseEditDupShort tid ssh csh) $> False
|
||||
|
||||
@ -142,6 +142,8 @@ courseRegisterForm (Entity cid Course{..}) = liftHandler $ do
|
||||
-> aFormToWForm $ fileUploadForm False (fslI . mkFs) courseApplicationsFiles
|
||||
|
||||
when (is _Just $ registration >>= courseParticipantAllocated . entityVal) $
|
||||
wformMessage =<< messageIconI Warning IconExamRegisterFalse MsgCourseDeregistrationNoShow
|
||||
when (is _Just (registration >>= courseParticipantAllocated . entityVal) && courseDeregisterNoShow) $
|
||||
wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationAllocationLog
|
||||
|
||||
return $ CourseRegisterForm
|
||||
@ -216,11 +218,23 @@ postCRegisterR tid ssh csh = do
|
||||
BtnCourseDeregister -> runDB $ do
|
||||
part <- fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
|
||||
forM_ part $ \(Entity _partId CourseParticipant{..}) -> do
|
||||
deregisterParticipant uid cid
|
||||
|
||||
when (is _Just courseParticipantAllocated) $ do
|
||||
updateBy (UniqueParticipant uid cid) [ CourseParticipantState =. CourseParticipantInactive courseDeregisterNoShow ]
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
insert_ $ AllocationDeregister courseParticipantUser (Just courseParticipantCourse) now Nothing
|
||||
|
||||
deregisterParticipant uid cid
|
||||
let recordNoShow eId = do
|
||||
didRecord <- is _Just <$> insertUnique ExamResult
|
||||
{ examResultExam = eId
|
||||
, examResultUser = uid
|
||||
, examResultResult = ExamNoShow
|
||||
, examResultLastChanged = now
|
||||
}
|
||||
when didRecord $
|
||||
audit $ TransactionExamResultEdit eId uid
|
||||
when courseDeregisterNoShow . runConduit $ selectKeys [ ExamCourse ==. cid ] [] .| C.mapM_ recordNoShow
|
||||
|
||||
addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk
|
||||
BtnCourseApply -> runDB $ do
|
||||
|
||||
@ -26,6 +26,8 @@ import qualified Data.Map as Map
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import qualified Data.Conduit.Combinators as C
|
||||
|
||||
|
||||
data ExamAction = ExamDeregister
|
||||
| ExamSetResult
|
||||
@ -129,7 +131,10 @@ courseUserProfileSection (Entity cid Course{..}) (Entity uid User{ userShowSex =
|
||||
if | is _Just $ courseParticipantAllocated . entityVal =<< mRegistration
|
||||
-> renderWForm FormStandard $ fmap (regButton, )
|
||||
<$ (wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationAllocationShouldLogTip)
|
||||
<*> optionalActionW (areq (textField & cfStrip & guardField (not . null)) (fslI MsgCourseDeregistrationAllocationReason & setTooltip MsgCourseDeregistrationAllocationReasonTip) Nothing) (fslI MsgCourseDeregistrationAllocationShouldLog) (Just True)
|
||||
<*> optionalActionW ((,)
|
||||
<$> areq (textField & cfStrip & guardField (not . null)) (fslI MsgCourseDeregistrationAllocationReason & setTooltip MsgCourseDeregistrationAllocationReasonTip) Nothing
|
||||
<*> apopt checkBoxField (fslI MsgCourseDeregistrationAllocationNoShow & setTooltip MsgCourseDeregistrationAllocationNoShowTip) Nothing
|
||||
) (fslI MsgCourseDeregistrationAllocationShouldLog) (Just True)
|
||||
| otherwise
|
||||
-> \csrf -> pure (FormSuccess (regButton, Nothing), toWidget csrf)
|
||||
|
||||
@ -153,9 +158,21 @@ courseUserProfileSection (Entity cid Course{..}) (Entity uid User{ userShowSex =
|
||||
lift . runDB $ do
|
||||
deregisterParticipant courseParticipantUser courseParticipantCourse
|
||||
|
||||
whenIsJust mbReason $ \reason -> do
|
||||
whenIsJust mbReason $ \(reason, noShow) -> do
|
||||
updateBy (UniqueParticipant uid cid) [ CourseParticipantState =. CourseParticipantInactive noShow ]
|
||||
|
||||
now <- liftIO getCurrentTime
|
||||
insert_ $ AllocationDeregister courseParticipantUser (Just cid) now (Just reason)
|
||||
let recordNoShow eId = do
|
||||
didRecord <- is _Just <$> insertUnique ExamResult
|
||||
{ examResultExam = eId
|
||||
, examResultUser = uid
|
||||
, examResultResult = ExamNoShow
|
||||
, examResultLastChanged = now
|
||||
}
|
||||
when didRecord $
|
||||
audit $ TransactionExamResultEdit eId uid
|
||||
when noShow . runConduit $ selectKeys [ ExamCourse ==. cid ] [] .| C.mapM_ recordNoShow
|
||||
addMessageIconI Info IconEnrolFalse MsgCourseDeregisterOk
|
||||
redirect $ CourseR courseTerm courseSchool courseShorthand CUsersR
|
||||
| otherwise
|
||||
|
||||
@ -30,6 +30,8 @@ import qualified Data.Conduit.List as C
|
||||
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
|
||||
import Database.Persist.Sql (updateWhereCount)
|
||||
|
||||
|
||||
type UserTableExpr = ( E.SqlExpr (Entity User)
|
||||
`E.InnerJoin` E.SqlExpr (Entity CourseParticipant)
|
||||
@ -283,6 +285,7 @@ data CourseUserAction = CourseUserSendMail
|
||||
| CourseUserRegisterTutorial
|
||||
| CourseUserRegisterExam
|
||||
| CourseUserSetSubmissionGroup
|
||||
| CourseUserReRegister
|
||||
deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
|
||||
|
||||
instance Universe CourseUserAction
|
||||
@ -292,7 +295,7 @@ embedRenderMessage ''UniWorX ''CourseUserAction id
|
||||
|
||||
data CourseUserActionData = CourseUserSendMailData
|
||||
| CourseUserDeregisterData
|
||||
{ deregisterReason :: Maybe Text
|
||||
{ deregisterSelfImposed :: Maybe (Text, Bool {- no-show -})
|
||||
}
|
||||
| CourseUserRegisterTutorialData
|
||||
{ registerTutorial :: TutorialId
|
||||
@ -303,6 +306,7 @@ data CourseUserActionData = CourseUserSendMailData
|
||||
| CourseUserSetSubmissionGroupData
|
||||
{ setSubmissionGroup :: Maybe SubmissionGroupName
|
||||
}
|
||||
| CourseUserReRegisterData
|
||||
deriving (Eq, Ord, Read, Show, Generic, Typeable)
|
||||
|
||||
|
||||
@ -372,6 +376,7 @@ makeCourseUserTable cid acts restrict colChoices psValidator csvColumns = do
|
||||
return . E.min_ $ exam E.^. ExamName
|
||||
)
|
||||
, single $ ("submission-group", SortColumn $ querySubmissionGroup >>> (E.?. SubmissionGroupName))
|
||||
, single $ ("state", SortColumn $ queryParticipant >>> (E.^. CourseParticipantState))
|
||||
]
|
||||
where single = uncurry Map.singleton
|
||||
dbtFilter = mconcat
|
||||
@ -513,7 +518,10 @@ courseUserDeregisterForm cid = wFormToAForm $ do
|
||||
E.&&. participant E.^. CourseParticipantState E.==. E.val CourseParticipantActive
|
||||
if | allocated -> do
|
||||
wformMessage =<< messageIconI Warning IconEnrolFalse MsgCourseDeregistrationAllocationShouldLogTip
|
||||
fmap CourseUserDeregisterData <$> optionalActionW (apreq (textField & cfStrip & guardField (not . null)) (fslI MsgCourseDeregistrationAllocationReason & setTooltip MsgCourseDeregistrationAllocationReasonTip) Nothing) (fslI MsgCourseDeregistrationAllocationShouldLog) (Just True)
|
||||
let selfImposedForm = (,)
|
||||
<$> apreq (textField & cfStrip & guardField (not . null)) (fslI MsgCourseDeregistrationAllocationReason & setTooltip MsgCourseDeregistrationAllocationReasonTip) Nothing
|
||||
<*> apopt checkBoxField (fslI MsgCourseDeregistrationAllocationNoShow & setTooltip MsgCourseDeregistrationAllocationNoShowTip) Nothing
|
||||
fmap CourseUserDeregisterData <$> optionalActionW selfImposedForm (fslI MsgCourseDeregistrationAllocationShouldLog) (Just True)
|
||||
| otherwise -> pure . pure $ CourseUserDeregisterData Nothing
|
||||
|
||||
getCUsersR, postCUsersR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
@ -547,6 +555,7 @@ postCUsersR tid ssh csh = do
|
||||
, guardOn hasTutorials $ colUserTutorials tid ssh csh
|
||||
, guardOn hasExams $ colUserExams tid ssh csh
|
||||
, pure $ sortable (Just "registration") (i18nCell MsgRegisteredSince) (maybe mempty dateCell . preview (_Just . _userTableRegistration) . assertM' (has $ _userTableParticipant . _entityVal . _courseParticipantState . _CourseParticipantActive))
|
||||
, pure $ sortable (Just "state") (i18nCell MsgCourseUserState) (i18nCell . view (_userTableParticipant . _entityVal . _courseParticipantState))
|
||||
, pure $ colUserComment tid ssh csh
|
||||
]
|
||||
psValidator = def & defaultSortingByName
|
||||
@ -578,21 +587,18 @@ postCUsersR tid ssh csh = do
|
||||
optionDisplay = CI.original $ examName entityVal
|
||||
return Option{..}
|
||||
submissionGroupOpts = optionsPersist [SubmissionGroupCourse ==. cid] [Asc SubmissionGroupName] submissionGroupName <&> fmap (submissionGroupName . entityVal)
|
||||
acts = mconcat
|
||||
[ singletonMap CourseUserSendMail $ pure CourseUserSendMailData
|
||||
, singletonMap CourseUserRegisterTutorial $ CourseUserRegisterTutorialData <$>
|
||||
apopt (selectField' Nothing . fmap (fmap entityKey) $ optionsPersistCryptoId [TutorialCourse ==. cid] [Asc TutorialName] tutorialName)
|
||||
(fslI MsgCourseTutorial)
|
||||
Nothing
|
||||
, singletonMap CourseUserRegisterExam $ CourseUserRegisterExamData <$>
|
||||
multiActionAOpts examOccActs examActs (fslI MsgCourseExam) Nothing
|
||||
, singletonMap CourseUserSetSubmissionGroup $ CourseUserSetSubmissionGroupData . assertM (not . Text.null . CI.original) <$>
|
||||
aopt (textField & cfStrip & cfCI & addDatalist submissionGroupOpts) (fslI MsgSubmissionGroup & setTooltip MsgSubmissionGroupEmptyIsUnsetTip) Nothing
|
||||
, if
|
||||
| mayRegister
|
||||
-> singletonMap CourseUserDeregister $ courseUserDeregisterForm cid
|
||||
| otherwise
|
||||
-> mempty
|
||||
acts = mconcat $ catMaybes
|
||||
[ pure . singletonMap CourseUserSendMail $ pure CourseUserSendMailData
|
||||
, pure . singletonMap CourseUserRegisterTutorial $ CourseUserRegisterTutorialData
|
||||
<$> apopt (selectField' Nothing . fmap (fmap entityKey) $ optionsPersistCryptoId [TutorialCourse ==. cid] [Asc TutorialName] tutorialName)
|
||||
(fslI MsgCourseTutorial)
|
||||
Nothing
|
||||
, pure . singletonMap CourseUserRegisterExam $ CourseUserRegisterExamData <$>
|
||||
multiActionAOpts examOccActs examActs (fslI MsgCourseExam) Nothing
|
||||
, pure . singletonMap CourseUserSetSubmissionGroup $ CourseUserSetSubmissionGroupData . assertM (not . Text.null . CI.original)
|
||||
<$> aopt (textField & cfStrip & cfCI & addDatalist submissionGroupOpts) (fslI MsgSubmissionGroup & setTooltip MsgSubmissionGroupEmptyIsUnsetTip) Nothing
|
||||
, guardOn mayRegister . singletonMap CourseUserDeregister $ courseUserDeregisterForm cid
|
||||
, guardOn mayRegister . singletonMap CourseUserReRegister $ pure CourseUserReRegisterData
|
||||
]
|
||||
numParticipants <- count [CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantActive]
|
||||
table <- makeCourseUserTable cid acts (const E.true) colChoices psValidator (Just $ const True)
|
||||
@ -606,10 +612,21 @@ postCUsersR tid ssh csh = do
|
||||
now <- liftIO getCurrentTime
|
||||
Entity _ CourseParticipant{..} <- MaybeT . fmap (assertM . has $ _entityVal . _courseParticipantState . _CourseParticipantActive) . getBy $ UniqueParticipant uid cid
|
||||
lift $ deregisterParticipant courseParticipantUser courseParticipantCourse
|
||||
case deregisterReason of
|
||||
Just reason
|
||||
| is _Just courseParticipantAllocated ->
|
||||
lift . insert_ $ AllocationDeregister uid (Just cid) now (Just reason)
|
||||
case deregisterSelfImposed of
|
||||
Just (reason, noShow)
|
||||
| is _Just courseParticipantAllocated -> lift $ do
|
||||
insert_ $ AllocationDeregister uid (Just cid) now (Just reason)
|
||||
updateBy (UniqueParticipant uid cid) [ CourseParticipantState =. CourseParticipantInactive noShow ]
|
||||
let recordNoShow eId = do
|
||||
didRecord <- is _Just <$> insertUnique ExamResult
|
||||
{ examResultExam = eId
|
||||
, examResultUser = uid
|
||||
, examResultResult = ExamNoShow
|
||||
, examResultLastChanged = now
|
||||
}
|
||||
when didRecord $
|
||||
audit $ TransactionExamResultEdit eId uid
|
||||
when noShow . runConduit $ selectKeys [ ExamCourse ==. cid ] [] .| C.mapM_ recordNoShow
|
||||
_other -> return ()
|
||||
return 1
|
||||
addMessageI Success $ MsgCourseUsersDeregistered nrDel
|
||||
@ -646,6 +663,24 @@ postCUsersR tid ssh csh = do
|
||||
Just _ -> addMessageI Success $ MsgCourseUsersSubmissionGroupSetNew nrSet
|
||||
|
||||
redirect $ CourseR tid ssh csh CUsersR
|
||||
(CourseUserReRegisterData, selectedUsers) -> do
|
||||
now <- liftIO getCurrentTime
|
||||
Sum nrSet <- runDB . flip foldMapM selectedUsers $ \uid -> maybeT (return mempty) $ do
|
||||
didUpdate <- lift $ updateWhereCount
|
||||
[ CourseParticipantUser ==. uid
|
||||
, CourseParticipantCourse ==. cid
|
||||
, CourseParticipantState !=. CourseParticipantActive
|
||||
]
|
||||
[ CourseParticipantState =. CourseParticipantActive
|
||||
, CourseParticipantRegistration =. now
|
||||
, CourseParticipantAllocated =. Nothing
|
||||
]
|
||||
guard $ didUpdate > 0
|
||||
lift $ deleteWhere [ AllocationDeregisterCourse ==. Just cid, AllocationDeregisterUser ==. uid ]
|
||||
lift . audit $ TransactionCourseParticipantEdit cid uid
|
||||
return $ Sum didUpdate
|
||||
addMessageI Success $ MsgCourseUsersStateSet nrSet
|
||||
redirect $ CourseR tid ssh csh CUsersR
|
||||
|
||||
let headingLong = [whamlet|_{MsgMenuCourseMembers} #{courseName course} #{tid}|]
|
||||
headingShort = prependCourseTitle tid ssh csh MsgCourseMembers
|
||||
|
||||
@ -12,6 +12,8 @@ import Handler.Utils
|
||||
import Handler.Utils.Invitations
|
||||
|
||||
import Jobs.Queue
|
||||
|
||||
import qualified Data.Conduit.Combinators as C
|
||||
|
||||
|
||||
getCExamNewR, postCExamNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
|
||||
@ -26,6 +28,8 @@ postCExamNewR tid ssh csh = do
|
||||
|
||||
formResult newExamResult $ \ExamForm{..} -> do
|
||||
insertRes <- runDBJobs $ do
|
||||
now <- liftIO getCurrentTime
|
||||
|
||||
insertRes <- insertUnique Exam
|
||||
{ examName = efName
|
||||
, examCourse = cid
|
||||
@ -75,6 +79,18 @@ postCExamNewR tid ssh csh = do
|
||||
, examCorrectorUser <- adds
|
||||
]
|
||||
sinkInvitationsF examCorrectorInvitationConfig $ map (, examid, (InvDBDataExamCorrector, InvTokenDataExamCorrector)) invites
|
||||
|
||||
let recordNoShow (Entity _ CourseParticipant{..}) = do
|
||||
didRecord <- is _Just <$> insertUnique ExamResult
|
||||
{ examResultExam = examid
|
||||
, examResultUser = courseParticipantUser
|
||||
, examResultResult = ExamNoShow
|
||||
, examResultLastChanged = now
|
||||
}
|
||||
when didRecord $
|
||||
audit $ TransactionExamResultEdit examid courseParticipantUser
|
||||
runConduit $ selectSource [ CourseParticipantCourse ==. cid, CourseParticipantState ==. CourseParticipantInactive True ] [] .| C.mapM_ recordNoShow
|
||||
|
||||
return insertRes
|
||||
case insertRes of
|
||||
Nothing -> addMessageI Error $ MsgExamNameTaken efName
|
||||
|
||||
@ -552,11 +552,12 @@ fillDb = do
|
||||
, courseApplicationsText = False
|
||||
, courseApplicationsFiles = NoUpload
|
||||
, courseApplicationsRatingsVisible = False
|
||||
, courseDeregisterNoShow = True
|
||||
}
|
||||
insert_ $ CourseEdit jost now ffp
|
||||
void . insert $ DegreeCourse ffp sdBsc sdInf
|
||||
void . insert $ DegreeCourse ffp sdMst sdInf
|
||||
void . insert $ Lecturer jost ffp CourseLecturer
|
||||
-- void . insert $ Lecturer jost ffp CourseLecturer
|
||||
void . insert $ Lecturer gkleen ffp CourseAssistant
|
||||
adhoc <- insert Sheet
|
||||
{ sheetCourse = ffp
|
||||
@ -614,9 +615,6 @@ fillDb = do
|
||||
,(maxMuster , Just sfMMs)
|
||||
,(tinaTester, Just sfTTc)
|
||||
]
|
||||
void . insertMany $ map (\(u,sf) -> CourseParticipant ffp u now sf Nothing $ CourseParticipantInactive False)
|
||||
[(svaupel, Nothing)
|
||||
]
|
||||
|
||||
examFFP <- insert' $ Exam
|
||||
{ examCourse = ffp
|
||||
@ -663,6 +661,7 @@ fillDb = do
|
||||
, courseApplicationsText = False
|
||||
, courseApplicationsFiles = NoUpload
|
||||
, courseApplicationsRatingsVisible = False
|
||||
, courseDeregisterNoShow = False
|
||||
}
|
||||
insert_ $ CourseEdit fhamann now eip
|
||||
void . insert' $ DegreeCourse eip sdBsc sdInf
|
||||
@ -686,6 +685,7 @@ fillDb = do
|
||||
, courseApplicationsText = False
|
||||
, courseApplicationsFiles = NoUpload
|
||||
, courseApplicationsRatingsVisible = False
|
||||
, courseDeregisterNoShow = False
|
||||
}
|
||||
insert_ $ CourseEdit fhamann now ixd
|
||||
void . insert' $ DegreeCourse ixd sdBsc sdInf
|
||||
@ -709,6 +709,7 @@ fillDb = do
|
||||
, courseApplicationsText = False
|
||||
, courseApplicationsFiles = NoUpload
|
||||
, courseApplicationsRatingsVisible = False
|
||||
, courseDeregisterNoShow = False
|
||||
}
|
||||
insert_ $ CourseEdit fhamann now ux3
|
||||
void . insert' $ DegreeCourse ux3 sdBsc sdInf
|
||||
@ -732,6 +733,7 @@ fillDb = do
|
||||
, courseApplicationsText = False
|
||||
, courseApplicationsFiles = NoUpload
|
||||
, courseApplicationsRatingsVisible = False
|
||||
, courseDeregisterNoShow = False
|
||||
}
|
||||
insert_ $ CourseEdit jost now pmo
|
||||
void . insert $ DegreeCourse pmo sdBsc sdInf
|
||||
@ -899,6 +901,7 @@ fillDb = do
|
||||
, courseApplicationsText = False
|
||||
, courseApplicationsFiles = NoUpload
|
||||
, courseApplicationsRatingsVisible = False
|
||||
, courseDeregisterNoShow = False
|
||||
}
|
||||
insert_ $ CourseEdit gkleen now dbs
|
||||
void . insert' $ DegreeCourse dbs sdBsc sdInf
|
||||
@ -997,6 +1000,11 @@ fillDb = do
|
||||
insert_ $ AllocationCourse funAlloc pmo 100
|
||||
insert_ $ AllocationCourse funAlloc ffp 2
|
||||
|
||||
void . insertMany $ map (\(u, pState) -> CourseParticipant ffp u now Nothing (Just funAlloc) pState)
|
||||
[ (svaupel, CourseParticipantInactive False)
|
||||
, (jost, CourseParticipantActive)
|
||||
]
|
||||
|
||||
void $ insertFile "H10-2.hs" -- unreferenced
|
||||
|
||||
-- -- betriebssysteme
|
||||
@ -1018,6 +1026,7 @@ fillDb = do
|
||||
, courseApplicationsText = False
|
||||
, courseApplicationsFiles = NoUpload
|
||||
, courseApplicationsRatingsVisible = False
|
||||
, courseDeregisterNoShow = False
|
||||
}
|
||||
insert_ $ CourseEdit gkleen now bs
|
||||
void . insert' $ Lecturer gkleen bs CourseLecturer
|
||||
@ -1086,6 +1095,7 @@ fillDb = do
|
||||
, courseApplicationsText = False
|
||||
, courseApplicationsFiles = NoUpload
|
||||
, courseApplicationsRatingsVisible = False
|
||||
, courseDeregisterNoShow = False
|
||||
}
|
||||
insert_ $ CourseEdit gkleen now cid
|
||||
-- void . insert' $ Lecturer gkleen cid CourseLecturer
|
||||
@ -1140,6 +1150,7 @@ fillDb = do
|
||||
, courseApplicationsText = False
|
||||
, courseApplicationsFiles = NoUpload
|
||||
, courseApplicationsRatingsVisible = False
|
||||
, courseDeregisterNoShow = False
|
||||
}
|
||||
insert_ $ CourseEdit gkleen now cid
|
||||
insert_ $ AllocationCourse bigAlloc cid minCap
|
||||
|
||||
Loading…
Reference in New Issue
Block a user