diff --git a/messages/uniworx/utils/table_column/de-de-formal.msg b/messages/uniworx/utils/table_column/de-de-formal.msg index 03d31eace..3113bc0a2 100644 --- a/messages/uniworx/utils/table_column/de-de-formal.msg +++ b/messages/uniworx/utils/table_column/de-de-formal.msg @@ -103,6 +103,7 @@ TableJobLockTime: Bearbeitung seit TableJobLockInstance: Bearbeiter 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 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. diff --git a/messages/uniworx/utils/table_column/en-eu.msg b/messages/uniworx/utils/table_column/en-eu.msg index 0dacc0a75..5bcf5d499 100644 --- a/messages/uniworx/utils/table_column/en-eu.msg +++ b/messages/uniworx/utils/table_column/en-eu.msg @@ -103,6 +103,7 @@ TableJobLockTime: Lock time TableJobLockInstance: Worker 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 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. diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index 8fc50b5e4..b1ac4ce01 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -8,7 +8,7 @@ -- 3. add constructor to list of module exports {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-unused-top-binds #-} module Foundation.I18n ( appLanguages, appLanguagesOpts @@ -87,21 +87,31 @@ pluralDE num singularForm pluralForm | num == 1 = singularForm | otherwise = pluralForm --- pluralDEx :: (Eq a, Num a) => Char -> a -> Text -> Text --- -- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@ --- pluralDEx c n t = pluralDE n t $ t `snoc` c +pluralDEx :: (Eq a, Num a) => Char -> a -> Text -> Text +-- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@ +pluralDEx c n t = pluralDE n t $ t `snoc` c --- -- | like `pluralDEe` but also prefixes with the number --- pluralDExN :: (Eq a, Num a, Show a) => Char -> a -> Text -> Text --- pluralDExN c n t = tshow n <> cons ' ' (pluralDEx c n t) +-- | like `pluralDEe` but also prefixes with the number +pluralDExN :: (Eq a, Num a, Show a) => Char -> a -> Text -> Text +pluralDExN c n t = tshow n <> cons ' ' (pluralDEx c n t) pluralDEe :: (Eq a, Num a) => a -> Text -> Text -- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@ -pluralDEe n t = pluralDE n t $ t `snoc` 'e' +pluralDEe = pluralDEx 'e' -- | like `pluralDEe` but also prefixes with the number pluralDEeN :: (Eq a, Num a, Show a) => a -> Text -> Text -pluralDEeN n t = tshow n <> cons ' ' (pluralDEe n t) +pluralDEeN = pluralDExN 'e' + +-- | postfix plural with an 'n' +pluralDEn :: (Eq a, Num a) => a -> Text -> Text +-- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@ +pluralDEn = pluralDEx 'n' + +-- | like `pluralDEn` but also prefixes with the number +pluralDEnN :: (Eq a, Num a, Show a) => a -> Text -> Text +pluralDEnN = pluralDExN 'n' + noneOneMoreDE :: (Eq a, Num a) => a -- ^ Count diff --git a/src/Handler/Admin/Crontab.hs b/src/Handler/Admin/Crontab.hs index 5806edd60..670d5ff3e 100644 --- a/src/Handler/Admin/Crontab.hs +++ b/src/Handler/Admin/Crontab.hs @@ -35,6 +35,9 @@ import qualified Database.Esqueleto.Legacy as E import qualified Database.Esqueleto.Utils as E -- import Database.Esqueleto.Utils.TH +-- Number of minutes a job must have been locked already to allow forced deletion +jobDeleteLockMinutes :: Int +jobDeleteLockMinutes = 3 deriveJSON defaultOptions { constructorTagModifier = camelToPathPiece' 1 @@ -118,7 +121,9 @@ instance Finite JobTableAction nullaryPathPiece ''JobTableAction $ camelToPathPiece' 1 embedRenderMessage ''UniWorX ''JobTableAction id -data JobTableActionData = ActJobDeleteData +data JobTableActionData = ActJobDeleteData + { jobDeleteLocked :: Bool + } deriving (Eq, Ord, Read, Show, Generic) @@ -164,7 +169,8 @@ postAdminJobsR = do ] dbtStyle = def { dbsFilterLayout = defaultDBSFilterLayout } acts :: Map JobTableAction (AForm Handler JobTableActionData) - acts = Map.singleton ActJobDelete $ pure ActJobDeleteData + acts = Map.singleton ActJobDelete $ ActJobDeleteData + <$> areq checkBoxField (fslI $ MsgActJobDeleteForce jobDeleteLockMinutes) Nothing dbtParams = DBParamsForm { dbParamsFormAdditional = renderAForm FormStandard @@ -193,13 +199,22 @@ postAdminJobsR = do (jobActRes, jobsTable) <- runDB (over _1 postprocess <$> dbTable jobsDBTableValidator jobsDBTable) formResult jobActRes $ \case - (ActJobDeleteData, jobIds) -> do - let jobReq = length jobIds + (ActJobDeleteData{jobDeleteLocked}, jobIds) -> do + now <- liftIO getCurrentTime + let cutoff :: UTCTime + cutoff = addUTCTime (nominalMinute * fromIntegral (negate jobDeleteLockMinutes)) now + jobReq = length jobIds + lockCriteria + | jobDeleteLocked = + [ QueuedJobLockTime ==. Nothing ] ||. + [ QueuedJobLockTime <=. Just cutoff ] + | otherwise = + [ QueuedJobLockTime ==. Nothing + , QueuedJobLockInstance ==. Nothing + ] rmvd <- runDB $ fromIntegral <$> deleteWhereCount - [ QueuedJobLockTime ==. Nothing - , QueuedJobLockInstance ==. Nothing - , QueuedJobId <-. Set.toList jobIds - ] + ((QueuedJobId <-. Set.toList jobIds) : lockCriteria) + addMessageI (bool Success Warning $ rmvd < jobReq) (MsgTableJobActDeleteFeedback rmvd jobReq) reloadKeepGetParams AdminJobsR