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

chore(admin-jobs): implement JobActionData as dbtable action res

Browse Source
This commit is contained in:
Sarah Vaupel 2023-07-17 14:47:50 +00:00
parent 15ab17aeca
commit 26ce2b83e2
1 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/Handler/Admin/Crontab.hs
View File

@ -118,9 +118,8 @@ instance Finite JobTableAction
nullaryPathPiece ''JobTableAction $ camelToPathPiece' 1 nullaryPathPiece ''JobTableAction $ camelToPathPiece' 1
embedRenderMessage ''UniWorX ''JobTableAction id embedRenderMessage ''UniWorX ''JobTableAction id
-- Not yet needed, since there is no additional data for now (also, postprocess did not type somehow) data JobTableActionData = ActJobDeleteData
-- data JobTableActionData = ActJobDeleteData deriving (Eq, Ord, Read, Show, Generic)
-- deriving (Eq, Ord, Read, Show, Generic)
getAdminJobsR, postAdminJobsR :: Handler Html getAdminJobsR, postAdminJobsR :: Handler Html
@ -164,13 +163,13 @@ postAdminJobsR = do
prismAForm (singletonFilter "job" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableJob) prismAForm (singletonFilter "job" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableJob)
] ]
dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout }
acts :: Map JobTableAction (AForm Handler JobTableAction) acts :: Map JobTableAction (AForm Handler JobTableActionData)
acts = Map.singleton ActJobDelete $ pure ActJobDelete acts = Map.singleton ActJobDelete $ pure ActJobDeleteData
dbtParams = DBParamsForm dbtParams = DBParamsForm
{ dbParamsFormAdditional = { dbParamsFormAdditional =
renderAForm FormStandard renderAForm FormStandard
$ (, mempty) . First . Just $ (, mempty) . First . Just
<$> multiActionA acts (fslI MsgTableAction) Nothing <$> multiActionA acts (fslI MsgTableAction) Nothing
, dbParamsFormMethod = POST , dbParamsFormMethod = POST
, dbParamsFormAction = Nothing -- Just $ SomeRoute currentRoute , dbParamsFormAction = Nothing -- Just $ SomeRoute currentRoute
, dbParamsFormAttrs = [] , dbParamsFormAttrs = []
@ -185,8 +184,8 @@ postAdminJobsR = do
-- jobsDBTableValidator :: PSValidator (MForm Handler) (FormResult (First JobTableAction, DBFormResult QueuedJobId Bool (DBRow (Entity QueuedJob)))) -- jobsDBTableValidator :: PSValidator (MForm Handler) (FormResult (First JobTableAction, DBFormResult QueuedJobId Bool (DBRow (Entity QueuedJob))))
jobsDBTableValidator = def jobsDBTableValidator = def
& defaultSorting [SortDescBy "creation-time"] & defaultSorting [SortDescBy "creation-time"]
-- postprocess :: FormResult (First JobTableAction, DBFormResult QueuedJobId Bool (DBRow (Entity QueuedJob))) postprocess :: FormResult (First JobTableActionData, DBFormResult QueuedJobId Bool (DBRow (Entity QueuedJob)))
-- -> FormResult (JobTableAction, Set QueuedJobId) -> FormResult (JobTableActionData, Set QueuedJobId)
postprocess inp = do postprocess inp = do
(First (Just act), jobMap) <- inp (First (Just act), jobMap) <- inp
let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap
@ -194,13 +193,13 @@ postAdminJobsR = do
(jobActRes, jobsTable) <- runDB (over _1 postprocess <$> dbTable jobsDBTableValidator jobsDBTable) (jobActRes, jobsTable) <- runDB (over _1 postprocess <$> dbTable jobsDBTableValidator jobsDBTable)
formResult jobActRes $ \case formResult jobActRes $ \case
(ActJobDelete, jobIds) -> do (ActJobDeleteData, jobIds) -> do
let jobReq = length jobIds let jobReq = length jobIds
rmvd <- fromIntegral <$> runDB (deleteWhereCount rmvd <- runDB $ fromIntegral <$> deleteWhereCount
[ QueuedJobLockTime ==. Nothing [ QueuedJobLockTime ==. Nothing
, QueuedJobLockInstance ==. Nothing , QueuedJobLockInstance ==. Nothing
, QueuedJobId <-. Set.toList jobIds , QueuedJobId <-. Set.toList jobIds
]) ]
addMessageI (bool Success Warning $ rmvd < jobReq) (MsgTableJobActDeleteFeedback rmvd jobReq) addMessageI (bool Success Warning $ rmvd < jobReq) (MsgTableJobActDeleteFeedback rmvd jobReq)
reloadKeepGetParams AdminJobsR reloadKeepGetParams AdminJobsR