From e98cf70400a6afd3677e7125919cff13b4edaaa0 Mon Sep 17 00:00:00 2001 From: SJost Date: Thu, 26 Apr 2018 11:29:42 +0200 Subject: [PATCH] MODEL REFACTOR: dropped ID suffixes throughout --- fill-db.hs | 24 +++---- models | 111 +++++++++++++++--------------- src/Foundation.hs | 7 +- src/Handler/Course.hs | 28 ++++---- src/Handler/CryptoIDDispatch.hs | 6 +- src/Handler/Sheet.hs | 34 ++++----- src/Handler/Submission.hs | 70 +++++++++---------- src/Handler/Term.hs | 2 +- src/Handler/Utils/Rating.hs | 4 +- src/Handler/Utils/Sheet.hs | 6 +- src/Handler/Utils/Submission.hs | 24 +++---- templates/widgets/asidenav.hamlet | 2 +- 12 files changed, 161 insertions(+), 157 deletions(-) diff --git a/fill-db.hs b/fill-db.hs index 205d4afd5..4802b75e1 100755 --- a/fill-db.hs +++ b/fill-db.hs @@ -89,8 +89,8 @@ main = db $ do , courseDescription = Nothing , courseLinkExternal = Nothing , courseShorthand = "ffp" - , courseTermId = TermKey summer2018 - , courseSchoolId = ifi + , courseTerm = TermKey summer2018 + , courseSchool = ifi , courseCapacity = Just 20 , courseHasRegistration = True , courseRegisterFrom = Just now @@ -117,8 +117,8 @@ main = db $ do , courseDescription = Nothing , courseLinkExternal = Nothing , courseShorthand = "eip" - , courseTermId = TermKey summer2017 - , courseSchoolId = ifi + , courseTerm = TermKey summer2017 + , courseSchool = ifi , courseCapacity = Just 20 , courseHasRegistration = False , courseRegisterFrom = Nothing @@ -136,8 +136,8 @@ main = db $ do , courseDescription = Nothing , courseLinkExternal = Nothing , courseShorthand = "ixd" - , courseTermId = TermKey summer2018 - , courseSchoolId = ifi + , courseTerm = TermKey summer2018 + , courseSchool = ifi , courseCapacity = Just 20 , courseHasRegistration = True , courseRegisterFrom = Just now @@ -155,8 +155,8 @@ main = db $ do , courseDescription = Nothing , courseLinkExternal = Nothing , courseShorthand = "ux3" - , courseTermId = TermKey winter2017 - , courseSchoolId = ifi + , courseTerm = TermKey winter2017 + , courseSchool = ifi , courseCapacity = Just 30 , courseHasRegistration = False , courseRegisterFrom = Nothing @@ -174,8 +174,8 @@ main = db $ do , courseDescription = Nothing , courseLinkExternal = Nothing , courseShorthand = "pmo" - , courseTermId = TermKey summer2017 - , courseSchoolId = ifi + , courseTerm = TermKey summer2017 + , courseSchool = ifi , courseCapacity = Just 50 , courseHasRegistration = False , courseRegisterFrom = Nothing @@ -193,8 +193,8 @@ main = db $ do , courseDescription = Nothing , courseLinkExternal = Nothing , courseShorthand = "dbs" - , courseTermId = TermKey summer2018 - , courseSchoolId = ifi + , courseTerm = TermKey summer2018 + , courseSchool = ifi , courseCapacity = Just 50 , courseHasRegistration = False , courseRegisterFrom = Nothing diff --git a/models b/models index 3e0c09966..ae1518f40 100644 --- a/models +++ b/models @@ -1,10 +1,10 @@ User - plugin Text - ident Text + plugin Text + ident Text matrikelnummer Text Maybe - email Text - displayName Text - maxFavourites Int default=12 + email Text + displayName Text + maxFavourites Int default=12 UniqueAuthentication plugin ident UniqueEmail email UserAdmin @@ -52,20 +52,20 @@ DegreeCourse json terms StudyTermsId UniqueDegreeCourse course degree terms Course - name Text - description Html Maybe - linkExternal Text Maybe - shorthand Text - termId TermId - schoolId SchoolId - capacity Int Maybe + name Text + description Html Maybe + linkExternal Text Maybe + shorthand Text + term TermId + school SchoolId + capacity Int Maybe hasRegistration Bool -- canRegisterNow = hasRegistration && maybe False (<= currentTime) registerFrom && maybe True (>= currentTime) registerTo registerFrom UTCTime Maybe registerTo UTCTime Maybe deregisterUntil UTCTime Maybe registerSecret Text Maybe -- Falls ein Passwort erforderlich ist materialFree Bool default=true - CourseTermShort termId shorthand + CourseTermShort term shorthand CourseEdit user UserId time UTCTime @@ -76,29 +76,28 @@ CourseFavourite course CourseId UniqueCourseFavourite user course Lecturer - userId UserId - courseId CourseId - UniqueLecturer userId courseId + user UserId + course CourseId + UniqueLecturer user course Corrector - userId UserId - courseId CourseId + user UserId + course CourseId load Load -- SELECT submissionID FROM Tutorial, TutorialUser, Submission, Sheet -- WHERE ( tutorialTutor = correctorUserId -- && tutorialCourse = correctorCourseId -- && tutorialUserTutorial = tutorialId -- && submissionUser = tutorialUserUser - -- && sheetId = submissionSheetId + -- && sheetId = SubmissionSheet -- && sheetCourse = correctorCourseId -- ) - UniqueCorrector userId courseId CourseParticipant - courseId CourseId - userId UserId + course CourseId + user UserId registration UTCTime - UniqueParticipant userId courseId + UniqueParticipant user course Sheet - courseId CourseId + course CourseId name Text description Html Maybe type SheetType @@ -109,23 +108,27 @@ Sheet activeTo UTCTime hintFrom UTCTime Maybe solutionFrom UTCTime Maybe - CourseSheet courseId name + CourseSheet course name SheetEdit user UserId time UTCTime sheet SheetId +SheetCorrector + user UserId + sheet CourseId + load Load SheetFile - sheetId SheetId - fileId FileId + sheet SheetId + file FileId type SheetFileType - UniqueSheetFile fileId sheetId type + UniqueSheetFile file sheet type File title FilePath content ByteString Maybe -- Nothing iff this is a directory modified UTCTime deriving Show Eq Submission - sheetId SheetId + sheet SheetId ratingPoints Points Maybe ratingComment Text Maybe ratingBy UserId Maybe @@ -136,37 +139,37 @@ SubmissionEdit time UTCTime submission SubmissionId SubmissionFile - submissionId SubmissionId - fileId FileId + submission SubmissionId + file FileId isUpdate Bool isDeletion Bool - UniqueSubmissionFile fileId submissionId isUpdate + UniqueSubmissionFile file submission isUpdate deriving Show SubmissionUser - userId UserId - submissionId SubmissionId - UniqueSubmissionUser userId submissionId + user UserId + submission SubmissionId + UniqueSubmissionUser user submission SubmissionGroup - courseId CourseId + course CourseId name Text Maybe SubmissionGroupEdit user UserId time UTCTime submissionGroup SubmissionGroupId SubmissionGroupUser - submissionGroupId SubmissionGroupId - userId UserId - UniqueSubmissionGroupUser submissionGroupId userId + submissionGroup SubmissionGroupId + user UserId + UniqueSubmissionGroupUser submissionGroup user Tutorial json name Text - tutor UserId + tutor UserId course CourseId TutorialUser - userId UserId - tutorialId TutorialId - UniqueTutorialUser userId tutorialId + user UserId + tutorial TutorialId + UniqueTutorialUser user tutorial Booking - termId TermId + term TermId begin UTCTime end UTCTime weekly Bool @@ -183,17 +186,17 @@ Room building Text Maybe -- BookingRoom -- subject RoomForId --- roomId RoomId --- bookingId BookingId --- UniqueRoomCourse subject roomId bookingId +-- room RoomId +-- booking BookingId +-- UniqueRoomCourse subject room booking +RoomFor - courseId CourseId - tutorialId TutorialId - examId ExamId --- data RoomFor = RoomForCourseIdSum CourseId | RoomForTutorialIdSum TutorialId ... + course CourseId + tutorial TutorialId + exam ExamId +-- data RoomFor = RoomForCourseSum CourseId | RoomForTutorialSum TutorialId ... -- EXAMS ARE TODO: Exam - courseId CourseId + course CourseId name Text description Text begin UTCTime @@ -208,8 +211,8 @@ Exam -- time UTCTime -- exam ExamId --ExamUser --- userId UserId +-- user UserId -- examId ExamId -- -- CONTINUE HERE: Include rating in this table or separately? --- UniqueExamUser userId examId +-- UniqueExamUser user examId -- By default this file is used in Model.hs (which is imported by Foundation.hs) diff --git a/src/Foundation.hs b/src/Foundation.hs index ac6f25b6c..514f152bf 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -274,7 +274,7 @@ submissionAccess cID = do authId <- lift requireAuthId submissionId <- either decrypt decrypt cID Submission{..} <- get404 submissionId - submissionUsers <- map (submissionUserUserId . entityVal) <$> selectList [SubmissionUserSubmissionId ==. submissionId] [] + submissionUsers <- map (submissionUserUser . entityVal) <$> selectList [SubmissionUserSubmission ==. submissionId] [] let auth = authId `elem` submissionUsers || Just authId == submissionRatingBy return $ case auth of True -> Authorized @@ -304,8 +304,9 @@ lecturerAccess' = authorizedFor UniqueSchoolLecturer MsgUnauthorizedSchoolLectur courseLecturerAccess :: CourseId -> YesodDB UniWorX AuthResult courseLecturerAccess = authorizedFor UniqueLecturer MsgUnauthorizedLecturer -courseCorrectorAccess :: CourseId -> YesodDB UniWorX AuthResult -courseCorrectorAccess = authorizedFor UniqueCorrector MsgUnauthorizedCorrector +--courseCorrectorAccess :: CourseId -> YesodDB UniWorX AuthResult +--courseCorrectorAccess = authorizedFor UniqueCorrector MsgUnauthorizedCorrector +-- TODO: Correctors are no longer unit, could be ByTutorial and also by ByProportion courseParticipantAccess :: CourseId -> YesodDB UniWorX AuthResult courseParticipantAccess = authorizedFor UniqueParticipant MsgUnauthorizedParticipant diff --git a/src/Handler/Course.hs b/src/Handler/Course.hs index 1945f323a..b8edfee9a 100644 --- a/src/Handler/Course.hs +++ b/src/Handler/Course.hs @@ -30,7 +30,7 @@ getCourseListTermR :: TermId -> Handler Html getCourseListTermR tidini = do (term,courses) <- runDB $ (,) <$> get tidini - <*> selectList [CourseTermId ==. tidini] [Asc CourseShorthand] + <*> selectList [CourseTerm ==. tidini] [Asc CourseShorthand] when (isNothing term) $ do addMessage "warning" [shamlet| Semester #{toPathPiece tidini} nicht gefunden. |] redirect TermShowR @@ -39,20 +39,20 @@ getCourseListTermR tidini = do [ headed "Kürzel" $ (\ckv -> let c = entityVal ckv shd = courseShorthand c - tid = courseTermId c + tid = courseTerm c in [whamlet| #{shd} |] ) -- , headed "Institut" $ [shamlet| #{course} |] , headed "Beginn Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterFrom.entityVal , headed "Ende Anmeldung" $ fromString.(maybe "" formatTimeGerWD).courseRegisterTo.entityVal , headed "Teilnehmer" $ (\ckv -> do let cid = entityKey ckv - partiNum <- handlerToWidget $ runDB $ count [CourseParticipantCourseId ==. cid] + partiNum <- handlerToWidget $ runDB $ count [CourseParticipantCourse ==. cid] [whamlet| #{show partiNum} |] ) , headed " " $ (\ckv -> let c = entityVal ckv shd = courseShorthand c - tid = courseTermId c + tid = courseTerm c in do adminLink <- handlerToWidget $ isAuthorized (CourseR tid shd CourseEditR) False -- if (adminLink==Authorized) then linkButton "Ändern" BCWarning (CourseEditR tid shd) else "" @@ -82,8 +82,8 @@ getCourseShowR tid csh = do (courseEnt,(schoolMB,participants,mbRegistered)) <- runDB $ do courseEnt@(Entity cid course) <- getBy404 $ CourseTermShort tid csh dependent <- (,,) - <$> get (courseSchoolId course) -- join - <*> count [CourseParticipantCourseId ==. cid] -- join + <$> get (courseSchool course) -- join + <*> count [CourseParticipantCourse ==. cid] -- join <*> (case mbAid of -- TODO: Someone please refactor this late-night mess here! Nothing -> return False (Just aid) -> do @@ -183,8 +183,8 @@ courseEditHandler course = do , courseDescription = cfDesc res , courseLinkExternal = cfLink res , courseShorthand = cfShort res - , courseTermId = cfTerm res - , courseSchoolId = cfSchool res + , courseTerm = cfTerm res + , courseSchool = cfSchool res , courseCapacity = cfCapacity res , courseHasRegistration = cfHasReg res , courseRegisterFrom = cfRegFrom res @@ -226,8 +226,8 @@ courseEditHandler course = do -- , CourseDescription =. cfDesc res -- , CourseLinkExternal =. cfLink res -- , CourseShorthand =. cfShort res -- TODO: change here should generate a warning, or only allowed for Admins?! --- , CourseTermId =. tid -- TODO: change here should generate a warning, or only allowed for Admins?! --- , CourseSchoolId =. cfSchool res +-- , CourseTerm =. tid -- TODO: change here should generate a warning, or only allowed for Admins?! +-- , CourseSchool =. cfSchool res -- , CourseCapacity =. cfCapacity res -- , CourseRegisterFrom =. cfRegFrom res -- , CourseRegisterTo =. cfRegTo res @@ -239,8 +239,8 @@ courseEditHandler course = do , courseDescription = cfDesc res , courseLinkExternal = cfLink res , courseShorthand = cfShort res - , courseTermId = cfTerm res - , courseSchoolId = cfSchool res + , courseTerm = cfTerm res + , courseSchool = cfSchool res , courseCapacity = cfCapacity res , courseHasRegistration = cfHasReg res , courseRegisterFrom = cfRegFrom res @@ -291,8 +291,8 @@ courseToForm cEntity = CourseForm , cfDesc = courseDescription course , cfLink = courseLinkExternal course , cfShort = courseShorthand course - , cfTerm = courseTermId course - , cfSchool = courseSchoolId course + , cfTerm = courseTerm course + , cfSchool = courseSchool course , cfCapacity = courseCapacity course , cfHasReg = courseHasRegistration course , cfRegFrom = courseRegisterFrom course diff --git a/src/Handler/CryptoIDDispatch.hs b/src/Handler/CryptoIDDispatch.hs index c604d3e45..f5a77cdbd 100644 --- a/src/Handler/CryptoIDDispatch.hs +++ b/src/Handler/CryptoIDDispatch.hs @@ -34,10 +34,10 @@ instance CryptoRoute UUID SubmissionId where cryptoIDRoute _ (CryptoID -> cID) = do (smid :: SubmissionId) <- decrypt cID (tid,csh,shn) <- runDB $ do - shid <- submissionSheetId <$> get404 smid + shid <- submissionSheet <$> get404 smid Sheet{..} <- get404 shid - Course{..} <- get404 sheetCourseId - return (courseTermId, courseShorthand, sheetName) + Course{..} <- get404 sheetCourse + return (courseTerm, courseShorthand, sheetName) return $ CourseR tid csh $ SheetR $ SubmissionR shn $ SubmissionMode $ Just cID diff --git a/src/Handler/Sheet.hs b/src/Handler/Sheet.hs index 455662401..d0da62b13 100644 --- a/src/Handler/Sheet.hs +++ b/src/Handler/Sheet.hs @@ -68,8 +68,8 @@ makeSheetForm :: Maybe SheetId -> Maybe SheetForm -> Form SheetForm makeSheetForm msId template = identForm FIDsheet $ \html -> do let oldFileIds fType | Just sId <- msId = fmap setFromList . fmap (map E.unValue) . runDB . E.select . E.from $ \(file `E.InnerJoin` sheetFile) -> do - E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFileId - E.where_ $ sheetFile E.^. SheetFileSheetId E.==. E.val sId + E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFile + E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val sId E.&&. sheetFile E.^. SheetFileType E.==. E.val fType return (file E.^. FileId) | otherwise = return Set.empty @@ -135,11 +135,11 @@ getSheetList courseEnt = do let cid = entityKey courseEnt let course = entityVal courseEnt let csh = courseShorthand course - let tid = courseTermId course + let tid = courseTerm course sheets <- runDB $ do - rawSheets <- selectList [SheetCourseId ==. cid] [Desc SheetActiveFrom] + rawSheets <- selectList [SheetCourse ==. cid] [Desc SheetActiveFrom] forM rawSheets $ \(Entity sid sheet) -> do - let sheetsub = [SubmissionSheetId ==. sid] + let sheetsub = [SubmissionSheet ==. sid] submissions <- count sheetsub rated <- count $ (SubmissionRatingTime !=. Nothing):sheetsub return (sid, sheet, (submissions, rated)) @@ -188,8 +188,8 @@ getSheetShowR tid csh shn = do fileNameTypes <- runDB $ E.select $ E.from $ \(sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> do -- Restrict to consistent rows that correspond to each other - E.on (file E.^. FileId E.==. sheetFile E.^. SheetFileFileId) - E.on (sheetFile E.^. SheetFileSheetId E.==. sheet E.^. SheetId) + E.on (file E.^. FileId E.==. sheetFile E.^. SheetFileFile) + E.on (sheetFile E.^. SheetFileSheet E.==. sheet E.^. SheetId) -- filter to requested file E.where_ (sheet E.^. SheetId E.==. E.val sid ) -- return desired columns @@ -214,15 +214,15 @@ getSheetFileR tid csh shn typ title = do content <- runDB $ E.select $ E.from $ \(course `E.InnerJoin` sheet `E.InnerJoin` sheetFile `E.InnerJoin` file) -> do -- Restrict to consistent rows that correspond to each other - E.on (file E.^. FileId E.==. sheetFile E.^. SheetFileFileId) - E.on (sheetFile E.^. SheetFileSheetId E.==. sheet E.^. SheetId) - E.on (sheet E.^. SheetCourseId E.==. course E.^. CourseId) + E.on (file E.^. FileId E.==. sheetFile E.^. SheetFileFile) + E.on (sheetFile E.^. SheetFileSheet E.==. sheet E.^. SheetId) + E.on (sheet E.^. SheetCourse E.==. course E.^. CourseId) -- filter to requested file E.where_ ((file E.^. FileTitle E.==. E.val title) E.&&. (sheetFile E.^. SheetFileType E.==. E.val typ ) E.&&. (sheet E.^. SheetName E.==. E.val shn ) E.&&. (course E.^. CourseShorthand E.==. E.val csh ) - E.&&. (course E.^. CourseTermId E.==. E.val tid ) + E.&&. (course E.^. CourseTerm E.==. E.val tid ) ) -- return desired columns return $ file E.^. FileContent @@ -251,8 +251,8 @@ getSheetEditR tid csh shn = do (sheetEnt, sheetFileIds) <- runDB $ do ent <- fetchSheet tid csh shn fIds <- fmap setFromList . fmap (map E.unValue) . E.select . E.from $ \(file `E.InnerJoin` sheetFile) -> do - E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFileId - E.where_ $ sheetFile E.^. SheetFileSheetId E.==. E.val (entityKey ent) + E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFile + E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val (entityKey ent) E.&&. sheetFile E.^. SheetFileType E.==. E.val SheetExercise return (file E.^. FileId) return (ent, fIds) @@ -295,7 +295,7 @@ handleSheetEdit tid csh msId template dbAction = do actTime <- liftIO getCurrentTime cid <- getKeyBy404 $ CourseTermShort tid csh let newSheet = Sheet - { sheetCourseId = cid + { sheetCourse = cid , sheetName = sfName , sheetDescription = sfDescription , sheetType = sfType @@ -345,7 +345,7 @@ getSheetDelR tid csh shn = do _other -> do submissionno <- runDB $ do sid <- fetchSheetId tid csh shn - count [SubmissionSheetId ==. sid] + count [SubmissionSheet ==. sid] let formTitle = MsgSheetDelTitle tident csh shn let formText = Just $ MsgSheetDelText submissionno let actionUrl = CSheetR tid csh $ SheetDelR shn @@ -369,8 +369,8 @@ insertSheetFile sid ftype finfo = do insertSheetFile' :: SheetId -> SheetFileType -> Source Handler (Either FileId File) -> YesodDB UniWorX () insertSheetFile' sid ftype fs = do oldFileIds <- fmap setFromList . fmap (map E.unValue) . E.select . E.from $ \(file `E.InnerJoin` sheetFile) -> do - E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFileId - E.where_ $ sheetFile E.^. SheetFileSheetId E.==. E.val sid + E.on $ file E.^. FileId E.==. sheetFile E.^. SheetFileFile + E.where_ $ sheetFile E.^. SheetFileSheet E.==. E.val sid E.&&. sheetFile E.^. SheetFileType E.==. E.val ftype return (file E.^. FileId) keep <- execWriterT . runConduit $ transPipe (lift . lift) fs =$= C.mapM_ finsert diff --git a/src/Handler/Submission.hs b/src/Handler/Submission.hs index ac25a999f..0a78a8458 100644 --- a/src/Handler/Submission.hs +++ b/src/Handler/Submission.hs @@ -80,27 +80,27 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do case msmid of Nothing -> do submissions <- E.select . E.from $ \(submission `E.InnerJoin` submissionUser) -> do - E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmissionId) - E.where_ $ submissionUser E.^. SubmissionUserUserId E.==. E.val uid - E.&&. submission E.^. SubmissionSheetId E.==. E.val shid + E.on (submission E.^. SubmissionId E.==. submissionUser E.^. SubmissionUserSubmission) + E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid + E.&&. submission E.^. SubmissionSheet E.==. E.val shid return $ submission E.^. SubmissionId -- $logDebugS "Submission.DUPLICATENEW" (tshow submissions) case submissions of [] -> do -- fetch buddies from previous submission in this course buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do - E.on (submissionUser E.^. SubmissionUserUserId E.==. user E.^. UserId) + E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId) let oldids = E.subList_select . E.from $ \(sheet `E.InnerJoin` submission `E.InnerJoin` submissionUser `E.InnerJoin` submissionEdit) -> do E.on (submissionEdit E.^. SubmissionEditSubmission E.==. submission E.^. SubmissionId) - E.on (submissionUser E.^. SubmissionUserSubmissionId E.==. submission E.^. SubmissionId) - E.on (sheet E.^. SheetId E.==. submission E.^. SubmissionSheetId) - E.where_ $ submissionUser E.^. SubmissionUserUserId E.==. E.val uid - E.&&. sheet E.^. SheetCourseId E.==. E.val sheetCourseId + E.on (submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId) + E.on (sheet E.^. SheetId E.==. submission E.^. SubmissionSheet) + E.where_ $ submissionUser E.^. SubmissionUserUser E.==. E.val uid + E.&&. sheet E.^. SheetCourse E.==. E.val sheetCourse E.orderBy [E.desc $ submissionEdit E.^. SubmissionEditTime] E.limit 1 return $ submission E.^. SubmissionId - E.where_ $ submissionUser E.^. SubmissionUserSubmissionId `E.in_` oldids - E.&&. submissionUser E.^. SubmissionUserUserId E.!=. E.val uid + E.where_ $ submissionUser E.^. SubmissionUserSubmission `E.in_` oldids + E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid E.orderBy [E.asc $ user E.^. UserEmail] return $ user E.^. UserEmail return (sheet,buddies,[],[]) @@ -109,13 +109,13 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do addMessageI "info" $ MsgSubmissionAlreadyExists redirect $ CourseR tid csh $ SheetR $ SubmissionR shn $ SubmissionMode $ Just cID (Just smid) -> do - shid' <- submissionSheetId <$> get404 smid + shid' <- submissionSheet <$> get404 smid when (shid /= shid') $ invalidArgsI [MsgSubmissionWrongSheet] -- fetch buddies from current submission buddies <- E.select . E.from $ \(submissionUser `E.InnerJoin` user) -> do - E.on (submissionUser E.^. SubmissionUserUserId E.==. user E.^. UserId) - E.where_ $ submissionUser E.^. SubmissionUserSubmissionId E.==. E.val smid - E.&&. submissionUser E.^. SubmissionUserUserId E.!=. E.val uid + E.on (submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId) + E.where_ $ submissionUser E.^. SubmissionUserSubmission E.==. E.val smid + E.&&. submissionUser E.^. SubmissionUserUser E.!=. E.val uid E.orderBy [E.asc $ user E.^. UserEmail] return $ user E.^. UserEmail oldfiles <- sourceToList $ submissionFileSource smid @@ -145,13 +145,13 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do E.where_ $ (E.lower_ $ user E.^. UserEmail) `E.in_` E.valList gemails let isParticipant = E.sub_select . E.from $ \courseParticipant -> do - E.where_ $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUserId - E.&&. courseParticipant E.^. CourseParticipantCourseId E.==. E.val sheetCourseId + E.where_ $ user E.^. UserId E.==. courseParticipant E.^. CourseParticipantUser + E.&&. courseParticipant E.^. CourseParticipantCourse E.==. E.val sheetCourse return $ E.countRows E.>. E.val (0 :: Int64) hasSubmitted = E.sub_select . E.from $ \(submissionUser `E.InnerJoin` submission) -> do - E.on $ submissionUser E.^. SubmissionUserSubmissionId E.==. submission E.^. SubmissionId - E.where_ $ submissionUser E.^. SubmissionUserUserId E.==. user E.^. UserId - E.&&. submission E.^. SubmissionSheetId E.==. E.val shid + E.on $ submissionUser E.^. SubmissionUserSubmission E.==. submission E.^. SubmissionId + E.where_ $ submissionUser E.^. SubmissionUserUser E.==. user E.^. UserId + E.&&. submission E.^. SubmissionSheet E.==. E.val shid return $ E.countRows E.>. E.val (0 :: Int64) return (user E.^. UserEmail, (user E.^. UserId, isParticipant, hasSubmitted)) $logDebugS "SUBMISSION.AdHocGroupValidation" $ tshow participants @@ -180,11 +180,11 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do -- Determine members of pre-registered group groupUids <- fmap (setFromList . map E.unValue) . E.select . E.from $ \(submissionGroupUser `E.InnerJoin` submissionGroup `E.InnerJoin` submissionGroupUser') -> do - E.on $ submissionGroup E.^. SubmissionGroupId E.==. submissionGroupUser' E.^. SubmissionGroupUserSubmissionGroupId - E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroupId E.==. submissionGroup E.^. SubmissionGroupId - E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUserId E.==. E.val uid - E.&&. submissionGroup E.^. SubmissionGroupCourseId E.==. E.val sheetCourseId - return $ submissionGroupUser' E.^. SubmissionGroupUserUserId + E.on $ submissionGroup E.^. SubmissionGroupId E.==. submissionGroupUser' E.^. SubmissionGroupUserSubmissionGroup + E.on $ submissionGroupUser E.^. SubmissionGroupUserSubmissionGroup E.==. submissionGroup E.^. SubmissionGroupId + E.where_ $ submissionGroupUser E.^. SubmissionGroupUserUser E.==. E.val uid + E.&&. submissionGroup E.^. SubmissionGroupCourse E.==. E.val sheetCourse + return $ submissionGroupUser' E.^. SubmissionGroupUserUser -- SubmissionUser for all group members (pre-registered & ad-hoc) forM_ (groupUids `Set.union` adhocIds) $ \uid' -> void . insertUnique $ SubmissionUser uid' smid @@ -229,8 +229,8 @@ postSubmissionR tid csh shn (SubmissionMode mcid) = do submissionFileSource :: SubmissionId -> Source (YesodDB UniWorX) (Entity File) submissionFileSource submissionID = E.selectSource . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do - E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFileId) - E.where_ $ sf E.^. SubmissionFileSubmissionId E.==. E.val submissionID + E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFile) + E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionID E.where_ . E.not_ $ sf E.^. SubmissionFileIsDeletion E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate] return f @@ -248,8 +248,8 @@ getSubmissionDownloadSingleR cID path = do maybe notFound (return . toTypedContent . Text.decodeUtf8) $ fileContent =<< file False -> do results <- E.select . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do - E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFileId) - E.where_ (sf E.^. SubmissionFileSubmissionId E.==. E.val submissionID) + E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFile) + E.where_ (sf E.^. SubmissionFileSubmission E.==. E.val submissionID) E.where_ (f E.^. FileTitle E.==. E.val path) E.where_ . E.not_ . E.isNothing $ f E.^. FileContent E.where_ . E.not_ $ sf E.^. SubmissionFileIsDeletion @@ -288,8 +288,8 @@ getSubmissionDownloadArchiveR (ZIPArchiveName cID) = do submissionTable :: MForm Handler (FormResult [SubmissionId], Widget) submissionTable = do subs <- lift . runDB $ E.select . E.from $ \(sub `E.InnerJoin` sheet `E.InnerJoin` course) -> do - E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourseId - E.on $ sheet E.^. SheetId E.==. sub E.^. SubmissionSheetId + E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse + E.on $ sheet E.^. SheetId E.==. sub E.^. SubmissionSheet return (sub, sheet, course) @@ -297,7 +297,7 @@ submissionTable = do (,,) <$> encrypt submissionId <*> encrypt submissionId <*> pure s let - anchorCourse (_, _, (_, _, Entity _ Course{..})) = CourseR courseTermId courseShorthand CourseShowR + anchorCourse (_, _, (_, _, Entity _ Course{..})) = CourseR courseTerm courseShorthand CourseShowR courseText (_, _, (_, _, Entity _ Course{..})) = toWidget courseName anchorSubmission (_, cUUID, _) = SubmissionDemoR cUUID submissionText (cID, _, _) = toWidget . toPathPiece . CI.foldedCase $ ciphertext cID @@ -334,7 +334,7 @@ postSubmissionListR = do Just sink -> return sink Nothing -> do Submission{..} <- lift $ get404 sId - return . newResumableSink $ sinkSubmission submissionSheetId userId (Just (sId, isUpdate)) + return . newResumableSink $ sinkSubmission submissionSheet userId (Just (sId, isUpdate)) sink' <- lift $ yield val ++$$ sink case sink' of Left _ -> error "sinkSubmission returned prematurely" @@ -434,12 +434,12 @@ postSubmissionDemoR cID = do yieldM $ do fileContent <- Just <$> runConduit (fileSource fInfo =$= foldC) return File{..} - submissionId' <- runConduit $ source =$= extractRatings =$= sinkSubmission submissionSheetId userId (Just (submissionId, isUpdate)) + submissionId' <- runConduit $ source =$= extractRatings =$= sinkSubmission submissionSheet userId (Just (submissionId, isUpdate)) get404 submissionId' files <- E.select . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do - E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFileId) - E.where_ (sf E.^. SubmissionFileSubmissionId E.==. E.val submissionId) + E.on (f E.^. FileId E.==. sf E.^. SubmissionFileFile) + E.where_ (sf E.^. SubmissionFileSubmission E.==. E.val submissionId) E.orderBy [E.desc $ sf E.^. SubmissionFileIsUpdate] return (f, sf) return (submission, files) diff --git a/src/Handler/Term.hs b/src/Handler/Term.hs index 46f464cc1..59c9e0909 100644 --- a/src/Handler/Term.hs +++ b/src/Handler/Term.hs @@ -35,7 +35,7 @@ getTermShowR = do -- E.orderBy [E.desc $ term E.^. TermStart ] let courseCount :: E.SqlExpr (E.Value Int) courseCount = E.sub_select . E.from $ \course -> do - E.where_ $ term E.^. TermId E.==. course E.^. CourseTermId + E.where_ $ term E.^. TermId E.==. course E.^. CourseTerm return E.countRows return (term, courseCount) selectRep $ do diff --git a/src/Handler/Utils/Rating.hs b/src/Handler/Utils/Rating.hs index e90c9501c..fe4c4b014 100644 --- a/src/Handler/Utils/Rating.hs +++ b/src/Handler/Utils/Rating.hs @@ -90,8 +90,8 @@ instance Exception RatingException getRating :: SubmissionId -> YesodDB UniWorX (Maybe Rating) getRating submissionId = runMaybeT $ do let query = E.select . E.from $ \(submission `E.InnerJoin` sheet `E.InnerJoin` course) -> do - E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourseId - E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheetId + E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse + E.on $ sheet E.^. SheetId E.==. submission E.^. SubmissionSheet E.where_ $ submission E.^. SubmissionId E.==. E.val submissionId diff --git a/src/Handler/Utils/Sheet.hs b/src/Handler/Utils/Sheet.hs index 24db7ae1a..76fed4737 100644 --- a/src/Handler/Utils/Sheet.hs +++ b/src/Handler/Utils/Sheet.hs @@ -33,8 +33,8 @@ fetchSheetAux prj tid csh shn = -- getBy404 $ CourseSheet cid shn -- Mit Esqueleto: sheetList <- E.select . E.from $ \(course `E.InnerJoin` sheet) -> do - E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourseId - E.where_ $ course E.^. CourseTermId E.==. E.val tid + E.on $ course E.^. CourseId E.==. sheet E.^. SheetCourse + E.where_ $ course E.^. CourseTerm E.==. E.val tid E.&&. course E.^. CourseShorthand E.==. E.val csh E.&&. sheet E.^. SheetName E.==. E.val shn return $ prj sheet @@ -49,4 +49,4 @@ fetchSheetId :: TermId -> Text -> Text -> YesodDB UniWorX (Key Sheet) fetchSheetId tid cid shn = E.unValue <$> fetchSheetAux (E.^. SheetId) tid cid shn fetchSheetIdCourseId :: TermId -> Text -> Text -> YesodDB UniWorX (Key Sheet, Key Course) -fetchSheetIdCourseId tid cid shn = bimap E.unValue E.unValue <$> fetchSheetAux ((,) <$> (E.^. SheetId) <*> (E.^. SheetCourseId)) tid cid shn +fetchSheetIdCourseId tid cid shn = bimap E.unValue E.unValue <$> fetchSheetAux ((,) <$> (E.^. SheetId) <*> (E.^. SheetCourse)) tid cid shn diff --git a/src/Handler/Utils/Submission.hs b/src/Handler/Utils/Submission.hs index 6a100ab98..9b71290a3 100644 --- a/src/Handler/Utils/Submission.hs +++ b/src/Handler/Utils/Submission.hs @@ -65,7 +65,7 @@ sinkSubmission :: SheetId sinkSubmission sheetId userId mExists = do now <- liftIO getCurrentTime let - submissionSheetId = sheetId + submissionSheet = sheetId submissionRatingPoints = Nothing submissionRatingComment = Nothing submissionRatingBy = Nothing @@ -90,8 +90,8 @@ sinkSubmission sheetId userId mExists = do tell $ mempty{ sinkFilenames = Set.singleton fileTitle } otherVersions <- lift . E.select . E.from $ \(sf `E.InnerJoin` f) -> do - E.on $ sf E.^. SubmissionFileFileId E.==. f E.^. FileId - E.where_ $ sf E.^. SubmissionFileSubmissionId E.==. E.val submissionId + E.on $ sf E.^. SubmissionFileFile E.==. f E.^. FileId + E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionId -- E.where_ $ sf E.^. SubmissionFileIsUpdate E.==. E.val isUpdate E.where_ $ f E.^. FileTitle E.==. E.val fileTitle -- 'Zip.hs' normalises filenames already, so this should work return (f, sf) @@ -121,8 +121,8 @@ sinkSubmission sheetId userId mExists = do _ -> do fileId <- insert file insert_ $ SubmissionFile - { submissionFileSubmissionId = submissionId - , submissionFileFileId = fileId + { submissionFileSubmission = submissionId + , submissionFileFile = fileId , submissionFileIsUpdate = isUpdate , submissionFileIsDeletion = False } @@ -189,8 +189,8 @@ sinkSubmission sheetId userId mExists = do finalize :: SubmissionSinkState -> YesodDB UniWorX () finalize SubmissionSinkState{..} = do missingFiles <- E.select . E.from $ \(sf `E.InnerJoin` f) -> E.distinctOnOrderBy [E.asc $ f E.^. FileTitle] $ do - E.on $ sf E.^. SubmissionFileFileId E.==. f E.^. FileId - E.where_ $ sf E.^. SubmissionFileSubmissionId E.==. E.val submissionId + E.on $ sf E.^. SubmissionFileFile E.==. f E.^. FileId + E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionId when (not isUpdate) $ E.where_ $ sf E.^. SubmissionFileIsUpdate E.==. E.val isUpdate E.where_ $ f E.^. FileTitle `E.notIn` E.valList (Set.toList sinkFilenames) @@ -202,8 +202,8 @@ sinkSubmission sheetId userId mExists = do False -> deleteCascadeWhere [ FileId <-. [ fileId | (Entity fileId _, _) <- missingFiles ] ] True -> forM_ missingFiles $ \(Entity fileId File{..}, Entity sfId SubmissionFile{..}) -> do shadowing <- E.select . E.from $ \(sf `E.InnerJoin` f) -> do - E.on $ sf E.^. SubmissionFileFileId E.==. f E.^. FileId - E.where_ $ sf E.^. SubmissionFileSubmissionId E.==. E.val submissionId + E.on $ sf E.^. SubmissionFileFile E.==. f E.^. FileId + E.where_ $ sf E.^. SubmissionFileSubmission E.==. E.val submissionId E.where_ $ sf E.^. SubmissionFileIsUpdate E.==. E.val (not isUpdate) E.where_ $ f E.^. FileTitle E.==. E.val fileTitle return $ f E.^. FileId @@ -212,13 +212,13 @@ sinkSubmission sheetId userId mExists = do ([], _) -> deleteCascade fileId (E.Value f:_, False) -> do insert_ $ SubmissionFile - { submissionFileSubmissionId = submissionId - , submissionFileFileId = f + { submissionFileSubmission = submissionId + , submissionFileFile = f , submissionFileIsUpdate = True , submissionFileIsDeletion = True } (E.Value f:_, True) -> do - update sfId [ SubmissionFileFileId =. f, SubmissionFileIsDeletion =. True ] + update sfId [ SubmissionFileFile =. f, SubmissionFileIsDeletion =. True ] deleteCascade fileId when (isUpdate && not (getAny sinkSeenRating)) $ diff --git a/templates/widgets/asidenav.hamlet b/templates/widgets/asidenav.hamlet index b19ab9d4f..29a3f1617 100644 --- a/templates/widgets/asidenav.hamlet +++ b/templates/widgets/asidenav.hamlet @@ -18,7 +18,7 @@ $newline never WiSe 17/18