56 lines
2.0 KiB
Haskell
56 lines
2.0 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 :: Maybe RoomReference
|
|
, cefRoomHidden :: Bool
|
|
, cefTime :: Occurrences
|
|
, cefNote :: Maybe StoredMarkup
|
|
}
|
|
|
|
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 ]
|
|
|
|
cefType' <- wreq (textField & cfStrip & cfCI & addDatalist courseEventTypes) (fslI MsgCourseEventType & addPlaceholder (mr MsgCourseEventTypePlaceholder)) (cefType <$> template)
|
|
cefRoom' <- aFormToWForm $ roomReferenceFormOpt (fslI MsgCourseEventRoom) (cefRoom <$> template)
|
|
cefRoomHidden' <- wpopt checkBoxField (fslI MsgCourseEventRoomHidden & setTooltip MsgCourseEventRoomHiddenTip) (cefRoomHidden <$> template)
|
|
cefTime' <- aFormToWForm $ occurrencesAForm ("time" :: Text) (cefTime <$> template)
|
|
cefNote' <- wopt htmlField (fslI MsgCourseEventNote) (cefNote <$> template)
|
|
|
|
return $ CourseEventForm
|
|
<$> cefType'
|
|
<*> cefRoom'
|
|
<*> cefRoomHidden'
|
|
<*> cefTime'
|
|
<*> cefNote'
|
|
|
|
courseEventToForm :: CourseEvent -> CourseEventForm
|
|
courseEventToForm CourseEvent{..} = CourseEventForm
|
|
{ cefType = courseEventType
|
|
, cefRoom = courseEventRoom
|
|
, cefRoomHidden = courseEventRoomHidden
|
|
, cefTime = courseEventTime
|
|
, cefNote = courseEventNote
|
|
}
|