-- SPDX-FileCopyrightText: 2022 Gregor Kleen ,Winnie Ros -- -- SPDX-License-Identifier: AGPL-3.0-or-later module Handler.ExamOffice.Course ( getCExamOfficeR, postCExamOfficeR ) where import Import import qualified Data.Set as Set import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E import Handler.Utils.ExamOffice.Course import Handler.Utils examOfficeOptOutForm :: UserId -> CourseId -> Maybe (Set SchoolId) -> Form (Set SchoolId) -- ^ Deals with sets of _opt outs_ examOfficeOptOutForm uid cid (fromMaybe Set.empty -> template) = renderWForm FormStandard $ do schools <- liftHandler . runDB . E.select $ courseExamOfficeSchools (E.val uid) (E.val cid) res <- fmap sequence . forM schools $ \(Entity ssh School{..}, E.Value isForced) -> fmap (ssh, ) <$> bool wpopt wforcedJust isForced checkBoxField (fslI schoolName) (Just $ ssh `Set.notMember` template) return $ res <&> setOf (folded . filtered (not . view _2) . _1) getCExamOfficeR, postCExamOfficeR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCExamOfficeR = postCExamOfficeR postCExamOfficeR tid ssh csh = do uid <- requireAuthId isModal <- hasCustomHeader HeaderIsModal (cid, optOuts, hasForced) <- runDB $ do cid <- getKeyBy404 (TermSchoolCourseShort tid ssh csh) optOuts <- selectList [ CourseUserExamOfficeOptOutCourse ==. cid, CourseUserExamOfficeOptOutUser ==. uid ] [] hasForced <- E.selectExists $ do (_school, isForced) <- courseExamOfficeSchools (E.val uid) (E.val cid) E.where_ isForced return (cid, optOuts, hasForced) ((optOutRes, optOutView), optOutEnc) <- runFormPost $ examOfficeOptOutForm uid cid (Just $ setOf (folded . _entityVal . _courseUserExamOfficeOptOutSchool) optOuts ) formResultModal optOutRes (CourseR tid ssh csh CExamOfficeR) $ \optOuts' -> do lift . runDB $ do deleteWhere [ CourseUserExamOfficeOptOutCourse ==. cid , CourseUserExamOfficeOptOutUser ==. uid , CourseUserExamOfficeOptOutSchool /<-. Set.toList optOuts' ] forM_ optOuts' $ \ssh' -> void $ insertUnique CourseUserExamOfficeOptOut { courseUserExamOfficeOptOutCourse = cid , courseUserExamOfficeOptOutUser = uid , courseUserExamOfficeOptOutSchool = ssh' } tell . pure =<< messageI Success MsgExamOfficeOptOutsChanged let optOutView' = wrapForm optOutView def { formAction = Just . SomeRoute $ CourseR tid ssh csh CExamOfficeR , formEncoding = optOutEnc , formAttrs = [ asyncSubmitAttr | isModal ] } siteLayoutMsg MsgHeadingCourseExamOffice $ do setTitleI MsgHeadingCourseExamOffice let explanation = $(i18nWidgetFile "course-exam-office-explanation") [whamlet| $newline never
^{explanation}
^{optOutView'} |]