diff --git a/src/Database/Esqueleto/Utils.hs b/src/Database/Esqueleto/Utils.hs index 228179f9c..e0b93ee5b 100644 --- a/src/Database/Esqueleto/Utils.hs +++ b/src/Database/Esqueleto/Utils.hs @@ -26,7 +26,7 @@ module Database.Esqueleto.Utils , maybe, maybe2, maybeEq, guardMaybe, unsafeCoalesce , bool , max, min - , greatest + , greatest, least , abs , SqlProject(..) , (->.), (#>>.) @@ -36,7 +36,7 @@ module Database.Esqueleto.Utils , selectMaybe , day, diffDays, diffTimes , exprLift - , explicitUnsafeCoerceSqlExprValue + , explicitUnsafeCoerceSqlExprValue , module Database.Esqueleto.Utils.TH ) where @@ -435,6 +435,8 @@ min a b = bool a b $ b E.<. a greatest :: PersistField a => (E.SqlExpr (E.Value a), E.SqlExpr (E.Value a)) -> E.SqlExpr (E.Value a) greatest = E.unsafeSqlFunction "GREATEST" . E.toArgList +least :: PersistField a => (E.SqlExpr (E.Value a), E.SqlExpr (E.Value a)) -> E.SqlExpr (E.Value a) +least = E.unsafeSqlFunction "LEAST" . E.toArgList abs :: (PersistField a, Num a) diff --git a/src/Handler/Utils/Users.hs b/src/Handler/Utils/Users.hs index 5a50fcd79..6a2bd800e 100644 --- a/src/Handler/Utils/Users.hs +++ b/src/Handler/Utils/Users.hs @@ -243,7 +243,7 @@ assimilateUser :: UserId -- ^ @newUserId@ -- ^ Move all relevant properties (submissions, corrections, grades, ...) from @oldUserId@ to @newUserId@ -- -- Fatal errors are thrown, non-fatal warnings are returned -assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do +assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do E.insertSelectWithConflict UniqueCourseFavourite (E.from $ \courseFavourite -> do @@ -779,7 +779,7 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do E.<&> E.val newUserId E.<&> (systemMessageHidden E.^. SystemMessageHiddenTime) ) - (\current excluded -> [ SystemMessageHiddenTime E.=. E.max (current E.^. SystemMessageHiddenTime) (excluded E.^. SystemMessageHiddenTime) ]) + (\current excluded -> [ SystemMessageHiddenTime E.=. combineWith current excluded E.max SystemMessageHiddenTime]) deleteWhere [ SystemMessageHiddenUser ==. oldUserId ] let getStudyFeatures = selectSource [ StudyFeaturesUser ==. oldUserId ] [] @@ -808,6 +808,29 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do delete oldSFId in runConduit $ getStudyFeatures .| C.mapM_ upsertStudyFeatures + -- lms + E.insertSelectWithConflict + UniqueQualificationUser + (E.from $ \qualificationUser -> do + E.where_ $ qualificationUser E.^. QualificationUserUser E.==. E.val oldUserId + return $ QualificationUser + E.<# E.val newUserId + E.<&> (qualificationUser E.^. QualificationUserQualification) + E.<&> (qualificationUser E.^. QualificationUserValidUntil) + E.<&> (qualificationUser E.^. QualificationUserLastRefresh) + E.<&> (qualificationUser E.^. QualificationUserFirstHeld) + E.<&> (qualificationUser E.^. QualificationUserBlockedDue) + ) + (\current excluded -> + [ QualificationUserValidUntil E.=. combineWith current excluded E.max QualificationUserValidUntil + , QualificationUserLastRefresh E.=. combineWith current excluded E.max QualificationUserLastRefresh + , QualificationUserFirstHeld E.=. combineWith current excluded E.min QualificationUserFirstHeld + , QualificationUserBlockedDue E.=. combineWith current excluded E.max QualificationUserBlockedDue + ] + ) + -- TODO: LmsUser! + deleteWhere [ QualificationUserUser ==. oldUserId ] + userIdents <- E.select . E.from $ \user -> do E.where_ $ user E.^. UserId `E.in_` E.valList [newUserId, oldUserId] return ( user E.^. UserId @@ -827,3 +850,13 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do tellError :: forall a. UserAssimilateExceptionReason -> ReaderT SqlBackend (WriterT (Set UserAssimilateException) Handler) a tellError = throwM . UserAssimilateException oldUserId newUserId + + + +combineWith :: (PersistEntity val, PersistField typ1) => + E.SqlExpr (Entity val) + -> E.SqlExpr (Entity val) + -> (E.SqlExpr (E.Value typ1) -> E.SqlExpr (E.Value typ1) -> E.SqlExpr (E.Value typ2)) + -> EntityField val typ1 + -> E.SqlExpr (E.Value typ2) +combineWith x y f pj = f (x E.^. pj) (y E.^. pj) \ No newline at end of file diff --git a/src/Jobs/Handler/SendNotification.hs b/src/Jobs/Handler/SendNotification.hs index 80574a065..a819c3d4e 100644 --- a/src/Jobs/Handler/SendNotification.hs +++ b/src/Jobs/Handler/SendNotification.hs @@ -22,6 +22,15 @@ import Jobs.Handler.SendNotification.CourseRegistered import Jobs.Handler.SendNotification.SubmissionEdited import Jobs.Handler.SendNotification.Qualification +dispatchJobSendNotification :: UserId -> Notification -> JobHandler UniWorX +dispatchJobSendNotification jRecipient jNotification = JobHandlerException $ + $(dispatchTH ''Notification) jNotification jRecipient + +{- +IDEAS: + 1) change type of dispatchNotificationfunctions to take another argument in addition to + jRecipient jNotificiation + 2) change mailT and sendPrintJob to account for supervisors dispatchJobSendNotification :: UserId -> Notification -> JobHandler UniWorX dispatchJobSendNotification jRecipient jNotification = JobHandlerException $ do @@ -32,3 +41,4 @@ dispatchJobSendNotification jRecipient jNotification = JobHandlerException $ do then $(dispatchTH ''Notification) jNotification jRecipient else forM_ superVs $ \Entity { entityVal = UserSupervisor { userSupervisorSupervisor = svr } } -> $(dispatchTH ''Notification) jNotification svr +-} \ No newline at end of file