module Handler.Exam.Register ( ButtonExamRegister(..) , postERegisterR ) where import Import import Handler.Utils import Handler.Utils.Exam -- Dedicated ExamRegistrationButton data ButtonExamRegister = BtnExamRegister | BtnExamDeregister deriving (Enum, Eq, Ord, Bounded, Read, Show, Generic, Typeable) instance Universe ButtonExamRegister instance Finite ButtonExamRegister nullaryPathPiece ''ButtonExamRegister $ camelToPathPiece' 1 embedRenderMessage ''UniWorX ''ButtonExamRegister id instance Button UniWorX ButtonExamRegister where btnClasses BtnExamRegister = [BCIsButton, BCPrimary] btnClasses BtnExamDeregister = [BCIsButton, BCDanger] btnLabel BtnExamRegister = [whamlet|#{iconExamRegister True} _{MsgBtnExamRegister}|] btnLabel BtnExamDeregister = [whamlet|#{iconExamRegister False} _{MsgBtnExamDeregister}|] postERegisterR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> Handler Html postERegisterR tid ssh csh examn = do Entity uid User{..} <- requireAuth Entity eId Exam{..} <- runDB $ fetchExam tid ssh csh examn ((btnResult, _), _) <- runFormPost buttonForm formResult btnResult $ \case BtnExamRegister -> do runDB $ do now <- liftIO getCurrentTime insert_ $ ExamRegistration eId uid Nothing now audit $ TransactionExamRegister eId uid addMessageIconI Success IconExamRegisterTrue $ MsgExamRegisteredSuccess examn redirect $ CExamR tid ssh csh examn EShowR BtnExamDeregister -> do runDB $ do deleteBy $ UniqueExamRegistration eId uid audit $ TransactionExamDeregister eId uid addMessageIconI Info IconExamRegisterFalse $ MsgExamDeregisteredSuccess examn -- yes, it's a success message, but it should be visually different from a positive success, since most will just note the positive green color! See discussion on commit 5f4925a4 redirect $ CExamR tid ssh csh examn EShowR invalidArgs ["Register/Deregister button required"]