From 3c4172cbc2abb8b692241cc7fe73b62384c92a94 Mon Sep 17 00:00:00 2001 From: Steffen Jost Date: Tue, 20 Aug 2019 14:10:09 +0200 Subject: [PATCH] fix(exam import): inactive registered features may be selected --- src/Handler/Exam/Users.hs | 31 ++++++++++++++++++------------- stack.yaml.lock | 12 ++++++------ 2 files changed, 24 insertions(+), 19 deletions(-) diff --git a/src/Handler/Exam/Users.hs b/src/Handler/Exam/Users.hs index 35a8842a4..42ec778b0 100644 --- a/src/Handler/Exam/Users.hs +++ b/src/Handler/Exam/Users.hs @@ -16,18 +16,18 @@ import Handler.Utils.Csv import qualified Database.Esqueleto as E import qualified Database.Esqueleto.Utils as E import Database.Esqueleto.Utils.TH - + import qualified Data.Csv as Csv - + import Data.Map ((!)) import qualified Data.Map as Map import qualified Data.Set as Set - + import qualified Data.Text as Text import qualified Data.Text.Lens as Text - + import qualified Data.Conduit.List as C - + import qualified Data.CaseInsensitive as CI import Numeric.Lens (integral) @@ -320,7 +320,7 @@ postEUsersR tid ssh csh examn = do criteria'' | ExamAttended (ExamPassed True) `Set.member` criteria = criteria' `Set.union` Set.fromList passed - | otherwise + | otherwise = criteria' in queryExamResult row E.?. ExamResultResult `E.in_` E.valList (Just <$> Set.toList criteria'') ) @@ -431,7 +431,7 @@ postEUsersR tid ssh csh examn = do ExamUserCsvCourseRegister -> DBCsvActionNew ExamUserCsvRegister -> DBCsvActionNew ExamUserCsvDeregister -> DBCsvActionMissing - _other -> DBCsvActionExisting + _other -> DBCsvActionExisting , dbtCsvExecuteActions = do C.mapM_ $ \case ExamUserCsvCourseRegisterData{..} -> do @@ -496,7 +496,7 @@ postEUsersR tid ssh csh examn = do ExamUserCsvSetCourseNoteData{ examUserCsvActCourseNote = Just note, .. } -> do now <- liftIO getCurrentTime uid <- liftHandlerT requireAuthId - Entity nid _ <- upsert (CourseUserNote examCourse examUserCsvActUser note) [ CourseUserNoteNote =. note ] + Entity nid _ <- upsert (CourseUserNote examCourse examUserCsvActUser note) [ CourseUserNoteNote =. note ] insert_ $ CourseUserNoteEdit uid now nid return $ CExamR tid ssh csh examn EUsersR , dbtCsvRenderKey = \(registeredUserName -> registeredUserName') -> \case @@ -579,12 +579,12 @@ postEUsersR tid ssh csh examn = do $newline never _{StudyDegreeTerm degree terms}, _{MsgStudyFeatureAge} #{studyFeaturesSemester} |] - + registeredUserName :: Map (E.Value ExamRegistrationId) ExamUserTableData -> ExamRegistrationId -> Widget registeredUserName existing (E.Value -> registration) = nameWidget userDisplayName userSurname where Entity _ User{..} = view resultUser $ existing ! registration - + guessUser :: ExamUserTableCsv -> DB (Bool, UserId) guessUser ExamUserTableCsv{..} = $cachedHereBinary (csvEUserMatriculation, csvEUserName, csvEUserSurname) $ do users <- E.select . E.from $ \user -> do @@ -620,7 +620,7 @@ postEUsersR tid ssh csh examn = do studyFeatures <- E.select . E.from $ \(studyFeatures `E.InnerJoin` studyDegree `E.InnerJoin` studyTerms) -> do E.on $ studyTerms E.^. StudyTermsId E.==. studyFeatures E.^. StudyFeaturesField E.on $ studyDegree E.^. StudyDegreeId E.==. studyFeatures E.^. StudyFeaturesDegree - E.where_ . E.and $ catMaybes + E.where_ . E.and $ catMaybes [ do field <- csvEUserField return . E.or $ catMaybes @@ -638,8 +638,13 @@ postEUsersR tid ssh csh examn = do , (studyFeatures E.^. StudyFeaturesSemester E.==.) . E.val <$> csvEUserSemester ] E.where_ $ studyFeatures E.^. StudyFeaturesUser E.==. E.val uid - E.&&. studyFeatures E.^. StudyFeaturesValid E.==. E.val True - E.limit 2 + let isCourseParticipantFeature = E.exists $ E.from $ \courseParticipant -> do + E.where_ $ courseParticipant E.^. CourseParticipantCourse E.==. E.val examCourse + E.where_ $ courseParticipant E.^. CourseParticipantUser E.==. E.val uid + E.where_ $ courseParticipant E.^. CourseParticipantField E.==. E.just (studyFeatures E.^. StudyFeaturesId) + E.where_ $ (studyFeatures E.^. StudyFeaturesValid E.==. E.val True) + E.||. isCourseParticipantFeature -- either active studyFeature or the one previously associated with the course + E.limit 2 -- we just need to know whether there is a unique one, none, or more than one return $ studyFeatures E.^. StudyFeaturesId case studyFeatures of [E.Value fid] -> return $ Just fid diff --git a/stack.yaml.lock b/stack.yaml.lock index cb8c9d974..45c694d00 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -10,13 +10,13 @@ packages: sha256: 2cab90bba4d15bf6a17e3cb8e50bc8708c1091de503dd4e91d3954240e89f37b name: zip-stream version: 0.1.0.1 - git: https://github.com/pngwjpgh/zip-stream.git + git: https://github.com/uni2work/zip-stream.git pantry-tree: size: 657 sha256: d1626bbc3fb88a48ce9c5c37199f8cbf426be6410740891d76a8343de4f3c109 commit: 9272bbed000928d500febad1cdc98d1da29d399e original: - git: https://github.com/pngwjpgh/zip-stream.git + git: https://github.com/uni2work/zip-stream.git commit: 9272bbed000928d500febad1cdc98d1da29d399e - completed: cabal-file: @@ -24,13 +24,13 @@ packages: sha256: 88537113b855381b8d70da2442ae644dc979ad6b32aaaec2ebf55306764c8f1a name: encoding version: 0.8.2 - git: https://github.com/pngwjpgh/encoding.git + git: https://github.com/uni2work/encoding.git pantry-tree: size: 5668 sha256: 57160d758802aba6a0d2cc88c53f2f0bb60df7d5e6822938351618b7eca0beab commit: 67bb87ceff53f0178c988dd4e15eeb2daee92b84 original: - git: https://github.com/pngwjpgh/encoding.git + git: https://github.com/uni2work/encoding.git commit: 67bb87ceff53f0178c988dd4e15eeb2daee92b84 - completed: cabal-file: @@ -38,13 +38,13 @@ packages: sha256: 7b25a0ef819e8a01b485d6d0865baa3445faa826ffb3876c94109dd2469ffbd3 name: memcached-binary version: 0.2.0 - git: https://github.com/pngwjpgh/memcached-binary.git + git: https://github.com/uni2work/memcached-binary.git pantry-tree: size: 1170 sha256: c466f91129410bae1f53e25aec4026f6984ce2dff0ada4516e2548048aba549a commit: b5461747e7be226d3b67daebc3c9aefe8a4490ad original: - git: https://github.com/pngwjpgh/memcached-binary.git + git: https://github.com/uni2work/memcached-binary.git commit: b5461747e7be226d3b67daebc3c9aefe8a4490ad - completed: hackage: colonnade-1.2.0@sha256:5620e999a68a394abfe157da6302dd6d8ce8a89b527ea9c294519efd7c4edb2c,2092