76 lines
2.7 KiB
Haskell
76 lines
2.7 KiB
Haskell
module Handler.ExamOffice.Course
|
|
( getCExamOfficeR, postCExamOfficeR
|
|
) where
|
|
|
|
import Import
|
|
|
|
import qualified Data.Set as Set
|
|
|
|
import qualified Database.Esqueleto 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 MsgMenuCourseExamOffice $ do
|
|
setTitleI MsgMenuCourseExamOffice
|
|
|
|
let explanation = $(i18nWidgetFile "course-exam-office-explanation")
|
|
|
|
[whamlet|
|
|
$newline never
|
|
<section>
|
|
^{explanation}
|
|
<section>
|
|
^{optOutView'}
|
|
|]
|