54 lines
2.2 KiB
Haskell
54 lines
2.2 KiB
Haskell
module Handler.Utils.Sheet where
|
|
|
|
import Import
|
|
|
|
import qualified Database.Esqueleto as E
|
|
import qualified Database.Esqueleto.Internal.Internal 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
|
|
|
|
|