fix(exam import): inactive registered features may be selected
This commit is contained in:
Steffen Jost
parent
440f0a97d0
commit
3c4172cbc2
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user