61 lines
2.7 KiB
Haskell
61 lines
2.7 KiB
Haskell
module Handler.Exam.List
|
|
( getCExamListR
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Handler.Utils
|
|
import Handler.Utils.Table.Cells
|
|
|
|
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")
|