module Handler.Allocation.Register
  ( AllocationRegisterForm(..)
  , AllocationRegisterButton(..)
  , allocationRegisterForm
  , allocationUserToForm
  , postARegisterR
  ) where

import Import

import Handler.Utils.Form

{-# ANN module ("HLint: ignore Use newtype instead of data"::String) #-}


data AllocationRegisterForm = AllocationRegisterForm
  { arfTotalCourses :: Natural
  }

allocationRegisterForm :: Maybe AllocationRegisterForm -> AForm Handler AllocationRegisterForm
allocationRegisterForm template
  = AllocationRegisterForm
    <$> areq (posIntFieldI MsgAllocationTotalCoursesNegative) (fslI MsgAllocationTotalCourses & setTooltip MsgAllocationTotalCoursesTip) (arfTotalCourses <$> template <|> Just 1)

allocationUserToForm :: AllocationUser -> AllocationRegisterForm
allocationUserToForm AllocationUser{..} = AllocationRegisterForm
  { arfTotalCourses = allocationUserTotalCourses
  }

data AllocationRegisterButton = BtnAllocationRegister | BtnAllocationRegistrationEdit
  deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic, Typeable)
instance Universe AllocationRegisterButton
instance Finite AllocationRegisterButton

nullaryPathPiece ''AllocationRegisterButton $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''AllocationRegisterButton id

instance Button UniWorX AllocationRegisterButton where
  btnClasses _ = [BCIsButton, BCPrimary]

postARegisterR :: TermId -> SchoolId -> AllocationShorthand -> Handler Void
postARegisterR tid ssh ash = do
  uid <- requireAuthId

  ((registerRes, _), _) <- runFormPost . renderAForm FormStandard $ allocationRegisterForm Nothing
  formResult registerRes $ \AllocationRegisterForm{..} -> runDB $ do
    aId <- getKeyBy404 $ TermSchoolAllocationShort tid ssh ash
    isRegistered <- existsBy $ UniqueAllocationUser aId uid
    void $ upsert AllocationUser 
      { allocationUserAllocation = aId
      , allocationUserUser = uid
      , allocationUserTotalCourses = arfTotalCourses
      , allocationUserPriority = Nothing
      }
      [ AllocationUserTotalCourses =. arfTotalCourses
      ]
    if
      | isRegistered -> addMessageI Success MsgAllocationRegistrationEdited
      | otherwise -> addMessageI Success MsgAllocationRegistered
  
  redirect $ AllocationR tid ssh ash AShowR :#: ("allocation-participation" :: Text)