chore(user): assimilateUser considers qualifications (wip)
This commit is contained in:
parent
184ccbc7a6
commit
56af63adc0
@ -26,7 +26,7 @@ module Database.Esqueleto.Utils
|
|||||||
, maybe, maybe2, maybeEq, guardMaybe, unsafeCoalesce
|
, maybe, maybe2, maybeEq, guardMaybe, unsafeCoalesce
|
||||||
, bool
|
, bool
|
||||||
, max, min
|
, max, min
|
||||||
, greatest
|
, greatest, least
|
||||||
, abs
|
, abs
|
||||||
, SqlProject(..)
|
, SqlProject(..)
|
||||||
, (->.), (#>>.)
|
, (->.), (#>>.)
|
||||||
@ -36,7 +36,7 @@ module Database.Esqueleto.Utils
|
|||||||
, selectMaybe
|
, selectMaybe
|
||||||
, day, diffDays, diffTimes
|
, day, diffDays, diffTimes
|
||||||
, exprLift
|
, exprLift
|
||||||
, explicitUnsafeCoerceSqlExprValue
|
, explicitUnsafeCoerceSqlExprValue
|
||||||
, module Database.Esqueleto.Utils.TH
|
, module Database.Esqueleto.Utils.TH
|
||||||
) where
|
) 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 :: PersistField a => (E.SqlExpr (E.Value a), E.SqlExpr (E.Value a)) -> E.SqlExpr (E.Value a)
|
||||||
greatest = E.unsafeSqlFunction "GREATEST" . E.toArgList
|
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)
|
abs :: (PersistField a, Num a)
|
||||||
|
|||||||
@ -243,7 +243,7 @@ assimilateUser :: UserId -- ^ @newUserId@
|
|||||||
-- ^ Move all relevant properties (submissions, corrections, grades, ...) from @oldUserId@ to @newUserId@
|
-- ^ Move all relevant properties (submissions, corrections, grades, ...) from @oldUserId@ to @newUserId@
|
||||||
--
|
--
|
||||||
-- Fatal errors are thrown, non-fatal warnings are returned
|
-- Fatal errors are thrown, non-fatal warnings are returned
|
||||||
assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
|
assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
|
||||||
E.insertSelectWithConflict
|
E.insertSelectWithConflict
|
||||||
UniqueCourseFavourite
|
UniqueCourseFavourite
|
||||||
(E.from $ \courseFavourite -> do
|
(E.from $ \courseFavourite -> do
|
||||||
@ -779,7 +779,7 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
|
|||||||
E.<&> E.val newUserId
|
E.<&> E.val newUserId
|
||||||
E.<&> (systemMessageHidden E.^. SystemMessageHiddenTime)
|
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 ]
|
deleteWhere [ SystemMessageHiddenUser ==. oldUserId ]
|
||||||
|
|
||||||
let getStudyFeatures = selectSource [ StudyFeaturesUser ==. oldUserId ] []
|
let getStudyFeatures = selectSource [ StudyFeaturesUser ==. oldUserId ] []
|
||||||
@ -808,6 +808,29 @@ assimilateUser newUserId oldUserId = mapReaderT execWriterT $ do
|
|||||||
delete oldSFId
|
delete oldSFId
|
||||||
in runConduit $ getStudyFeatures .| C.mapM_ upsertStudyFeatures
|
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
|
userIdents <- E.select . E.from $ \user -> do
|
||||||
E.where_ $ user E.^. UserId `E.in_` E.valList [newUserId, oldUserId]
|
E.where_ $ user E.^. UserId `E.in_` E.valList [newUserId, oldUserId]
|
||||||
return ( user E.^. UserId
|
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 :: forall a. UserAssimilateExceptionReason -> ReaderT SqlBackend (WriterT (Set UserAssimilateException) Handler) a
|
||||||
tellError = throwM . UserAssimilateException oldUserId newUserId
|
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)
|
||||||
@ -22,6 +22,15 @@ import Jobs.Handler.SendNotification.CourseRegistered
|
|||||||
import Jobs.Handler.SendNotification.SubmissionEdited
|
import Jobs.Handler.SendNotification.SubmissionEdited
|
||||||
import Jobs.Handler.SendNotification.Qualification
|
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 :: UserId -> Notification -> JobHandler UniWorX
|
||||||
dispatchJobSendNotification jRecipient jNotification = JobHandlerException $ do
|
dispatchJobSendNotification jRecipient jNotification = JobHandlerException $ do
|
||||||
@ -32,3 +41,4 @@ dispatchJobSendNotification jRecipient jNotification = JobHandlerException $ do
|
|||||||
then $(dispatchTH ''Notification) jNotification jRecipient
|
then $(dispatchTH ''Notification) jNotification jRecipient
|
||||||
else forM_ superVs $ \Entity { entityVal = UserSupervisor { userSupervisorSupervisor = svr } } ->
|
else forM_ superVs $ \Entity { entityVal = UserSupervisor { userSupervisorSupervisor = svr } } ->
|
||||||
$(dispatchTH ''Notification) jNotification svr
|
$(dispatchTH ''Notification) jNotification svr
|
||||||
|
-}
|
||||||
Loading…
Reference in New Issue
Block a user