module Handler.Exam.List ( getCExamListR ) where import Import import Handler.Utils import qualified Data.Map as Map import qualified Database.Esqueleto as E getCExamListR :: TermId -> SchoolId -> CourseShorthand -> Handler Html getCExamListR tid ssh csh = do Entity cid Course{..} <- runDB . getBy404 $ TermSchoolCourseShort tid ssh csh now <- liftIO getCurrentTime mayCreate <- hasWriteAccessTo $ CourseR tid ssh csh CExamNewR let examDBTable = DBTable{..} where dbtSQLQuery exam = do E.where_ $ exam E.^. ExamCourse E.==. E.val cid return exam dbtRowKey = (E.^. ExamId) dbtProj x@DBRow{ dbrOutput = Entity _ Exam{..} } = do guardM . hasReadAccessTo $ CExamR tid ssh csh examName EShowR return x dbtColonnade = dbColonnade . mconcat $ catMaybes [ Just . sortable (Just "name") (i18nCell MsgExamName) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> anchorCell (CExamR tid ssh csh examName EShowR) examName , (<$ guard mayCreate) . sortable (Just "visible") (i18nCell MsgExamVisibleFrom) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty (dateTimeCellVisible now) examVisibleFrom , Just . sortable (Just "register-from") (i18nCell MsgExamRegisterFrom) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterFrom , Just . sortable (Just "register-to") (i18nCell MsgExamRegisterTo) $ \DBRow { dbrOutput = Entity _ Exam{..} } -> maybe mempty dateTimeCell examRegisterTo , Just . sortable (Just "time") (i18nCell MsgExamTime) $ \DBRow{ dbrOutput = Entity _ Exam{..} } -> maybe mempty (cell . flip (formatTimeRangeW SelFormatDateTime) examEnd) examStart ] dbtSorting = Map.fromList [ ("name", SortColumn $ \exam -> exam E.^. ExamName ) , ("time", SortColumn $ \exam -> exam E.^. ExamStart ) , ("register-from", SortColumn $ \exam -> exam E.^. ExamRegisterFrom ) , ("register-to", SortColumn $ \exam -> exam E.^. ExamRegisterTo ) , ("visible", SortColumn $ \exam -> exam E.^. ExamVisibleFrom ) ] dbtFilter = Map.empty dbtFilterUI = const mempty dbtStyle = def dbtParams = def dbtIdent :: Text dbtIdent = "exams" dbtCsvEncode = noCsvEncode dbtCsvDecode = Nothing examDBTableValidator = def & defaultSorting [SortAscBy "time"] ((), examTable) <- runDB $ dbTable examDBTableValidator examDBTable siteLayoutMsg (prependCourseTitle tid ssh csh MsgExamsHeading) $ do setTitleI $ prependCourseTitle tid ssh csh MsgExamsHeading $(widgetFile "exam-list")