module Handler.Utils.Sheet where import Import import qualified Database.Esqueleto as E import qualified Database.Esqueleto.Internal.Sql as E -- | Map sheet file types to their visibily dates of a given sheet, for convenience sheetFileTypeDates :: Sheet -> SheetFileType -> Maybe UTCTime sheetFileTypeDates Sheet{..} = \case SheetExercise -> sheetActiveFrom SheetHint -> sheetHintFrom SheetSolution -> sheetSolutionFrom SheetMarking -> Nothing fetchSheetAux :: ( E.SqlSelect b a , Typeable a, MonadHandler m ) => (E.SqlExpr (Entity Sheet) -> E.SqlExpr (Entity Course) -> b) -> TermId -> SchoolId -> CourseShorthand -> SheetName -> SqlReadT m a fetchSheetAux prj tid ssh csh shn = let cachId = encodeUtf8 $ tshow (tid, ssh, csh, shn) in cachedBy cachId $ do -- Mit Yesod: -- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh -- getBy404 $ CourseSheet cid shn -- Mit Esqueleto: sheetList <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse E.where_ $ course E.^. CourseTerm E.==. E.val tid E.&&. course E.^. CourseSchool E.==. E.val ssh E.&&. course E.^. CourseShorthand E.==. E.val csh E.&&. sheet E.^. SheetName E.==. E.val shn return $ prj sheet course case sheetList of [sheet] -> return sheet _other -> notFound fetchSheet :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Entity Sheet) fetchSheet = fetchSheetAux const fetchSheetCourse :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Entity Sheet, Entity Course) fetchSheetCourse = fetchSheetAux (,) fetchSheetId :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Key Sheet) fetchSheetId tid ssh cid shn = E.unValue <$> fetchSheetAux (\sheet _ -> sheet E.^. SheetId) tid ssh cid shn fetchSheetIdCourseId :: TermId -> SchoolId -> CourseShorthand -> SheetName -> YesodDB UniWorX (Key Sheet, Key Course) fetchSheetIdCourseId tid ssh cid shn = bimap E.unValue E.unValue <$> fetchSheetAux (\sheet course -> (sheet E.^. SheetId, course E.^. CourseId)) tid ssh cid shn