49 lines
1.8 KiB
Haskell
49 lines
1.8 KiB
Haskell
module Handler.Course.Events.Form
|
|
( CourseEventForm(..)
|
|
, courseEventForm
|
|
, courseEventToForm
|
|
) where
|
|
|
|
import Import
|
|
import Handler.Utils
|
|
import Handler.Utils.Form.Occurrences
|
|
|
|
import qualified Database.Esqueleto as E
|
|
|
|
|
|
data CourseEventForm = CourseEventForm
|
|
{ cefType :: CI Text
|
|
, cefRoom :: Text
|
|
, cefTime :: Occurrences
|
|
}
|
|
|
|
courseEventForm :: Maybe CourseEventForm -> Form CourseEventForm
|
|
courseEventForm template = identifyForm FIDCourseEvent . renderWForm FormStandard $ do
|
|
MsgRenderer mr <- getMsgRenderer
|
|
|
|
muid <- maybeAuthId
|
|
existingEvents <- liftHandler . runDB $ fromMaybe [] <$> for muid
|
|
(\uid -> E.select . E.from $ \(lecturer `E.InnerJoin` event) -> do
|
|
E.on $ lecturer E.^. LecturerCourse E.==. event E.^. CourseEventCourse
|
|
E.&&. lecturer E.^. LecturerUser E.==. E.val uid
|
|
return event
|
|
)
|
|
let courseEventTypes = optionsPairs [ (courseEventType, courseEventType) | Entity _ CourseEvent{..} <- existingEvents ]
|
|
courseEventRooms = optionsPairs [ (courseEventRoom, courseEventRoom) | Entity _ CourseEvent{..} <- existingEvents ]
|
|
|
|
cefType' <- wreq (textField & cfStrip & cfCI & addDatalist courseEventTypes) (fslI MsgCourseEventType & addPlaceholder (mr MsgCourseEventTypePlaceholder)) (cefType <$> template)
|
|
cefRoom' <- wreq (textField & cfStrip & addDatalist courseEventRooms) (fslI MsgCourseEventRoom) (cefRoom <$> template)
|
|
cefTime' <- aFormToWForm $ occurrencesAForm ("time" :: Text) (cefTime <$> template)
|
|
|
|
return $ CourseEventForm
|
|
<$> cefType'
|
|
<*> cefRoom'
|
|
<*> cefTime'
|
|
|
|
courseEventToForm :: CourseEvent -> CourseEventForm
|
|
courseEventToForm CourseEvent{..} = CourseEventForm
|
|
{ cefType = courseEventType
|
|
, cefRoom = courseEventRoom
|
|
, cefTime = courseEventTime
|
|
}
|