fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(tutorial): assign exam rooms for tutorial users ad hoc

Browse Source
This commit is contained in:
Steffen Jost 2024-12-19 15:57:49 +01:00 committed by Sarah Vaupel
parent 1d68ed9c5e
commit f44d66cb91
12 changed files with 119 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
messages/uniworx/categories/courses/courses/de-de-formal.msg
View File

@ -136,6 +136,7 @@ CourseUserNoTutorialsDeregistered: Teilnehmer:in ist zu keinem der gewählten Ku
CourseUserTutorials: Angemeldete Kurse
CourseUserExams: Angemeldete Prüfungen
CourseUserExamOccurrences: Prüfungstermin
CourseUserExamOccurrenceOverride: Ggf. vorhanden Prüfungstermin überschreiben
CourseUserSheets: Übungsblätter
CsvColumnUserName: Voller Name des/der Teilnehmers/Teilnehmerin
CsvColumnUserMatriculation: AVS Nummer des/der Teilnehmers/Teilnehmerin

1
messages/uniworx/categories/courses/courses/en-eu.msg
View File

@ -136,6 +136,7 @@ CourseUserNoTutorialsDeregistered: Participant is not registered for any of the
CourseUserTutorials: Registered courses
CourseUserExams: Registered exams
CourseUserExamOccurrences: Exam occurrence
CourseUserExamOccurrenceOverride: Override other registrations for this exam, if any
CourseUserSheets: Exercise sheets
CsvColumnUserName: Participant's full name
CsvColumnUserMatriculation: Participant's AVS number

1
messages/uniworx/categories/courses/exam/exam/de-de-formal.msg
View File

@ -86,6 +86,7 @@ ExamRoomAlreadyExists: Prüfung ist bereits eingetragen
ExamRoomName: Interne Bezeichnung
ExamRoomCapacity: Kapazität
ExamRoomCapacityNegative: Kapazität darf nicht negativ sein
ExamRommCapacityInsufficient n@Int: Kapazität reicht nicht aus, nur noch #{n} Plätze verfügbar
ExamRoomTime: Termin
ExamRoomStart: Beginn
ExamRoomEnd: Ende

1
messages/uniworx/categories/courses/exam/exam/en-eu.msg
View File

@ -86,6 +86,7 @@ ExamRoomAlreadyExists: Occurrence already configured
ExamRoomName: Internal name
ExamRoomCapacity: Capacity
ExamRoomCapacityNegative: Capacity may not be negative
ExamRommCapacityInsufficient n@Int: Insufficient capacity, only #{n} remaining
ExamRoomTime: Time
ExamRoomStart: Start
ExamRoomEnd: End

2
messages/uniworx/categories/courses/tutorial/de-de-formal.msg
View File

@ -50,6 +50,8 @@ TutorialUserGrantQualification: Qualifikation vergeben
TutorialUserRenewQualification: Qualifikation regulär verlängern
TutorialUserRenewedQualification n@Int: Qualifikation für #{tshow n} Kurs-#{pluralDE n "Teilnehmer:in" "Teilnehmer:innen"} regulär verlängert
TutorialUserGrantedQualification n@Int: Qualifikation erfolgreich an #{tshow n} Kurs-#{pluralDE n "Teilnehmer:in" "Teilnehmer:innen"} vergeben
TutorialUserAssignExam: Zur Prüfung einteilen
TutorialUserExamAssignedFor n@Int m@Int p@Text: #{n}/#{m} zur Prüfung #{p} eingeteilt
CommTutorial: Kursmitteilung
TutorialDrivingPermit: Führerschein
TutorialEyeExam: Sehtest

2
messages/uniworx/categories/courses/tutorial/en-eu.msg
View File

