module Handler.Allocation.New
  ( getAllocationNewR, postAllocationNewR
  ) where

import Import
import Handler.Utils

import Handler.Allocation.Form

import qualified Crypto.Random as Crypto

import qualified Data.Set as Set


getAllocationNewR, postAllocationNewR :: Handler Html
getAllocationNewR = postAllocationNewR
postAllocationNewR = do
  (mAct, (formView, formEnc)) <- runDB $ do
    ((formRes, formView), formEnc) <- runFormPost . renderAForm FormStandard $ allocationForm Nothing

    mAct <- formResultMaybe formRes $ \AllocationForm{..} -> runMaybeT $ do
      allocationMatchingSeed <- liftIO $ Crypto.getRandomBytes 32
      
      insertRes <- lift $ insertUnique Allocation
        { allocationTerm = afTerm
        , allocationSchool = afSchool
        , allocationShorthand = afShorthand
        , allocationName = afName
        , allocationLegacyShorthands = Set.toList afLegacyShorthands
        , allocationDescription = afDescription
        , allocationStaffDescription = afStaffDescription
        , allocationStaffRegisterFrom = afStaffRegisterFrom
        , allocationStaffRegisterTo = afStaffRegisterTo
        , allocationStaffAllocationFrom = afStaffAllocationFrom
        , allocationStaffAllocationTo = afStaffAllocationTo
        , allocationRegisterFrom = afRegisterFrom
        , allocationRegisterTo = afRegisterTo
        , allocationRegisterByStaffFrom = afRegisterByStaffFrom
        , allocationRegisterByStaffTo = afRegisterByStaffTo
        , allocationRegisterByCourse = afRegisterByCourse
        , allocationOverrideDeregister = afOverrideDeregister
        , allocationMatchingSeed
        }

      unless (is _Just insertRes) $ do
        addMessageI Error MsgAllocationNewAlreadyExists
        mzero
      
      return $ do
        addMessageI Success MsgAllocationNewSuccess
        redirect $ AllocationR afTerm afSchool afShorthand AShowR

    return (mAct, (formView, formEnc))

  sequence_ mAct

  siteLayoutMsg MsgTitleAllocationNew $ do
    setTitleI MsgTitleAllocationNew

    wrapForm formView def
      { formAction = Just $ SomeRoute AllocationNewR
      , formEncoding = formEnc
      }
