fradrive/src/Handler/ExternalExam/Show.hs

50 lines
1.8 KiB
Haskell

module Handler.ExternalExam.Show
( getEEShowR
) where
import Import
import Handler.Utils
import Handler.Utils.Invitations
import Handler.ExternalExam.StaffInvite ()
import qualified Data.CaseInsensitive as CI
import qualified Data.Map as Map
import qualified Database.Esqueleto as E
getEEShowR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html
getEEShowR tid ssh coursen examn = do
mUid <- maybeAuthId
(Entity _ ExternalExam{..}, fmap entityVal -> mResult, School{..}, staff, addSchools) <- runDB $ do
exam@(Entity eeId ExternalExam{..}) <- getBy404 $ UniqueExternalExam tid ssh coursen examn
actualStaff <- E.select . E.from $ \(eeStaff `E.InnerJoin` user) -> do
E.on $ eeStaff E.^. ExternalExamStaffUser E.==. user E.^. UserId
E.where_ $ eeStaff E.^. ExternalExamStaffExam E.==. E.val eeId
E.orderBy [E.asc $ user E.^. UserDisplayName]
return user
maySeeInvites <- hasReadAccessTo $ EExamR tid ssh coursen examn EEGradesR
staffInvites <- if
| maySeeInvites -> sourceInvitationsF @ExternalExamStaff eeId
| otherwise -> return Map.empty
let staff = map Right actualStaff ++ map Left (Map.keys staffInvites)
addSchools <- E.select . E.from $ \(eeSchool `E.InnerJoin` school) -> do
E.on $ eeSchool E.^. ExternalExamOfficeSchoolSchool E.==. school E.^. SchoolId
E.where_ $ eeSchool E.^. ExternalExamOfficeSchoolExam E.==. E.val eeId
E.orderBy [E.asc $ school E.^. SchoolName]
return school
school <- getJust externalExamSchool
mResult <- fmap join . for mUid $ getBy . UniqueExternalExamResult eeId
return (exam, mResult, school, staff, addSchools)
let heading = CI.original examn
siteLayoutMsg heading $ do
setTitleI heading
$(widgetFile "external-exam-show")