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

feat(eeusers): fix form & finish implementation

Browse Source
This commit is contained in:
Gregor Kleen 2020-05-06 15:03:00 +02:00
parent 8008248483
commit 7d3e9a3de3
3 changed files with 63 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
src/Handler/ExamOffice/ExternalExam.hs
View File

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

54
src/Handler/ExternalExam/Users.hs
View File

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

29
src/Handler/Utils/ExternalExam/Users.hs
View File

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