fix(exam add users): correctly differentiate and fix messages

This commit is contained in:
Gregor Kleen 2019-07-30 16:18:01 +02:00
parent e5163a6e5a
commit a47359997c
3 changed files with 16 additions and 15 deletions

View File

@ -27,7 +27,8 @@ data AddRecipientsResult = AddRecipientsResult
{ aurAlreadyRegistered
, aurNoUniquePrimaryField
, aurNoCourseRegistration
, aurSuccess :: [UserEmail]
, aurSuccess
, aurSuccessCourse :: [UserEmail]
} deriving (Read, Show, Generic, Typeable)
instance Monoid AddRecipientsResult where
@ -87,7 +88,7 @@ postEAddUserR tid ssh csh examn = do
processUsers :: Entity Exam -> (UTCTime, Bool, Maybe ExamOccurrenceId, Set (Either UserEmail UserId)) -> WriterT [Message] Handler ()
processUsers (Entity eid Exam{..}) (deadline, registerCourse, occId, users) = do
let (emails,uids) = partitionEithers $ Set.toList users
AddRecipientsResult alreadyRegistered registeredNoField noCourseRegistration registeredOneField <- lift . runDBJobs $ do
AddRecipientsResult{..} <- lift . runDBJobs $ do
-- send Invitation eMails to unkown users
sinkInvitationsF examRegistrationInvitationConfig [(mail,eid,(InvDBDataExamRegistration occId deadline registerCourse, InvTokenDataExamRegistration)) | mail <- emails]
-- register known users
@ -96,21 +97,21 @@ postEAddUserR tid ssh csh examn = do
unless (null emails) $
tell . pure <=< messageI Success . MsgExamParticipantsInvited $ length emails
unless (null alreadyRegistered) $
tell . pure <=< messageI Success . MsgExamRegistrationParticipantsRegistered $ length registeredOneField
unless (null aurSuccess) $
tell . pure <=< messageI Success . MsgExamRegistrationParticipantsRegistered $ length aurSuccess
unless (null registeredNoField) $ do
let modalTrigger = [whamlet|_{MsgExamRegistrationRegisteredWithoutField (length registeredNoField)}|]
unless (null aurNoUniquePrimaryField) $ do
let modalTrigger = [whamlet|_{MsgExamRegistrationRegisteredWithoutField (length aurNoUniquePrimaryField)}|]
modalContent = $(widgetFile "messages/examRegistrationInvitationRegisteredWithoutField")
tell . pure <=< messageWidget Warning $ msgModal modalTrigger (Right modalContent)
unless (null noCourseRegistration) $ do
let modalTrigger = [whamlet|_{MsgExamRegistrationNotRegisteredWithoutCourse (length noCourseRegistration)}|]
unless (null aurNoCourseRegistration) $ do
let modalTrigger = [whamlet|_{MsgExamRegistrationNotRegisteredWithoutCourse (length aurNoCourseRegistration)}|]
modalContent = $(widgetFile "messages/examRegistrationInvitationNotRegisteredWithoutCourse")
tell . pure <=< messageWidget Error $ msgModal modalTrigger (Right modalContent)
unless (null registeredOneField) $
tell . pure <=< messageI Success . MsgExamRegistrationAndCourseParticipantsRegistered $ length registeredOneField
unless (null aurSuccessCourse) $
tell . pure <=< messageI Success . MsgExamRegistrationAndCourseParticipantsRegistered $ length aurSuccessCourse
registerUser :: CourseId -> ExamId -> Bool -> Maybe ExamOccurrenceId -> UserId -> WriterT AddRecipientsResult (YesodJobDB UniWorX) ()
registerUser cid eid registerCourse occId uid = exceptT tell tell $ do
@ -149,6 +150,6 @@ postEAddUserR tid ssh csh examn = do
return $ case courseParticipantField of
Nothing -> mempty { aurNoUniquePrimaryField = pure userEmail }
Just _ -> mempty { aurSuccess = pure userEmail }
Just _ -> mempty { aurSuccessCourse = pure userEmail }

View File

@ -1,5 +1,5 @@
<h2>
_{MsgExamRegistrationNotRegisteredWithoutCourse (length registeredNoField)}
_{MsgExamRegistrationNotRegisteredWithoutCourse (length aurNoCourseRegistration)}
<ul>
$forall email <- noCourseRegistration
$forall email <- aurNoCourseRegistration
<li style="font-family: monospace">#{email}

View File

@ -1,5 +1,5 @@
<h2>
_{MsgExamRegistrationRegisteredWithoutField (length registeredNoField)}
_{MsgExamRegistrationRegisteredWithoutField (length aurNoUniquePrimaryField)}
<ul>
$forall email <- registeredNoField
$forall email <- aurNoUniquePrimaryField
<li style="font-family: monospace">#{email}