refactor(daily): factor our tutorial selection function
This commit is contained in:
parent
5c70b1099c
commit
cac0a47d01
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user