84 lines
3.4 KiB
Haskell
84 lines
3.4 KiB
Haskell
module Handler.ExternalExam.List
|
|
( getEExamListR
|
|
) where
|
|
|
|
import Import
|
|
|
|
import Handler.Utils
|
|
|
|
import qualified Database.Esqueleto as E
|
|
import qualified Database.Esqueleto.Utils as E
|
|
|
|
import qualified Data.Map as Map
|
|
|
|
|
|
getEExamListR :: Handler Html
|
|
getEExamListR = do
|
|
mAuthId <- maybeAuthId
|
|
|
|
let
|
|
examDBTable = DBTable{..}
|
|
where
|
|
resultEExam = _dbrOutput . _1
|
|
resultSchool = _dbrOutput . _2
|
|
|
|
queryEExam = $(E.sqlIJproj 2 1)
|
|
querySchool = $(E.sqlIJproj 2 2)
|
|
|
|
dbtSQLQuery (eexam `E.InnerJoin` school) = do
|
|
E.on $ eexam E.^. ExternalExamSchool E.==. school E.^. SchoolId
|
|
let
|
|
isStaff
|
|
| Just authId <- mAuthId
|
|
= E.exists . E.from $ \eexamStaff ->
|
|
E.where_ $ eexamStaff E.^. ExternalExamStaffExam E.==. eexam E.^. ExternalExamId
|
|
E.&&. eexamStaff E.^. ExternalExamStaffUser E.==. E.val authId
|
|
| otherwise
|
|
= E.false
|
|
isStudent
|
|
| Just authId <- mAuthId
|
|
= E.exists . E.from $ \eexamResult ->
|
|
E.where_ $ eexamResult E.^. ExternalExamResultExam E.==. eexam E.^. ExternalExamId
|
|
E.&&. eexamResult E.^. ExternalExamResultUser E.==. E.val authId
|
|
| otherwise
|
|
= E.false
|
|
E.where_ $ isStaff E.||. isStudent
|
|
|
|
return (eexam, school)
|
|
dbtRowKey = queryEExam >>> (E.^. ExternalExamId)
|
|
dbtProj = return
|
|
dbtColonnade = widgetColonnade $ mconcat
|
|
[ sortable (Just "term") (i18nCell MsgTerm) $ \(view resultEExam -> Entity _ ExternalExam{..}) -> i18nCell . ShortTermIdentifier $ unTermKey externalExamTerm
|
|
, sortable (Just "school") (i18nCell MsgSchool) $ \(view resultSchool -> Entity _ School{..}) -> i18nCell schoolName
|
|
, sortable (Just "course") (i18nCell MsgCourse) $ \(view resultEExam -> Entity _ ExternalExam{..}) -> i18nCell externalExamCourseName
|
|
, sortable (Just "name") (i18nCell MsgExamName) $ \(view resultEExam -> Entity _ ExternalExam{..}) -> anchorCell (EExamR externalExamTerm externalExamSchool externalExamCourseName externalExamExamName EEShowR) externalExamExamName
|
|
]
|
|
dbtSorting = Map.fromList
|
|
[ ("term", SortColumn $ queryEExam >>> (E.^. ExternalExamTerm))
|
|
, ("school", SortColumn $ querySchool >>> (E.^. SchoolName))
|
|
, ("course", SortColumn $ queryEExam >>> (E.^. ExternalExamCourseName))
|
|
, ("name", SortColumn $ queryEExam >>> (E.^. ExternalExamExamName))
|
|
]
|
|
dbtFilter = mconcat
|
|
[ singletonMap "may-access" . FilterProjected $ \(Any b) (view resultEExam -> Entity _ ExternalExam{..}) -> (==b) <$>
|
|
hasReadAccessTo (EExamR externalExamTerm externalExamSchool externalExamCourseName externalExamExamName EEShowR) :: DB Bool
|
|
]
|
|
dbtFilterUI = const mempty
|
|
dbtStyle = def
|
|
dbtParams = def
|
|
dbtIdent :: Text
|
|
dbtIdent = "external-exams"
|
|
dbtCsvEncode = noCsvEncode
|
|
dbtCsvDecode = Nothing
|
|
examDBTableValidator = def
|
|
& defaultSorting [SortDescBy "term", SortAscBy "school", SortAscBy "course", SortAscBy "name"]
|
|
& forceFilter "may-access" (Any True)
|
|
|
|
examTable <- runDB $ dbTableWidget' examDBTableValidator examDBTable
|
|
|
|
let heading = MsgMenuExternalExamList
|
|
|
|
siteLayoutMsg heading $ do
|
|
setTitleI heading
|
|
examTable
|