This repository has been archived on 2024-10-24. You can view files and clone it, but cannot push or open issues or pull requests.
fradrive-old/src/Handler/Course/Events/New.hs
2020-11-19 14:25:38 +01:00

41 lines
1.3 KiB
Haskell

module Handler.Course.Events.New
( getCEventsNewR, postCEventsNewR
) where
import Import
import Handler.Utils
import Handler.Course.Events.Form
getCEventsNewR, postCEventsNewR :: TermId -> SchoolId -> CourseShorthand -> Handler Html
getCEventsNewR = postCEventsNewR
postCEventsNewR tid ssh csh = do
cid <- runDB . getKeyBy404 $ TermSchoolCourseShort tid ssh csh
((eventRes, eventWgt'), eventEnctype) <- runFormPost $ courseEventForm Nothing
formResult eventRes $ \CourseEventForm{..} -> do
now <- liftIO getCurrentTime
cID <- runDB $ do
eId <- insert CourseEvent
{ courseEventCourse = cid
, courseEventType = cefType
, courseEventRoom = cefRoom
, courseEventRoomHidden = cefRoomHidden
, courseEventTime = cefTime
, courseEventNote = cefNote
, courseEventLastChanged = now
}
encrypt eId :: DB CryptoUUIDCourseEvent
addMessageI Success MsgCourseEventCreated
redirect $ CourseR tid ssh csh CShowR :#: [st|event-#{toPathPiece cID}|]
siteLayoutMsg MsgMenuCourseEventNew $ do
setTitleI MsgMenuCourseEventNew
wrapForm eventWgt' def
{ formAction = Just . SomeRoute $ CourseR tid ssh csh CEventsNewR
, formEncoding = eventEnctype
}