@ -51,6 +51,8 @@ TutorialUserGrantQualification: Grant qualification
TutorialUserRenewQualification: Renew qualification
TutorialUserRenewedQualification n@Int: Successfully renewed qualification #{tshow n} course #{pluralEN n "user" "users"}
TutorialUserGrantedQualification n: Successfully granted qualification #{tshow n} course #{pluralEN n "user" "users"}
TutorialUserAssignExam: Register for examination
TutorialUserExamAssignedFor n@Int m@Int p@Text: #{n}/#{m} enrolled for exam #{p}
CommTutorial: Course message
TutorialDrivingPermit: Driving permit
TutorialEyeExam: Eye exam

30
src/Database/Esqueleto/Utils.hs
View File

@ -53,6 +53,7 @@ module Database.Esqueleto.Utils
, str2citext
, num2text --, text2num
, day, day', dayMaybe, interval, diffDays, diffTimes
, withinPeriod
, exprLift
, explicitUnsafeCoerceSqlExprValue
, psqlVersion_
@ -151,21 +152,25 @@ infixl 4 ?=.
-- | like (=?.) but also succeeds if the right-hand side is NULL. Can often be avoided by moving from where- to join-condition!
infixl 4 =~.
(=~.) :: PersistField typ => E.SqlExpr (E.Value typ) -> E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value Bool)
(=~.) a b = E.isNothing b E.||. (E.just a E.==. b)
-- (=~.) a b = E.isNothing b E.||. (E.just a E.==. b) -- avoid expensive E.||.
(=~.) a b = a E.==. E.coalesceDefault [b] a
infixl 4 ~=.
(~=.) :: PersistField typ => E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value typ) -> E.SqlExpr (E.Value Bool)
(~=.) a b = E.isNothing a E.||. (a E.==. E.just b)
-- (~=.) a b = E.isNothing a E.||. (a E.==. E.just b) -- avoid expensive E.||.
(~=.) a b = b E.==. E.coalesceDefault [a] b
-- | like (>.), but also succeeds if the right-hand side is NULL
-- | like (>=.), but also succeeds if the right-hand side is NULL
infixl 4 >~.
(>~.) :: PersistField typ => E.SqlExpr (E.Value typ) -> E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value Bool)
(>~.) a b = E.isNothing b E.||. (E.just a E.>. b)
-- (>~.) a b = E.isNothing b E.||. (E.just a E.>. b)
(>~.) a b = a E.>=. E.coalesceDefault [b] a
-- | like (<.), but also succeeds if the right-hand side is NULL
-- | like (<=.), but also succeeds if the right-hand side is NULL
infixl 4 <~.
(<~.) :: PersistField typ => E.SqlExpr (E.Value typ) -> E.SqlExpr (E.Value (Maybe typ)) -> E.SqlExpr (E.Value Bool)
(<~.) a b = E.isNothing b E.||. (E.just a E.<. b)
-- (<~.) a b = E.isNothing b E.||. (E.just a E.<. b)
(<~.) a b = a E.<=. E.coalesceDefault [b] a
infixr 2 ~., ~*., !~., !~*.
@ -774,6 +779,19 @@ day' = E.unsafeSqlCastAs "date"
dayMaybe :: E.SqlExpr (E.Value (Maybe UTCTime)) -> E.SqlExpr (E.Value (Maybe Day))
dayMaybe = E.unsafeSqlCastAs "date"
-- | Given an occurrence with start-time and maybe an end-time, does it overlap with a given day interval?
-- If there is no end-time, then the start-time must be in between.
withinPeriod :: (Day, Day) -> E.SqlExpr (E.Value UTCTime) -> E.SqlExpr (E.Value (Maybe UTCTime)) -> E.SqlExpr (E.Value Bool)
withinPeriod (dbegin, dend) tfrom tto = day tfrom E.<=. E.val dend
E.&&. E.coalesceDefault [dayMaybe tto]
(day tfrom) E.>=. E.val dbegin
-- Alternative variant which SJ expected to be more efficient, if there is an index on the first argument available,
-- but FraportGPT thinks otherwise: "OR conditions may prevent the efficient use of an index. OR conditions can sometimes lead to a full table scan, whereas COALESCE is quite cheap"
-- withinPeriod (dstart, dend) tfrom tto = day tfrom E.<=. E.val dend
-- E.&&. ( day tfrom E.>=. E.val dstart
-- E.||. (isJust tto E.&&. dayMaybe tto E.>=. justVal dstart ))
interval :: CalendarDiffDays -> E.SqlExpr (E.Value Day) -- E.+=. requires both types to be the same, so we use Day
-- interval _ = E.unsafeSqlCastAs "interval" $ E.unsafeSqlValue "'P2Y'" -- tested working example
interval = E.unsafeSqlCastAs "interval". E.unsafeSqlValue . wrapSqlString . Text.Builder.fromString . iso8601Show

