diff --git a/src/Handler/ExamOffice/ExternalExam.hs b/src/Handler/ExamOffice/ExternalExam.hs index 949399545..1e7bafffd 100644 --- a/src/Handler/ExamOffice/ExternalExam.hs +++ b/src/Handler/ExamOffice/ExternalExam.hs @@ -4,8 +4,6 @@ module Handler.ExamOffice.ExternalExam import Import -import Database.Persist.Sql (deleteWhereCount, updateWhereCount) - import Handler.Utils import Handler.Utils.ExternalExam.Users @@ -17,52 +15,13 @@ postEEGradesR tid ssh coursen examn = do eExam <- getBy404 $ UniqueExternalExam tid ssh coursen examn (usersResult, examUsersTable) <- makeExternalExamUsersTable EEUMGrades eExam - let - editResults results changeList = fmap getSum . flip foldMapM results $ \result -> do - now <- liftIO getCurrentTime - mExtExamRes <- get result - nrEdit <- updateWhereCount - [ ExternalExamResultId ==. result ] - (changeList <> [ ExternalExamResultLastChanged =. now ]) - if - | Just ExternalExamResult{..} <- mExtExamRes -> do - forM_ [1..nrEdit] $ const $ audit $ TransactionExternalExamResultEdit externalExamResultExam externalExamResultUser - return $ Sum nrEdit - | otherwise -> return mempty - usersResult' <- formResultMaybe usersResult $ \case (ExternalExamUserMarkSynchronisedData, selectedResults) -> do forM_ selectedResults externalExamResultMarkSynchronised return . Just $ do addMessageI Success $ MsgExamUserMarkedSynchronised $ length selectedResults redirect $ EExamR tid ssh coursen examn EEGradesR - - (ExternalExamUserEditOccurrenceData occ, selectedResults) -> do - nrEdited <- editResults selectedResults - [ ExternalExamResultTime =. occ ] - return . Just $ do - addMessageI Success $ MsgExternalExamOccurrenceEdited nrEdited - redirect $ EExamR tid ssh coursen examn EEGradesR - - (ExternalExamUserEditResultData examResult, selectedResults) -> do - nrEdited <- editResults selectedResults - [ ExternalExamResultResult =. examResult ] - return . Just $ do - addMessageI Success $ MsgExternalExamResultEdited nrEdited - redirect $ EExamR tid ssh coursen examn EEGradesR - - (ExternalExamUserDeleteData, selectedResults) -> do - nrDeleted <- fmap getSum . flip foldMapM selectedResults $ \selectedResult -> do - mExtExamRes <- get selectedResult - nrDel <- deleteWhereCount [ ExternalExamResultId ==. selectedResult ] - if - | Just ExternalExamResult{..} <- mExtExamRes -> do - forM_ [1..nrDel] $ const $ audit $ TransactionExternalExamResultDelete externalExamResultExam externalExamResultUser - return $ Sum nrDel - | otherwise -> return mempty - return . Just $ do - addMessageI Success $ MsgExternalExamUserDeleted nrDeleted - redirect $ EExamR tid ssh coursen examn EEGradesR + _other -> return Nothing return (usersResult', examUsersTable) diff --git a/src/Handler/ExternalExam/Users.hs b/src/Handler/ExternalExam/Users.hs index 163d086fa..79f9f8b38 100644 --- a/src/Handler/ExternalExam/Users.hs +++ b/src/Handler/ExternalExam/Users.hs @@ -4,14 +4,64 @@ module Handler.ExternalExam.Users import Import +import Database.Persist.Sql (deleteWhereCount, updateWhereCount) + +import Handler.Utils + import Handler.Utils.ExternalExam.Users getEEUsersR, postEEUsersR :: TermId -> SchoolId -> CourseName -> ExamName -> Handler Html getEEUsersR = postEEUsersR postEEUsersR tid ssh coursen examn = do - (_, table) <- runDB $ do + (usersResult, table) <- runDB $ do eExam <- getBy404 $ UniqueExternalExam tid ssh coursen examn - makeExternalExamUsersTable EEUMUsers eExam + (usersResult, examUsersTable) <- makeExternalExamUsersTable EEUMUsers eExam + + let + editResults results changeList = fmap getSum . flip foldMapM results $ \result -> do + now <- liftIO getCurrentTime + mExtExamRes <- get result + nrEdit <- updateWhereCount + [ ExternalExamResultId ==. result ] + (changeList <> [ ExternalExamResultLastChanged =. now ]) + if + | Just ExternalExamResult{..} <- mExtExamRes -> do + forM_ [1..nrEdit] $ const $ audit $ TransactionExternalExamResultEdit externalExamResultExam externalExamResultUser + return $ Sum nrEdit + | otherwise -> return mempty + + usersResult' <- formResultMaybe usersResult $ \case + (ExternalExamUserEditOccurrenceData occ, selectedResults) -> do + nrEdited <- editResults selectedResults + [ ExternalExamResultTime =. occ ] + return . Just $ do + addMessageI Success $ MsgExternalExamOccurrenceEdited nrEdited + redirect $ EExamR tid ssh coursen examn EEGradesR + + (ExternalExamUserEditResultData examResult, selectedResults) -> do + nrEdited <- editResults selectedResults + [ ExternalExamResultResult =. examResult ] + return . Just $ do + addMessageI Success $ MsgExternalExamResultEdited nrEdited + redirect $ EExamR tid ssh coursen examn EEGradesR + + (ExternalExamUserDeleteData, selectedResults) -> do + nrDeleted <- fmap getSum . flip foldMapM selectedResults $ \selectedResult -> do + mExtExamRes <- get selectedResult + nrDel <- deleteWhereCount [ ExternalExamResultId ==. selectedResult ] + if + | Just ExternalExamResult{..} <- mExtExamRes -> do + forM_ [1..nrDel] $ const $ audit $ TransactionExternalExamResultDelete externalExamResultExam externalExamResultUser + return $ Sum nrDel + | otherwise -> return mempty + return . Just $ do + addMessageI Success $ MsgExternalExamUserDeleted nrDeleted + redirect $ EExamR tid ssh coursen examn EEGradesR + _other -> return Nothing + + return (usersResult', examUsersTable) + + whenIsJust usersResult join siteLayoutMsg (MsgExternalExamUsers coursen examn) $ do setTitleI MsgBreadcrumbExternalExamUsers diff --git a/src/Handler/Utils/ExternalExam/Users.hs b/src/Handler/Utils/ExternalExam/Users.hs index 0df3df9e9..3aaf8b7e2 100644 --- a/src/Handler/Utils/ExternalExam/Users.hs +++ b/src/Handler/Utils/ExternalExam/Users.hs @@ -34,6 +34,7 @@ data ExternalExamUserMode = EEUMUsers | EEUMGrades instance Universe ExternalExamUserMode instance Finite ExternalExamUserMode nullaryPathPiece ''ExternalExamUserMode $ camelToPathPiece' 1 +makePrisms ''ExternalExamUserMode type ExternalExamUserTableExpr = E.SqlExpr (Entity ExternalExamResult) @@ -259,12 +260,8 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do dbtColonnade :: Colonnade Sortable _ _ dbtColonnade = mconcat - [ case mode of - EEUMGrades -> mconcat - [ dbSelect (applying _2) id $ return . view (resultResult . _entityKey) - , colSynced - ] - _other -> mempty + [ dbSelect (applying _2) id $ return . view (resultResult . _entityKey) + , fromMaybe mempty . guardOn (is _EEUMGrades mode) $ colSynced , colUserDisplayName (resultUser . _entityVal . $(multifocusL 2) _userDisplayName _userSurname) , colUserMatriculation (resultUser . _entityVal . _userMatrikelnummer) , Colonnade.singleton (fromSortable . Sortable (Just "occurrence-start") $ i18nCell MsgExamTime) $ \x -> cell . flip runReaderT x $ do @@ -299,9 +296,7 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do { dbParamsFormMethod = POST , dbParamsFormAction = Just $ SomeRoute currentRoute , dbParamsFormAttrs = [] - , dbParamsFormSubmit = case mode of - EEUMGrades -> FormSubmit - _other -> FormNoSubmit + , dbParamsFormSubmit = FormSubmit , dbParamsFormAdditional = case mode of EEUMGrades -> \csrf -> do let @@ -316,18 +311,14 @@ makeExternalExamUsersTable mode (Entity eeId ExternalExam{..}) = do return (formRes, formWgt) EEUMUsers -> \csrf -> do let - -- TODO work in progress actionMap :: Map ExternalExamUserAction (AForm Handler ExternalExamUserActionData) actionMap = mconcat - [ singletonMap ExternalExamUserMarkSynchronised $ - pure ExternalExamUserMarkSynchronisedData - --, singletonMap ExternalExamUserEditOccurrence $ - -- ExternalExamUserEditOccurrenceData - -- <$> mempty - -- <$> aopt () (fslI MsgExamOccurrence) (Just Nothing) - --, singletonMap ExternalExamUserEditResult $ - -- ExternalExamUserEditResultData - -- <$> mempty + [ singletonMap ExternalExamUserEditOccurrence $ + ExternalExamUserEditOccurrenceData + <$> apopt utcTimeField (fslI MsgExamTime) externalExamDefaultTime + , singletonMap ExternalExamUserEditResult $ + ExternalExamUserEditResultData + <$> apopt (examResultPassedGradeField Nothing) (fslI MsgExamResult) Nothing , singletonMap ExternalExamUserDelete $ pure ExternalExamUserDeleteData ]