53 lines
1.9 KiB
Haskell
53 lines
1.9 KiB
Haskell
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"]
|