module Handler.Exam.Register
  ( ButtonExamRegister(..)
  , postERegisterR
  , postERegisterOccR
  ) where

import Import

import Handler.Utils
import Handler.Utils.Exam

import Database.Persist.Sql (deleteWhereCount)


-- Dedicated ExamRegistrationButton
data ButtonExamRegister = BtnExamRegisterOccurrence
                        | BtnExamSwitchOccurrence
                        | BtnExamRegister
                        | BtnExamDeregister
  deriving (Enum, Bounded, Eq, Ord, Read, Show, Generic, Typeable)
instance Universe ButtonExamRegister
instance Finite ButtonExamRegister
nullaryPathPiece ''ButtonExamRegister $ camelToPathPiece' 2

instance Button UniWorX ButtonExamRegister where
  btnClasses BtnExamRegisterOccurrence = [BCIsButton, BCPrimary]
  btnClasses BtnExamSwitchOccurrence   = [BCIsButton, BCPrimary]
  btnClasses BtnExamRegister           = [BCIsButton, BCPrimary]
  btnClasses BtnExamDeregister         = [BCIsButton, BCDanger]

  btnLabel BtnExamRegisterOccurrence = [whamlet|#{iconExamRegister True } _{MsgBtnExamRegisterOccurrence}|]
  btnLabel BtnExamSwitchOccurrence   = [whamlet|_{MsgBtnExamSwitchOccurrence}|]
  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
  uid <- requireAuthId

  Entity eId Exam{} <- runDB $ fetchExam tid ssh csh examn

  ((btnResult, _), _) <- runFormPost $ buttonForm' [BtnExamRegister, BtnExamDeregister]

  formResult btnResult $ \case
    BtnExamDeregister -> do
      runDB $ do
        deleted <- deleteWhereCount [ExamRegistrationExam ==. eId, ExamRegistrationUser ==. uid]
        unless (deleted <= 0) $
          audit $ TransactionExamDeregister eId uid
      addMessageIconI Success IconExamRegisterFalse $ MsgExamDeregisteredSuccess examn
      redirect $ CExamR tid ssh csh examn EShowR
    BtnExamRegister -> do
      runDB $ do
        now <- liftIO getCurrentTime
        void $ upsertBy (UniqueExamRegistration eId uid) (ExamRegistration eId uid Nothing now) [ExamRegistrationTime =. now]
        audit $ TransactionExamRegister eId uid
        addMessageIconI Success IconExamRegisterTrue $ MsgExamRegisteredSuccess examn
      redirect $ CExamR tid ssh csh examn EShowR
    _other -> error "Unexpected due to definition of buttonForm'"

  redirect $ CExamR tid ssh csh examn EShowR

postERegisterOccR :: TermId -> SchoolId -> CourseShorthand -> ExamName -> ExamOccurrenceName -> Handler Html
postERegisterOccR tid ssh csh examn occn = do
  uid <- requireAuthId
  (eId, occId) <- runDB $ do
    Entity eId _ <- fetchExam tid ssh csh examn
    occ <- getKeyBy404 $ UniqueExamOccurrence eId occn
    return (eId, occ)

  ((btnResult, _), _) <- runFormPost buttonForm

  formResult btnResult $ \case
    BtnExamDeregister -> do
      runDB $ do
        deleted <- deleteWhereCount [ExamRegistrationExam ==. eId, ExamRegistrationUser ==. uid]
        unless (deleted <= 0) $
          audit $ TransactionExamDeregister eId uid
      addMessageIconI Success IconExamRegisterFalse $ MsgExamDeregisteredSuccess examn
      redirect $ CExamR tid ssh csh examn EShowR
    btn | btn `elem` [BtnExamRegisterOccurrence, BtnExamSwitchOccurrence] -> do
      runDB $ do
        now <- liftIO getCurrentTime
        void $ upsertBy (UniqueExamRegistration eId uid) (ExamRegistration eId uid (Just occId) now) [ExamRegistrationOccurrence =. Just occId, ExamRegistrationTime =. now]
        audit $ TransactionExamRegister eId uid
        addMessageIconI Success IconExamRegisterTrue $ MsgExamRegisteredSuccess examn
      redirect $ CExamR tid ssh csh examn EShowR
    _other -> error "Unexpected due to definition of buttonForm'"

  redirect $ CExamR tid ssh csh examn EShowR

