refactor(daily): factor our tutorial selection function

This commit is contained in:
Steffen Jost 2024-09-18 18:03:49 +02:00 committed by Sarah Vaupel
parent 5c70b1099c
commit cac0a47d01

View File

@ -22,7 +22,7 @@ import qualified Data.Aeson as Aeson
-- import qualified Data.Text as Text
-- import Database.Persist.Sql (updateWhereCount)
-- import Database.Esqueleto.Experimental ((:&)(..))
import Database.Esqueleto.Experimental ((:&)(..))
import qualified Database.Esqueleto.Legacy as EL (on) -- only `on` and `from` are different, needed for dbTable using Esqueleto.Legacy
import qualified Database.Esqueleto.Experimental as E
import qualified Database.Esqueleto.Utils as E
@ -51,7 +51,19 @@ occurrenceDayValue d = Aeson.object
] ] ]
-- TODO: ensure that an appropriate GIN index for the jsonb column is set
getDayTutorials :: SchoolId -> Day -> DB [TutorialId]
getDayTutorials ssh d = E.unValue <<$>> E.select (do
-- getDayTutorials :: SchoolId -> Day -> DB [E.Value TutorialId]
-- getDayTutorials ssh d = E.select (do
(trm :& crs :& tut) <- E.from $ E.table @Term
`E.innerJoin` E.table @Course `E.on` (\(trm :& crs) -> crs E.^. CourseTerm E.==. trm E.^. TermId)
`E.innerJoin` E.table @Tutorial `E.on` (\(_ :& crs :& tut) -> crs E.^. CourseId E.==. tut E.^. TutorialCourse)
E.where_ $ E.between (E.val d) (trm E.^. TermStart, trm E.^. TermEnd)
E.&&. crs E.^. CourseSchool E.==. E.val ssh
E.&&. (E.just (tut E.^. TutorialTime) @>. E.jsonbVal (occurrenceDayValue d))
return $ tut E.^. TutorialId
)
-- CONTINUE HERE: deal with regular schedules and exceptions, filter in Haskell-Land and use memcaching for the result
type DailyTableExpr =
( E.SqlExpr (Entity Course)
@ -100,19 +112,14 @@ instance HasUser DailyTableData where
mkDailyTable :: Bool -> SchoolId -> Day -> DB (FormResult (DailyTableActionData, Set TutorialId), Widget)
mkDailyTable isAdmin ssh nd = do
tuts <- getDayTutorials ssh nd
let
dbtSQLQuery :: DailyTableExpr -> DailyTableOutput
dbtSQLQuery (crs `E.InnerJoin` tut `E.InnerJoin` tpu `E.InnerJoin` usr) = do
EL.on $ tut E.^. TutorialCourse E.==. crs E.^. CourseId
EL.on $ tut E.^. TutorialId E.==. tpu E.^. TutorialParticipantTutorial
EL.on $ usr E.^. UserId E.==. tpu E.^. TutorialParticipantUser
E.where_ $ crs E.^. CourseSchool E.==. E.val ssh
E.&&. (E.just (tut E.^. TutorialTime) @>. E.jsonbVal (occurrenceDayValue nd))
E.&&. E.exists (do
trm <- E.from $ E.table @Term
E.where_ $ trm E.^. TermId E.==. crs E.^. CourseTerm
E.&&. E.between (E.val nd) (trm E.^. TermStart, trm E.^. TermEnd)
)
E.where_ $ tut E.^. TutorialId `E.in_` E.valList tuts
return (crs, tut, tpu, usr, selectCompanyUserPrime usr)
dbtRowKey = queryTutorial >>> (E.^. TutorialId)
dbtProj = dbtProjId