80
src/Handler/Tutorial/Users.hs
View File

@ -14,7 +14,7 @@ import Utils.Form
import Utils.Print
import Handler.Utils
import Handler.Utils.Course
-- import Handler.Utils.Course.Cache
import Handler.Utils.Course.Cache
import Handler.Utils.Tutorial
import Database.Persist.Sql (deleteWhereCount)
@ -32,7 +32,8 @@ import Handler.Course.Users
data TutorialUserAction
= TutorialUserPrintQualification
= TutorialUserAssignExam
| TutorialUserPrintQualification
| TutorialUserRenewQualification
| TutorialUserGrantQualification
| TutorialUserSendMail
@ -53,21 +54,26 @@ data TutorialUserActionData
, tuValidUntil :: Day
}
| TutorialUserSendMailData
| TutorialUserDeregisterData{}
| TutorialUserDeregisterData
| TutorialUserAssignExamData
{ tuOccurrenceId :: ExamOccurrenceId
, tuReassign :: Bool
}
deriving (Eq, Ord, Read, Show, Generic)
getTUsersR, postTUsersR :: TermId -> SchoolId -> CourseShorthand -> TutorialName -> Handler TypedContent
getTUsersR = postTUsersR
postTUsersR tid ssh csh tutn = do
let croute = CTutorialR tid ssh csh tutn TUsersR
now <- liftIO getCurrentTime
isAdmin <- hasReadAccessTo AdminR
(Entity tutid tut@Tutorial{..}, (participantRes, participantTable), qualifications) <- runDB $ do
(Entity tutid tut@Tutorial{..}, (participantRes, participantTable), qualifications, exOccs) <- runDB $ do
trm <- get404 tid
-- cid <- getKeyBy404 $ TermSchoolCourseShort tid ssh csh
-- tutEnt@(Entity tutid _) <- fetchTutorial tid ssh csh tutn
(cid, tutEnt@(Entity tutid _)) <- fetchCourseIdTutorial tid ssh csh tutn
qualifications <- getCourseQualifications cid
now <- liftIO getCurrentTime
let nowaday = utctDay now
minDur :: Maybe Int = minimumMaybe $ mapMaybe (view _qualificationValidDuration) qualifications -- no instance Ord CalendarDiffDays
dayExpiry = flip addGregorianDurationClip nowaday . fromMonths <$> minDur
@ -90,34 +96,20 @@ postTUsersR tid ssh csh tutn = do
E.where_ $ tutorialParticipant E.^. TutorialParticipantUser E.==. queryUser q E.^. UserId
E.&&. tutorialParticipant E.^. TutorialParticipantTutorial E.==. E.val tutid
csvColChoices = flip elem ["name", "matriculation", "email", "qualifications"]
qualOptions = qualificationsOptionList qualifications
lessons = occurringLessons trm $ tutEnt ^. _entityVal . _tutorialTime . _Wrapped' -- TODO: export and show on page, since it is already computed!
_timespan = lessonTimesSpan lessons
-- for purposes of table actions, pick all currently open associated exams
_exams <- selectList
(-- ([ExamRegisterTo >=. Just now] ||. [ExamRegisterTo ==. Nothing]) ++ -- Reconsider: only allow exams with open registration?
([ExamEnd >=. Just now] ||. [ExamEnd ==. Nothing]) ++
[ ExamStart <=. Just now -- , ExamRegisterFrom <=. Just now
, ExamCourse ==. cid, ExamClosed ==. Nothing, ExamFinished ==. Nothing -- Reconsider: ExamFinished prevents publication of results - do we want this?
]) [Asc ExamRegisterFrom, Asc ExamStart, Asc ExamRegisterTo, Asc ExamName, LimitTo 7] -- earliest still open exam
-- tutorialTime
-- pick exam occurrences and tutors
-- TODO: !!!continue here!!!
-- _examOccs <- forM timespan $ \(dstart,dend) -> E.select $ do
-- occ <- E.from $ E.table @ExamOccurrence
-- E.where_ $ (occ E.^. ExamOccurrenceId `E.in_` E.valList (entityKey <$> exams))
-- E.&&. ( E.day (occ E.^. ExamOccurrenceStart) `E.between` (E.val dstart, E.val dend)
-- E.||. E.dayMaybe (occ E.^. ExamOccurrenceEnd) `E.between` (E.justVal dstart, E.justVal dend)
-- )
-- E.orderBy [E.asc $ occ E.^. ExamOccurrenceName]
-- multiActionAOpts or similar, see FirmAction for another example
lessons = occurringLessons trm $ tutEnt ^. _entityVal . _tutorialTime . _Wrapped'
timespan = lessonTimesSpan lessons
$logDebugS "Occurrences" $ tshow timespan
exOccs <- flip foldMapM timespan $ getDayExamOccurrences True ssh $ Just cid
let
acts :: Map TutorialUserAction (AForm Handler TutorialUserActionData)
acts = Map.fromList $
bcons (not $ null exOccs)
( TutorialUserAssignExam
, TutorialUserAssignExamData
<$> apopt (selectField $ pure $ mkExamOccurrenceOptions exOccs) (fslI MsgCourseUserExamOccurrences) Nothing
<*> apopt checkBoxField (fslI MsgCourseUserExamOccurrenceOverride) (Just False)
) $
(if null qualifications then mempty else
[ ( TutorialUserRenewQualification
, TutorialUserRenewQualificationData
@ -135,7 +127,7 @@ postTUsersR tid ssh csh tutn = do
, ( TutorialUserPrintQualification, pure TutorialUserPrintQualificationData )
]
table <- makeCourseUserTable cid acts isInTut colChoices psValidator (Just csvColChoices)
return (tutEnt, table, qualifications)
return (tutEnt, table, qualifications, exOccs)
let courseQids = Set.fromList (entityKey <$> qualifications)
tcontent <- formResultMaybe participantRes $ \case
@ -147,7 +139,6 @@ postTUsersR tid ssh csh tutn = do
case mbAletter of
Nothing -> addMessageI Error MsgErrorUnknownFormAction >> return Nothing -- TODO: better error message
Just aletter -> do
now <- liftIO getCurrentTime
apcIdent <- letterApcIdent aletter encRcvr now
let fName = letterFileName aletter
renderLetters rcvr letters apcIdent >>= \case
@ -164,22 +155,39 @@ postTUsersR tid ssh csh tutn = do
let reason = "Kurs " <> CI.original (unSchoolKey ssh) <> "-" <> CI.original csh <> "-" <> CI.original tutn
runDB . forM_ selectedUsers $ upsertQualificationUser tuQualification today tuValidUntil Nothing reason
addMessageI (if 0 < Set.size selectedUsers then Success else Warning) . MsgTutorialUserGrantedQualification $ Set.size selectedUsers
redirect $ CTutorialR tid ssh csh tutn TUsersR
reloadKeepGetParams croute
(TutorialUserRenewQualificationData{..}, selectedUsers)
| tuQualification `Set.member` courseQids -> do
noks <- runDB $ renewValidQualificationUsers tuQualification Nothing Nothing $ Set.toList selectedUsers
addMessageI (if noks > 0 && noks == Set.size selectedUsers then Success else Warning) $ MsgTutorialUserRenewedQualification noks
redirect $ CTutorialR tid ssh csh tutn TUsersR
(TutorialUserSendMailData{}, selectedUsers) -> do
reloadKeepGetParams croute
(TutorialUserSendMailData, selectedUsers) -> do
cids <- traverse encrypt $ Set.toList selectedUsers :: Handler [CryptoUUIDUser]
redirect (CTutorialR tid ssh csh tutn TCommR, [(toPathPiece GetRecipient, toPathPiece cID) | cID <- cids])
(TutorialUserDeregisterData{},selectedUsers) -> do
(TutorialUserDeregisterData, selectedUsers) -> do
nrDel <- runDB $ deleteWhereCount
[ TutorialParticipantTutorial ==. tutid
, TutorialParticipantUser <-. Set.toList selectedUsers
]
addMessageI Success $ MsgTutorialUsersDeregistered nrDel
redirect $ CTutorialR tid ssh csh tutn TUsersR
reloadKeepGetParams croute
(TutorialUserAssignExamData{..}, selectedUsers)
| (Just (ExamOccurrence{..}, (eid,_))) <- Map.lookup tuOccurrenceId exOccs -> do
let n = Set.size selectedUsers
capOk <- ifNothing examOccurrenceCapacity (pure True) $ \(fromIntegral -> totalCap) -> do
usedCap <- runDBRead $ count [ExamRegistrationOccurrence ==. Just tuOccurrenceId, ExamRegistrationUser /<-. Set.toList selectedUsers]
let ok = totalCap - usedCap >= n
unless ok $ addMessageI Error $ MsgExamRommCapacityInsufficient $ totalCap - usedCap
pure ok
when capOk $ do
let regTemplate uid = ExamRegistration eid uid (Just tuOccurrenceId) now
nrOk <- runDB $ if tuReassign
then putMany [regTemplate uid | uid <- Set.toList selectedUsers] >> pure n
else forM (Set.toList selectedUsers) (insertUnique . regTemplate) <&> (length . catMaybes)
let allok = bool Warning Success $ nrOk == n
addMessageI allok $ MsgTutorialUserExamAssignedFor nrOk n $ ciOriginal examOccurrenceName
reloadKeepGetParams croute
return Nothing
_other -> addMessageI Error MsgErrorUnknownFormAction >> return Nothing
case tcontent of

54
src/Handler/Utils/Course/Cache.hs
View File

@ -11,7 +11,7 @@ import Handler.Utils
import qualified Data.Set as Set
import qualified Data.Map as Map
import qualified Data.Aeson as Aeson
-- import qualified Data.Aeson as Aeson
-- import Database.Persist.Sql (updateWhereCount)
@ -23,15 +23,15 @@ import qualified Database.Esqueleto.Utils as E
-- | partial JSON object to be used for filtering with "@>"
-- partial JSON object to be used for filtering with "@>"
-- ensure that a GIN index for the jsonb column is created in Model.Migration.Definitions
occurrenceDayValue :: Day -> Value
occurrenceDayValue d = Aeson.object
[ "exceptions" Aeson..=
[ Aeson.object
[ "exception" Aeson..= ("occur"::Text)
, "day" Aeson..= d
] ] ]
-- occurrenceDayValue :: Day -> Value
-- occurrenceDayValue d = Aeson.object
-- [ "exceptions" Aeson..=
-- [ Aeson.object
-- [ "exception" Aeson..= ("occur"::Text)
-- , "day" Aeson..= d
-- ] ] ]
{- More efficient DB-only version, but ignores regular schedules
getDayTutorials :: SchoolId -> Day -> DB [TutorialId]
@ -131,22 +131,38 @@ getDayTutorials ssh dlimit@(dstart, dend )
-- mkOccMap :: (Entity Exam, Entity ExamOccurrence) -> Map ExamOccurrenceId (CourseId, ExamName, ExamOccurrence)
-- mkOccMap (entityVal -> exm, Entity{..}) = Map.singleton entityKey (exm ^. _examCourse, exm ^. _examName, entityVal)
type ExamOccurrenceMap = Map ExamOccurrenceId (ExamOccurrence, (ExamId, ExamName))
-- | retrieve all exam occurrences for a school in a given time period, ignoring term times; uses caching
getDayExamOccurrences :: SchoolId -> Maybe CourseId -> (Day,Day) -> DB (Map ExamOccurrenceId (CourseId, ExamName, ExamOccurrence))
getDayExamOccurrences ssh mbcid dlimit@(dstart, dend )
-- if a CourseId is specified, only exams from that course are returned
getDayExamOccurrences :: Bool -> SchoolId -> Maybe CourseId -> (Day,Day) -> DB ExamOccurrenceMap
getDayExamOccurrences onlyOpen ssh mbcid dlimit@(dstart, dend)
| dstart > dend = return mempty
| otherwise = memcachedByClass MemcachedKeyClassExamOccurrences (Just . Right $ 12 * diffDay) (CacheKeyExamOccurrences ssh dlimit mbcid) $ do
now <- liftIO getCurrentTime
candidates <- E.select $ do
(crs :& exm :& occ) <- E.from $ E.table @Course
`E.innerJoin` E.table @Exam `E.on` (\(crs :& exm) -> crs E.^. CourseId E.==. exm E.^. ExamCourse)
`E.innerJoin` E.table @ExamOccurrence `E.on` (\(_ :& exm :& occ) -> exm E.^. ExamId E.==. occ E.^. ExamOccurrenceExam)
E.where_ $ ifNothing mbcid id (\cid -> ((crs E.^. CourseId E.==. E.val cid) E.&&.)) $
E.val ssh E.==. crs E.^. CourseSchool
E.&&. ( E.day (occ E.^. ExamOccurrenceStart) `E.between` (E.val dstart, E.val dend)
E.||. E.dayMaybe (occ E.^. ExamOccurrenceEnd) `E.between` (E.justVal dstart, E.justVal dend)
)
return (exm, occ)
E.where_ $ E.and $ catMaybes
[ toMaybe onlyOpen $ E.justVal now E.>=. exm E.^. ExamRegisterFrom -- fail on null
E.&&. E.val now E.<~. exm E.^. ExamRegisterTo -- success on null
, mbcid <&> ((E.==. (crs E.^. CourseId)) . E.val)
, Just $ crs E.^. CourseSchool E.==. E.val ssh
, Just $ E.withinPeriod dlimit (occ E.^. ExamOccurrenceStart) (occ E.^. ExamOccurrenceEnd)
]
return (occ, exm E.^. ExamId, exm E.^. ExamName) -- No Binary instance for Entity Exam, so we only extract what is needed for now
return $ foldMap mkOccMap candidates
where
mkOccMap :: (Entity Exam, Entity ExamOccurrence) -> Map ExamOccurrenceId (CourseId, ExamName, ExamOccurrence)
mkOccMap (entityVal -> exm, Entity{..}) = Map.singleton entityKey (exm ^. _examCourse, exm ^. _examName, entityVal)
mkOccMap :: (Entity ExamOccurrence, E.Value ExamId, E.Value ExamName) -> ExamOccurrenceMap
mkOccMap (Entity{..}, E.Value eId, E.Value eName) = Map.singleton entityKey (entityVal, (eId, eName))
mkExamOccurrenceOptions :: ExamOccurrenceMap -> OptionList ExamOccurrenceId
mkExamOccurrenceOptions = mkOptionListGrouped . groupSort . map mkEOOption . Map.toList
where
mkEOOption :: (ExamOccurrenceId, (ExamOccurrence, (ExamId, ExamName))) -> (Text, [Option ExamOccurrenceId])
mkEOOption (eid, (ExamOccurrence{..}, (_,eName))) = (ciOriginal eName, [Option{..}])
where
optionDisplay = ciOriginal examOccurrenceName
optionExternalValue = toPathPiece $ eName <> ":" <> examOccurrenceName
optionInternalValue = eid

5
src/Model/Migration/Definitions.hs
View File

@ -92,6 +92,7 @@ migrateManual = do
, ("study_features_relevance_cached", "CREATE INDEX study_features_relevance_cached ON \"study_features\" (relevance_cached)")
, ("submission_rating_by", "CREATE INDEX submission_rating_by ON submission (rating_by) WHERE rating_by IS NOT NULL" )
, ("exam_corrector_user", "CREATE INDEX exam_corrector_user ON exam_corrector (\"user\")" )
, ("exam_occurrence_start", "CREATE INDEX exam_occurrence_start ON exam_occurrence (\"start\")" )
, ("submission_rating_time", "CREATE INDEX submission_rating_time ON submission (rating_time)" )
, ("idx_qualification_user_first_held" ,"CREATE INDEX idx_qualification_user_first_held ON \"qualification_user\" (\"first_held\")")
, ("idx_qualification_user_valid_until" ,"CREATE INDEX idx_qualification_user_valid_until ON \"qualification_user\" (\"valid_until\")")
@ -102,8 +103,8 @@ migrateManual = do
, ("idx_lms_report_log_q_ident_time" ,"CREATE INDEX idx_lms_report_log_q_ident_time ON \"lms_report_log\" (\"qualification\",\"ident\",\"timestamp\")")
, ("idx_user_company_company" ,"CREATE INDEX idx_user_company_company ON \"user_company\" (\"company\")") -- composed index from unique cannot be used for frequently used filters on company
, ("idx_user_supervisor_user" ,"CREATE INDEX idx_user_supervisor_user ON \"user_supervisor\" (\"user\")") -- composed index from unique cannot be used for frequently used filters on user
, ("idx_tutorial_time" ,"CREATE INDEX idx_tutorial_time ON \"tutorial\" USING GIN (\"time\")") -- GIN Index to speed up filtering with @>.
, ("idx_course_event_time" ,"CREATE INDEX idx_course_event_time ON \"course_event\" USING GIN (\"time\")") -- GIN Index to speed up filtering with @>.
-- , ("idx_tutorial_time" ,"CREATE INDEX idx_tutorial_time ON \"tutorial\" USING GIN (\"time\")") -- GIN Index to speed up filtering with @>.
-- , ("idx_course_event_time" ,"CREATE INDEX idx_course_event_time ON \"course_event\" USING GIN (\"time\")") -- GIN Index to speed up filtering with @>.
]
where
addIndex :: Text -> Sql -> Migration

2
src/Model/Types/Exam.hs
View File

@ -238,7 +238,7 @@ traverseExamOccurrenceMapping :: Ord roomId'
traverseExamOccurrenceMapping = _examOccurrenceMappingMapping . iso Map.toList (Map.fromListWith Set.union) . traverse . _1
-- | Natural extended by representation for Infinity.
--
--
-- Maybe doesn't work, because the 'Ord' instance puts 'Nothing' below 0
-- instead of above every other number.
newtype ExamOccurrenceCapacity = EOCapacity (Maybe Natural)

4
src/Utils.hs
View File

@ -769,6 +769,10 @@ adjustAssoc upd key = aux
where
v' = upd v
-- | Merge all duplicate keys of an association list over a semigroup and sort the association list
groupSort :: (Ord k, Semigroup v) => [(k,v)] -> [(k,v)]
groupSort = Map.toAscList . Map.fromListWith (<>)
-- | Copied form Util from package ghc
partitionWith :: (a -> Either b c) -> [a] -> ([b], [c])
-- ^ Uses a function to determine which of two output lists an input element should join