diff --git a/messages/uniworx/utils/table_column/de-de-formal.msg b/messages/uniworx/utils/table_column/de-de-formal.msg index abc8d219a..d8463570c 100644 --- a/messages/uniworx/utils/table_column/de-de-formal.msg +++ b/messages/uniworx/utils/table_column/de-de-formal.msg @@ -114,6 +114,11 @@ TableJobCreationInstance: Ersteller ActJobDelete: Job entfernen ActJobDeleteForce n@Int: Auch vor #{pluralDEnN n "Minute"} gesperrte Jobs entfernen TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} Jobs entfernt +ActJobSleep: Test Job einreihen +JobSleepNr: Anzahl Jobs +JobSleepSecs: Laufzeit in Sekunden pro Job +JobSleepNow: Prioriäts-Jobs +TableJobActSleepFeedback n@Int sec@Int prio@Bool: #{n} #{bool tempty "Prioritäts-" prio}#{pluralDEx 's' n "Job"} mit #{sec}s Laufzeit eingereiht. TableFilterComma: Es können mehrere alternative Suchkriterien mit Komma getrennt angegeben werden, wovon mindestens eines erfüllt werden muss. TableFilterCommaPlus: Mehrere alternative Suchkriterien mit Komma trennen. Mindestens ein Suchkriterium muss erfüllt werden, zusätzlich zu allen Suchkriterien mit vorangestelltem Plus-Symbol. TableFilterCommaPlusShort: Unterstützt mehrere Kriterien mit Komma-Plus, siehe oben. diff --git a/messages/uniworx/utils/table_column/en-eu.msg b/messages/uniworx/utils/table_column/en-eu.msg index 2feb3f9dd..8f2f7927f 100644 --- a/messages/uniworx/utils/table_column/en-eu.msg +++ b/messages/uniworx/utils/table_column/en-eu.msg @@ -114,6 +114,11 @@ TableJobCreationInstance: Creator ActJobDelete: Delete job ActJobDeleteForce n: Also delete jobs locked #{pluralENsN n "minute"} ago TableJobActDeleteFeedback n@Int m@Int: #{n}/#{m} queued jobs deleted +ActJobSleep: Enqueue sleep job +JobSleepNr: Number of jobs +JobSleepSecs: Seconds per job +JobSleepNow: Priority jobs +TableJobActSleepFeedback n@Int sec@Int prio@Bool: #{n} #{bool tempty "priority " prio} sleep #{pluralENs n "job"} for #{sec}s enqueued. TableFilterComma: Separate multiple alternative filter criteria by comma, at least one of which must be fulfilled. TableFilterCommaPlus: Separate multiple alternative filter criteria by comma, at least one of which must be fulfilled in addition to all criteria preceded by a plus symbol. TableFilterCommaPlusShort: Support multiple criteria with comma/plus, see above. diff --git a/src/Handler/Admin/Crontab.hs b/src/Handler/Admin/Crontab.hs index 721bd0333..2a3006b79 100644 --- a/src/Handler/Admin/Crontab.hs +++ b/src/Handler/Admin/Crontab.hs @@ -114,6 +114,7 @@ getAdminCrontabR = do data JobTableAction = ActJobDelete + | ActJobSleep deriving (Eq, Ord, Enum, Bounded, Read, Show, Generic) instance Universe JobTableAction @@ -121,9 +122,10 @@ instance Finite JobTableAction nullaryPathPiece ''JobTableAction $ camelToPathPiece' 1 embedRenderMessage ''UniWorX ''JobTableAction id -newtype JobTableActionData = ActJobDeleteData - { jobDeleteLocked :: Bool - } +data JobTableActionData + = ActJobDeleteData { jobDeleteLocked :: Bool } + | ActJobSleepData { jobSleepNr, jobSleepSecs :: Int + , jobSleepNow :: Bool } deriving (Eq, Ord, Read, Show, Generic) @@ -168,9 +170,18 @@ postAdminJobsR = do prismAForm (singletonFilter "job" . maybePrism _PathPiece) mPrev $ aopt (hoistField lift textField) (fslI MsgTableJob) ] dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } + + areq_posIntF msg = areq (posIntFieldI $ SomeMessages " " [SomeMessage msg, SomeMessage MsgMustBePositive]) (fslI msg) acts :: Map JobTableAction (AForm Handler JobTableActionData) - acts = Map.singleton ActJobDelete $ ActJobDeleteData - <$> areq checkBoxField (fslI $ MsgActJobDeleteForce jobDeleteLockMinutes) Nothing + acts = Map.fromList + [ (ActJobDelete, ActJobDeleteData + <$> areq checkBoxField (fslI $ MsgActJobDeleteForce jobDeleteLockMinutes) Nothing + ),(ActJobSleep, ActJobSleepData + <$> areq_posIntF MsgJobSleepNr (Just 1) + <*> areq_posIntF MsgJobSleepSecs (Just 60) + <*> areq checkBoxField (fslI MsgJobSleepNow) (Just True) + )] + dbtParams = DBParamsForm { dbParamsFormAdditional = renderAForm FormStandard @@ -196,7 +207,6 @@ postAdminJobsR = do (First (Just act), jobMap) <- inp let jobSet = Map.keysSet . Map.filter id $ getDBFormResult (const False) jobMap return (act, jobSet) - void . queueJob' $ JobSleep 42 -- debug add sleep job (jobActRes, jobsTable) <- runDB (over _1 postprocess <$> dbTable jobsDBTableValidator jobsDBTable) formResult jobActRes $ \case @@ -219,6 +229,13 @@ postAdminJobsR = do addMessageI (bool Success Warning $ rmvd < jobReq) (MsgTableJobActDeleteFeedback rmvd jobReq) reloadKeepGetParams AdminJobsR + (ActJobSleepData{..}, _) -> do + let jSleep = JobSleep jobSleepSecs + enqSleep = bool (void . queueJob) queueJob' jobSleepNow jSleep + replicateM_ jobSleepNr enqSleep + addMessageI Success (MsgTableJobActSleepFeedback jobSleepNr jobSleepSecs jobSleepNow) + reloadKeepGetParams AdminJobsR + -- gather some data on job worles (nrWorkers, jobStateVar) <- getsYesod (view _appJobWorkers &&& appJobState) jState <- atomically $ tryReadTMVar jobStateVar diff --git a/src/Utils.hs b/src/Utils.hs index 285740f6a..a4e477ae9 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -274,6 +274,10 @@ addAttrsClass cl attrs = ("class", cl') : noClAttrs -- tickmark :: IsString a => a -- tickmark = fromString "✔" +-- | to conveniently avoid some ambiguous type problems +tempty :: Text +tempty = mempty + nonBreakableDash :: Text -- used directly in several messages nonBreakableDash = "‑"