chore(jobs): add option to manually delete old jobs

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.

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.

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
+pluralDEx :: (Eq a, Num a) => Char -> a -> Text -> Text
--- -- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@ 
+-- ^ @pluralENs n "Monat" = pluralEN n "Monat" "Monate"@ 
--- pluralDEx c n t = pluralDE n t $ t `snoc` c
+pluralDEx c n t = pluralDE n t $ t `snoc` c
 
--- -- | like `pluralDEe` but also prefixes with the number
+-- | like `pluralDEe` but also prefixes with the number
--- pluralDExN :: (Eq a, Num a, Show a) => Char -> a -> Text -> Text
+pluralDExN :: (Eq a, Num a, Show a) => Char -> a -> Text -> Text
--- pluralDExN c n t = tshow n <> cons ' ' (pluralDEx c n t)
+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

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
+    (ActJobDeleteData{jobDeleteLocked}, jobIds) -> do
-      let jobReq  = length jobIds
+      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
+        ((QueuedJobId <-. Set.toList jobIds) : lockCriteria)
-        , QueuedJobLockInstance ==. Nothing
+        
-        , QueuedJobId <-. Set.toList jobIds
-        ]
       addMessageI (bool Success Warning $ rmvd < jobReq) (MsgTableJobActDeleteFeedback rmvd jobReq)
       reloadKeepGetParams AdminJobsR