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

CreatedBy/ChangeBy als eigene Tabellen überall eingeführt

Browse Source
This commit is contained in:
SJost 2018-03-22 20:35:17 +01:00
parent 6fe311ee78
commit 05a0f6b0bf
6 changed files with 51 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
fill-db.hs
View File

@ -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

43
models
View File

@ -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

23
src/Handler/Course.hs
View File

@ -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

2
src/Handler/Sheet.hs
View File

@ -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

7
src/Handler/Submission.hs
View File

@ -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
}

13
src/Handler/Utils/Submission.hs
View File

@ -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 ()