diff --git a/fill-db.hs b/fill-db.hs index 26114a88f..dd8f42c62 100755 --- a/fill-db.hs +++ b/fill-db.hs @@ -87,20 +87,17 @@ main = db $ do , courseTermId = TermKey summer2018 , courseSchoolId = ifi , courseCapacity = Just 20 - , courseCreated = now - , courseChanged = now - , courseCreatedBy = gkleen - , courseChangedBy = gkleen , courseHasRegistration = True , courseRegisterFrom = Just now , courseRegisterTo = Just ((3600 * 24 * 60) `addUTCTime` now ) } + insert_ $ CourseEdit jost now ffp void . insert $ DegreeCourse ifiBsc ffp void . insert $ DegreeCourse ifiMsc ffp void . insert $ Lecturer gkleen ffp insert_ $ Corrector gkleen ffp (ByProportion 1) sheetkey <- insert $ Sheet ffp "Blatt 1" Nothing NotGraded NoGroups Nothing Nothing now now Nothing Nothing - insert_ $ SheetEdit gkleen sheetkey now + insert_ $ SheetEdit gkleen now sheetkey -- EIP eip <- insert Course { courseName = "Einführung in die Programmierung" @@ -110,14 +107,11 @@ main = db $ do , courseTermId = TermKey summer2017 , courseSchoolId = ifi , courseCapacity = Just 20 - , courseCreated = now - , courseChanged = now - , courseCreatedBy = fhamann - , courseChangedBy = fhamann , courseHasRegistration = False , courseRegisterFrom = Nothing , courseRegisterTo = Nothing } + insert_ $ CourseEdit fhamann now eip void . insert $ DegreeCourse ifiBsc eip void . insert $ DegreeCourse ifiMsc eip void . insert $ Lecturer fhamann eip @@ -130,14 +124,11 @@ main = db $ do , courseTermId = TermKey summer2018 , courseSchoolId = ifi , courseCapacity = Just 20 - , courseCreated = now - , courseChanged = now - , courseCreatedBy = fhamann - , courseChangedBy = fhamann , courseHasRegistration = True , courseRegisterFrom = Just now , courseRegisterTo = Just ((3600 * 24 * 60) `addUTCTime` now ) } + insert_ $ CourseEdit fhamann now ixd void . insert $ DegreeCourse ifiBsc ixd void . insert $ Lecturer fhamann ixd -- concept development @@ -149,14 +140,11 @@ main = db $ do , courseTermId = TermKey winter2017 , courseSchoolId = ifi , courseCapacity = Just 30 - , courseCreated = now - , courseChanged = now - , courseCreatedBy = fhamann - , courseChangedBy = fhamann , courseHasRegistration = False , courseRegisterFrom = Nothing , courseRegisterTo = Nothing } + insert_ $ CourseEdit fhamann now ux3 void . insert $ DegreeCourse ifiBsc ux3 void . insert $ Lecturer fhamann ux3 -- promo @@ -168,14 +156,11 @@ main = db $ do , courseTermId = TermKey summer2017 , courseSchoolId = ifi , courseCapacity = Just 50 - , courseCreated = now - , courseChanged = now - , courseCreatedBy = jost - , courseChangedBy = jost , courseHasRegistration = False , courseRegisterFrom = Nothing , courseRegisterTo = Nothing } + insert_ $ CourseEdit jost now pmo void . insert $ DegreeCourse ifiBsc pmo void . insert $ Lecturer jost pmo -- datenbanksysteme @@ -187,13 +172,11 @@ main = db $ do , courseTermId = TermKey summer2018 , courseSchoolId = ifi , courseCapacity = Just 50 - , courseCreated = now - , courseChanged = now - , courseCreatedBy = jost - , courseChangedBy = jost , courseHasRegistration = False , courseRegisterFrom = Nothing , courseRegisterTo = Nothing } + insert_ $ CourseEdit gkleen now dbs void . insert $ DegreeCourse ifiBsc dbs - void . insert $ Lecturer jost dbs + void . insert $ Lecturer gkleen dbs + void . insert $ Lecturer jost dbs diff --git a/models b/models index d07c3f9bd..ea24256b9 100644 --- a/models +++ b/models @@ -61,14 +61,14 @@ Course termId TermId schoolId SchoolId capacity Int Maybe - created UTCTime - changed UTCTime - createdBy UserId - changedBy UserId hasRegistration Bool -- canRegisterNow = hasRegistration && maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo registerFrom UTCTime Maybe registerTo UTCTime Maybe CourseTermShort termId shorthand +CourseEdit + user UserId + time UTCTime + course CourseId Lecturer userId UserId courseId CourseId @@ -106,8 +106,8 @@ Sheet CourseSheet courseId name SheetEdit user UserId - sheet SheetId time UTCTime + sheet SheetId SheetFile sheetId SheetId fileId FileId @@ -124,11 +124,11 @@ Submission ratingComment Text Maybe ratingBy UserId Maybe ratingTime UTCTime Maybe - created UTCTime - changed UTCTime - createdBy UserId - changedBy UserId deriving Show +SubmissionEdit + user UserId + time UTCTime + submission SubmissionId SubmissionFile submissionId SubmissionId fileId FileId @@ -143,10 +143,10 @@ SubmissionUser SubmissionGroup courseId CourseId name Text - created UTCTime - changed UTCTime - createdBy UserId - changedBy UserId +SubmissionGroupEdit + user UserId + time UTCTime + submissionGroup SubmissionGroupId SubmissionGroupUser submissionGroupId SubmissionGroupId userId UserId @@ -165,13 +165,12 @@ Booking end UTCTime weekly Bool exceptions [Day] -- only if weekly, begin in exception - created UTCTime - changed UTCTime - createdBy UserId - changedBy UserId - bookedFor RoomForId room RoomId +BookingEdit + user UserId + time UTCTime + boooking BookingId Room name Text capacity Int Maybe @@ -197,10 +196,10 @@ Exam deregistrationEnd UTCTime ratingVisible Bool statisticsVisible Bool - created UTCTime - changed UTCTime - createdBy UserId - changedBy UserId +ExamEdit + user UserId + time UTCTime + exam ExamId ExamUser userId UserId examId ExamId diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index aebfe8634..4a7a36623 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -177,7 +177,7 @@ courseEditHandler course = do , cfTerm = tid })) -> do -- create new course let tident = unTermKey tid - actTime <- liftIO getCurrentTime + now <- liftIO getCurrentTime insertOkay <- runDB $ insertUnique $ Course { courseName = cfName res , courseDescription = cfDesc res @@ -189,14 +189,12 @@ courseEditHandler course = do , courseHasRegistration = cfHasReg res , courseRegisterFrom = cfRegFrom res , courseRegisterTo = cfRegTo res - , courseCreated = actTime - , courseChanged = actTime - , courseCreatedBy = aid - , courseChangedBy = aid - } + } case insertOkay of (Just cid) -> do - runDB $ insert_ $ Lecturer aid cid + runDB $ do + insert_ $ CourseEdit aid now cid + insert_ $ Lecturer aid cid addMessageI "info" $ MsgCourseNewOk tident csh redirect $ CourseListTermR tid Nothing -> @@ -208,7 +206,7 @@ courseEditHandler course = do , cfTerm = tid })) -> do -- edit existing course let tident = unTermKey tid - actTime <- liftIO getCurrentTime + now <- liftIO getCurrentTime -- addMessage "debug" [shamlet| #{show res}|] runDB $ do old <- get cid @@ -231,9 +229,9 @@ courseEditHandler course = do -- , CourseRegisterFrom =. cfRegFrom res -- , CourseRegisterTo =. cfRegTo res -- , CourseChangedBy =. aid --- , CourseChanged =. actTime +-- , CourseChanged =. now -- ] - updOkay <- replace cid ( -- TODO replaceUnique requires Eq?! + _updOkay <- replace cid ( -- TODO replaceUnique requires Eq?! Course { courseName = cfName res , courseDescription = cfDesc res , courseLinkExternal = cfLink res @@ -241,15 +239,12 @@ courseEditHandler course = do , courseTermId = cfTerm res , courseSchoolId = cfSchool res , courseCapacity = cfCapacity res - , courseChanged = actTime - , courseChangedBy = aid - , courseCreated = courseCreated oldCourse - , courseCreatedBy = courseCreatedBy oldCourse , courseHasRegistration = cfHasReg res , courseRegisterFrom = cfRegFrom res , courseRegisterTo = cfRegTo res } ) + insert_ $ CourseEdit aid now cid -- if (isNothing updOkay) -- then do addMessageI "info" $ MsgCourseEditOk tident csh diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index ad336b12d..65efda688 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -317,7 +317,7 @@ handleSheetEdit tid csh template dbAction = do whenIsJust sfSheetF $ insertSheetFile sid SheetExercise whenIsJust sfHintF $ insertSheetFile sid SheetHint whenIsJust sfSolutionF $ insertSheetFile sid SheetSolution - insert_ $ SheetEdit aid sid actTime + insert_ $ SheetEdit aid actTime sid addMessageI "info" $ MsgSheetEditOk tident csh sfName return True when saveOkay $ redirect $ CSheetR tid csh $ SheetShowR sfName -- redirect must happen outside of runDB diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index 78ec0ed4a..3e2160d28 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -8,6 +8,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE ViewPatterns #-} module Handler.Submission where @@ -177,8 +178,12 @@ postSubmissionDownloadMultiArchiveR = do withinDirectory f@File{..} = f { fileTitle = directoryName fileTitle } + lastEditMb <- lift $ selectList [SubmissionEditSubmission ==. submissionID] [Desc SubmissionEditTime, LimitTo 1] + lastEditTime <- case lastEditMb of + [(submissionEditTime.entityVal -> time)] -> return time + _other -> liftIO getCurrentTime yield $ File - { fileModified = submissionChanged + { fileModified = lastEditTime , fileTitle = directoryName , fileContent = Nothing } diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index fad44f370..6a100ab98 100644 --- a/src/Handler/Utils/Submission.hs +++ b/src/Handler/Utils/Submission.hs @@ -70,12 +70,9 @@ sinkSubmission sheetId userId mExists = do submissionRatingComment = Nothing submissionRatingBy = Nothing submissionRatingTime = Nothing - submissionCreated = now - submissionChanged = now - submissionCreatedBy = userId - submissionChangedBy = userId - (sId, isUpdate) <- lift $ maybe ((, False) <$> insert Submission{..}) return mExists + (sId, isUpdate) <- lift $ maybe ((, False) <$> (insert Submission{..} >>= (\sid -> sid <$ insert (SubmissionEdit userId now sid)))) return mExists + sId <$ sinkSubmission' sId isUpdate where @@ -184,9 +181,9 @@ sinkSubmission sheetId userId mExists = do alreadyTouched <- gets $ getAny . sinkSubmissionTouched when (not alreadyTouched) $ do now <- liftIO getCurrentTime - lift . update submissionId $ case isUpdate of - False -> [ SubmissionChangedBy =. userId, SubmissionChanged =. now ] - True -> [ SubmissionRatingBy =. Just userId, SubmissionRatingTime =. Just now ] + lift $ case isUpdate of + False -> insert_ $ SubmissionEdit userId now submissionId + True -> update submissionId [ SubmissionRatingBy =. Just userId, SubmissionRatingTime =. Just now ] tell $ mempty{ sinkSubmissionTouched = Any True } finalize :: SubmissionSinkState -> YesodDB UniWorX ()