81 lines
3.2 KiB
Haskell
81 lines
3.2 KiB
Haskell
module Handler.Allocation.Edit
|
|
( getAEditR, postAEditR
|
|
) where
|
|
|
|
import Import
|
|
import Handler.Utils
|
|
|
|
import Handler.Allocation.Form
|
|
|
|
import qualified Data.Set as Set
|
|
|
|
|
|
getAEditR, postAEditR :: TermId -> SchoolId -> AllocationShorthand -> Handler Html
|
|
getAEditR = postAEditR
|
|
postAEditR tid ssh ash = do
|
|
(Allocation{..}, (mAct, (formView, formEnc))) <- runDB $ do
|
|
Entity aId alloc@Allocation{..} <- getBy404 $ TermSchoolAllocationShort tid ssh ash
|
|
|
|
let template = AllocationForm
|
|
{ afTerm = allocationTerm
|
|
, afSchool = allocationSchool
|
|
, afShorthand = allocationShorthand
|
|
, afName = allocationName
|
|
, afLegacyShorthands = Set.fromList allocationLegacyShorthands
|
|
, afDescription = allocationDescription
|
|
, afStaffDescription = allocationStaffDescription
|
|
, afStaffRegisterFrom = allocationStaffRegisterFrom
|
|
, afStaffRegisterTo = allocationStaffRegisterTo
|
|
, afRegisterFrom = allocationRegisterFrom
|
|
, afRegisterTo = allocationRegisterTo
|
|
, afStaffAllocationFrom = allocationStaffAllocationFrom
|
|
, afStaffAllocationTo = allocationStaffAllocationTo
|
|
, afRegisterByStaffFrom = allocationRegisterByStaffFrom
|
|
, afRegisterByStaffTo = allocationRegisterByStaffTo
|
|
, afRegisterByCourse = allocationRegisterByCourse
|
|
, afOverrideDeregister = allocationOverrideDeregister
|
|
}
|
|
|
|
((formRes, formView), formEnc) <- runFormPost . renderAForm FormStandard . allocationForm $ Just template
|
|
|
|
mAct <- formResultMaybe formRes $ \AllocationForm{..} -> runMaybeT $ do
|
|
didUpdate <- fmap (is _Nothing) . lift $ replaceUnique aId alloc
|
|
{ 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
|
|
}
|
|
|
|
unless didUpdate $ do
|
|
addMessageI Error MsgAllocationEditAlreadyExists
|
|
mzero
|
|
|
|
return $ do
|
|
addMessageI Success MsgAllocationEditSuccess
|
|
redirect $ AllocationR afTerm afSchool afShorthand AShowR
|
|
|
|
return (alloc, (mAct, (formView, formEnc)))
|
|
|
|
sequence_ mAct
|
|
|
|
siteLayoutMsg (MsgHeadingAllocationEdit allocationTerm allocationSchool allocationName) $ do
|
|
setTitleI $ MsgTitleAllocationEdit allocationTerm allocationSchool allocationShorthand
|
|
|
|
wrapForm formView def
|
|
{ formAction = Just . SomeRoute $ AllocationR tid ssh ash AEditR
|
|
, formEncoding = formEnc
|
|
}
|