56 lines
2.0 KiB
Haskell
56 lines
2.0 KiB
Haskell
-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>
|
|
--
|
|
-- SPDX-License-Identifier: AGPL-3.0-or-later
|
|
|
|
module Handler.Course.Events.Form
|
|
( CourseEventForm(..)
|
|
, courseEventForm
|
|
, courseEventToForm
|
|
) where
|
|
|
|
import Import
|
|
import Handler.Utils
|
|
import Handler.Utils.Form.Occurrences
|
|
|
|
import qualified Database.Esqueleto.Legacy as E
|
|
|
|
|
|
data CourseEventForm = CourseEventForm
|
|
{ cefType :: CI Text
|
|
, 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)
|
|
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'
|
|
<*> cefRoomHidden'
|
|
<*> cefTime'
|
|
<*> cefNote'
|
|
|
|
courseEventToForm :: CourseEvent -> CourseEventForm
|
|
courseEventToForm CourseEvent{..} = CourseEventForm
|
|
{ cefType = courseEventType
|
|
, cefRoomHidden = courseEventRoomHidden
|
|
, cefTime = courseEventTime & unJSONB
|
|
, cefNote = courseEventNote
|
|
}
|