6482f2f · odd-jobs · git.iko.soy

git.iko.soy/odd-jobs

Follow hlint suggestion: redundant bracket.

commit6482f2fe7446f11b96c2eaee76eac7e932c3718f authorPhil de Joux <philderbeast@gmail.com> dateSun 16 Oct 2022, 16:09 (4 years ago) parent3ff78d2

9 files changed+110−111

compare with master

unifiedsplit

.hlint.yaml−1 examples/OddJobsCliExample.lhs+1−1 src/OddJobs/Cli.hs+5−5 src/OddJobs/ConfigBuilder.hs+13−13 src/OddJobs/Endpoints.hs+12−12 src/OddJobs/Job.hs+23−23 src/OddJobs/Migrations.hs+2−2 src/OddJobs/Web.hs+19−19 test/Test.hs+35−35

.hlint.yaml−1

@@ -1,7 +1,6 @@

11# Warnings currently triggered by your code

22- ignore: {name: "Eta reduce"} # 6 hints

33- ignore: {name: "Move brackets to avoid $"} # 19 hints

4−- ignore: {name: "Redundant bracket"} # 118 hints

54- ignore: {name: "Redundant if"} # 1 hint

65- ignore: {name: "Use newtype instead of data"} # 1 hint

76- ignore: {name: "Use null"} # 3 hints

examples/OddJobsCliExample.lhs+1−1

@@ -71,7 +71,7 @@ In this example, the core job-runner function is in the `IO` monad. In all proba

7171\begin{code}

7272myJobRunner :: Job -> IO ()

7373myJobRunner job = do

74− (throwParsePayload job) >>= \case

74+ throwParsePayload job >>= \case

7575 SendWelcomeEmail _userId -> do

7676 putStrLn $ "This should call the function that actually sends the welcome email. " <>

7777 "\nWe are purposely waiting 60 seconds before completing this job so that graceful shutdown can be demonstrated."

src/OddJobs/Cli.hs+5−5

@@ -164,12 +164,12 @@ defaultStopCommand :: StopArgs

164164defaultStopCommand StopArgs{..} = do

165165 progName <- getProgName

166166 -- pid <- read <$> (readFile shutPidFile)

167− if (shutTimeout == Seconds 0)

167+ if shutTimeout == Seconds 0

168168 then Daemon.brutalKill shutPidFile

169169 else do putStrLn $ "Sending sigINT to " <> show progName <>

170170 " and waiting " <> (show $ unSeconds shutTimeout) <> " seconds for graceful stop"

171171 readFile shutPidFile >>= Sig.signalProcess Sig.sigINT . read

172− (Async.race (delaySeconds shutTimeout) checkProcessStatus) >>= \case

172+ Async.race (delaySeconds shutTimeout) checkProcessStatus >>= \case

173173 Right _ -> do

174174 putStrLn $ progName <> " seems to have exited gracefully."

175175 Exit.exitSuccess

@@ -204,7 +204,7 @@ data Args = Args

204204

205205-- | The top-level command-line parser

206206argParser :: CliType -> Parser Args

207−argParser cliType = Args <$> (commandParser cliType)

207+argParser cliType = Args <$> commandParser cliType

208208

209209-- ** Top-level command parser

210210

@@ -261,7 +261,7 @@ startCmdParser cliType = Start

261261 <*> (case cliType of

262262 CliOnlyJobRunner _ -> pure Nothing

263263 CliOnlyWebUi _ -> Just <$> uiStartArgsParser

264− CliBoth _ _ -> (Just <$> uiStartArgsParser) <|> (pure Nothing)

264+ CliBoth _ _ -> (Just <$> uiStartArgsParser) <|> pure Nothing

265265 )

266266

267267data WebUiAuth

@@ -342,7 +342,7 @@ defaultCliParserPrefs = prefs $

342342

343343defaultCliInfo :: CliType -> ParserInfo Args

344344defaultCliInfo cliType =

345− info ((argParser cliType) <**> helper) fullDesc

345+ info (argParser cliType <**> helper) fullDesc

346346

347347-- defaultDaemonOptions :: DaemonOptions

348348-- defaultDaemonOptions = DaemonOptions

src/OddJobs/ConfigBuilder.hs+13−13

@@ -66,15 +66,15 @@ mkConfig :: (LogLevel -> LogEvent -> IO ())

6666mkConfig logger tname dbpool ccControl jrunner configOverridesFn =

6767 let cfg = configOverridesFn $ Config

6868 { cfgPollingInterval = defaultPollingInterval

69− , cfgOnJobSuccess = (const $ pure ())

69+ , cfgOnJobSuccess = const $ pure ()

7070 , cfgOnJobFailed = []

7171 , cfgJobRunner = jrunner

7272 , cfgLogger = logger

7373 , cfgDbPool = dbpool

74− , cfgOnJobStart = (const $ pure ())

74+ , cfgOnJobStart = const $ pure ()

7575 , cfgDefaultMaxAttempts = 10

7676 , cfgTableName = tname

77− , cfgOnJobTimeout = (const $ pure ())

77+ , cfgOnJobTimeout = const $ pure ()

7878 , cfgConcurrencyControl = ccControl

7979 , cfgJobType = defaultJobType

8080 , cfgDefaultJobTimeout = Seconds 600

@@ -111,7 +111,7 @@ mkUIConfig logger tname dbpool configOverridesFn =

111111 , uicfgTableName = tname

112112 , uicfgJobType = defaultJobType

113113 , uicfgJobToHtml = defaultJobsToHtml (uicfgJobType cfg)

114− , uicfgAllJobTypes = (defaultDynamicJobTypes (uicfgTableName cfg) (uicfgJobTypeSql cfg))

114+ , uicfgAllJobTypes = defaultDynamicJobTypes (uicfgTableName cfg) (uicfgJobTypeSql cfg)

115115 , uicfgJobTypeSql = defaultJobTypeSql

116116 }

117117 in cfg

@@ -140,7 +140,7 @@ defaultLogStr jobTypeFn logLevel logEvent =

140140 FailPermanent -> "Failed (permanent)"

141141 in tag <> " | " <> jobToLogStr j <> " | runtime=" <> (toLogStr $ show t) <> " | error=" <> (toLogStr $ show e)

142142 LogJobSuccess j t ->

143− "Success | " <> (jobToLogStr j) <> " | runtime=" <> (toLogStr $ show t)

143+ "Success | " <> jobToLogStr j <> " | runtime=" <> (toLogStr $ show t)

144144 LogJobTimeout j@Job{jobLockedAt, jobLockedBy} ->

145145 "Timeout | " <> jobToLogStr j <> " | lockedBy=" <> (toLogStr $ maybe "unknown" unJobRunnerName jobLockedBy) <>

146146 " lockedAt=" <> (toLogStr $ maybe "unknown" show jobLockedAt)

@@ -288,14 +288,14 @@ withConnectionPool connConfig action = withRunInIO $ \runInIO -> do

288288 case connConfig of

289289#if MIN_VERSION_resource_pool(0,3,0)

290290 Left connString ->

291− newPool $ PoolConfig (PGS.connectPostgreSQL connString) PGS.close (fromIntegral $ 2 * (unSeconds defaultPollingInterval)) 8

291+ newPool $ PoolConfig (PGS.connectPostgreSQL connString) PGS.close (fromIntegral $ 2 * unSeconds defaultPollingInterval) 8

292292 Right connInfo ->

293− newPool $ PoolConfig (PGS.connect connInfo) PGS.close (fromIntegral $ 2 * (unSeconds defaultPollingInterval)) 8

293+ newPool $ PoolConfig (PGS.connect connInfo) PGS.close (fromIntegral $ 2 * unSeconds defaultPollingInterval) 8

294294#else

295295 Left connString ->

296− createPool (PGS.connectPostgreSQL connString) PGS.close 1 (fromIntegral $ 2 * (unSeconds defaultPollingInterval)) 8

296+ createPool (PGS.connectPostgreSQL connString) PGS.close 1 (fromIntegral $ 2 * unSeconds defaultPollingInterval) 8

297297 Right connInfo ->

298− createPool (PGS.connect connInfo) PGS.close 1 (fromIntegral $ 2 * (unSeconds defaultPollingInterval)) 8

298+ createPool (PGS.connect connInfo) PGS.close 1 (fromIntegral $ 2 * unSeconds defaultPollingInterval) 8

299299#endif

300300

301301-- | A convenience function to help you define a timed-logger with some sensible

@@ -308,8 +308,8 @@ defaultTimedLogger :: FLogger.TimedFastLogger

308308defaultTimedLogger logger logStrFn logLevel logEvent =

309309 if logLevel == LevelDebug

310310 then pure ()

311− else logger $ \t -> (toLogStr t) <> " | " <>

312− (logStrFn logLevel logEvent) <>

311+ else logger $ \t -> toLogStr t <> " | " <>

312+ logStrFn logLevel logEvent <>

313313 "\n"

314314

315315

@@ -318,7 +318,7 @@ defaultJsonLogEvent logEvent =

318318 case logEvent of

319319 LogJobStart job ->

320320 Aeson.object [ "tag" Aeson..= ("LogJobStart" :: Text)

321− , "contents" Aeson..= (defaultJsonJob job) ]

321+ , "contents" Aeson..= defaultJsonJob job ]

322322 LogJobSuccess job runTime ->

323323 Aeson.object [ "tag" Aeson..= ("LogJobSuccess" :: Text)

324324 , "contents" Aeson..= (defaultJsonJob job, runTime) ]

@@ -327,7 +327,7 @@ defaultJsonLogEvent logEvent =

327327 , "contents" Aeson..= (defaultJsonJob job, show e, defaultJsonFailureMode fm, runTime) ]

328328 LogJobTimeout job ->

329329 Aeson.object [ "tag" Aeson..= ("LogJobTimeout" :: Text)

330− , "contents" Aeson..= (defaultJsonJob job) ]

330+ , "contents" Aeson..= defaultJsonJob job ]

331331 LogPoll ->

332332 Aeson.object [ "tag" Aeson..= ("LogJobPoll" :: Text)]

333333 LogWebUIRequest ->

src/OddJobs/Endpoints.hs+12−12

@@ -65,7 +65,7 @@ data Routes route = Routes

6565

6666

6767type FinalAPI =

68− (ToServant Routes AsApi) :<|>

68+ ToServant Routes AsApi :<|>

6969 "assets" :> StaticAssetRoutes

7070

7171data Env = Env

@@ -106,14 +106,14 @@ server :: forall m . (MonadIO m)

106106 -> (forall a . Handler a -> m a)

107107 -> ServerT FinalAPI m

108108server cfg env nt =

109− (toServant routeServer) :<|> staticAssetServer

109+ toServant routeServer :<|> staticAssetServer

110110 where

111111 routeServer :: Routes (AsServerT m)

112112 routeServer = Routes

113− { rFilterResults = nt . (filterResults cfg env)

114− , rEnqueue = nt . (enqueueJob cfg env)

115− , rCancel = nt . (cancelJob cfg env)

116− , rRunNow = nt . (runJobNow cfg env)

113+ { rFilterResults = nt . filterResults cfg env

114+ , rEnqueue = nt . enqueueJob cfg env

115+ , rCancel = nt . cancelJob cfg env

116+ , rRunNow = nt . runJobNow cfg env

117117 , rRefreshJobTypes = nt $ refreshJobTypes cfg env

118118 , rRefreshJobRunners = nt $ refreshJobRunners cfg env

119119 }

@@ -122,10 +122,10 @@ server2 :: UIConfig

122122 -> Env

123123 -> Routes AsServer

124124server2 cfg env = Routes

125− { rFilterResults = (filterResults cfg env)

126− , rEnqueue = (enqueueJob cfg env)

127− , rCancel = (cancelJob cfg env)

128− , rRunNow = (runJobNow cfg env)

125+ { rFilterResults = filterResults cfg env

126+ , rEnqueue = enqueueJob cfg env

127+ , rCancel = cancelJob cfg env

128+ , rRunNow = runJobNow cfg env

129129 , rRefreshJobTypes = refreshJobTypes cfg env

130130 , rRefreshJobRunners = refreshJobRunners cfg env

131131 }

@@ -185,8 +185,8 @@ filterResults :: UIConfig

185185filterResults cfg@UIConfig{uicfgJobToHtml, uicfgDbPool} Env{..} mFilter = do

186186 let filters = fromMaybe mempty mFilter

187187 (jobs, runningCount) <- liftIO $ Pool.withResource uicfgDbPool $ \conn -> (,)

188− <$> (filterJobs cfg conn filters)

189− <*> (countJobs cfg conn filters{ filterStatuses = [Job.Locked] })

188+ <$> filterJobs cfg conn filters

189+ <*> countJobs cfg conn filters{ filterStatuses = [Job.Locked] }

190190 t <- liftIO getCurrentTime

191191 js <- liftIO (DL.zip jobs <$> uicfgJobToHtml jobs)

192192 allJobTypes <- readIORef envJobTypesRef

src/OddJobs/Job.hs+23−23

@@ -216,7 +216,7 @@ jobWorkerName :: IO String

216216jobWorkerName = do

217217 pid <- getProcessID

218218 hname <- getHostName

219− pure $ hname ++ ":" ++ (show pid)

219+ pure $ hname ++ ":" ++ show pid

220220

221221-- | If you are writing SQL queries where you want to return ALL columns from

222222-- the jobs table it is __recommended__ that you do not issue a @SELECT *@ or

@@ -288,7 +288,7 @@ findJobByIdIO :: Connection -> TableName -> JobId -> IO (Maybe Job)

288288findJobByIdIO conn tname jid = PGS.query conn findJobByIdQuery (tname, jid) >>= \case

289289 [] -> pure Nothing

290290 [j] -> pure (Just j)

291− _js -> Prelude.error $ "Not expecting to find multiple jobs by id=" <> (show jid)

291+ _js -> Prelude.error $ "Not expecting to find multiple jobs by id=" <> show jid

292292

293293

294294saveJobQuery :: PGS.Query

@@ -316,9 +316,9 @@ saveJobIO conn tname Job{jobRunAt, jobStatus, jobPayload, jobLastError, jobAttem

316316 , jobId

317317 )

318318 case rs of

319− [] -> Prelude.error $ "Could not find job while updating it id=" <> (show jobId)

319+ [] -> Prelude.error $ "Could not find job while updating it id=" <> show jobId

320320 [j] -> pure j

321− _js -> Prelude.error $ "Not expecting multiple rows to ber returned when updating job id=" <> (show jobId)

321+ _js -> Prelude.error $ "Not expecting multiple rows to ber returned when updating job id=" <> show jobId

322322

323323deleteJob :: (HasJobRunner m) => JobId -> m ()

324324deleteJob jid = do

@@ -388,13 +388,13 @@ runJobWithTimeout timeoutSec job = do

388388

389389runJob :: (HasJobRunner m) => JobId -> m ()

390390runJob jid = do

391− (findJobById jid) >>= \case

391+ findJobById jid >>= \case

392392 Nothing -> Prelude.error $ "Could not find job id=" <> show jid

393393 Just job -> do

394394 startTime <- liftIO getCurrentTime

395395 lockTimeout <- getDefaultJobTimeout

396396 log LevelInfo $ LogJobStart job

397− (flip catches) [Handler $ timeoutHandler job startTime, Handler $ exceptionHandler job startTime] $ do

397+ flip catches [Handler $ timeoutHandler job startTime, Handler $ exceptionHandler job startTime] $ do

398398 runJobWithTimeout lockTimeout job

399399 endTime <- liftIO getCurrentTime

400400 shouldDeleteJob <- deleteSuccessfulJobs

@@ -420,8 +420,8 @@ runJob jid = do

420420 newJob <- saveJob job{ jobStatus=newStatus

421421 , jobLockedBy=Nothing

422422 , jobLockedAt=Nothing

423− , jobLastError=(Just $ toJSON $ show e) -- TODO: convert errors to json properly

424− , jobRunAt=(addUTCTime (fromIntegral $ unSeconds backoffInSeconds) t)

423+ , jobLastError=Just $ toJSON $ show e -- TODO: convert errors to json properly

424+ , jobRunAt=addUTCTime (fromIntegral $ unSeconds backoffInSeconds) t

425425 }

426426 case fromException e :: Maybe TimeoutException of

427427 Nothing -> log logLevel $ LogJobFailed newJob e failureMode runTime

@@ -440,7 +440,7 @@ restartUponCrash name_ action = do

440440 traceM "restartUponCrash top"

441441 a <- async action

442442 finally (waitCatch a >>= fn) $ do

443− (log LevelInfo $ LogText $ "Received shutdown: " <> toS name_)

443+ log LevelInfo $ LogText $ "Received shutdown: " <> toS name_

444444 cancel a

445445 where

446446 fn x = do

@@ -480,7 +480,7 @@ waitForJobs = do

480480 as -> do

481481 tid <- myThreadId

482482 void $ waitAnyCatch as

483− log LevelDebug $ LogText $ toS $ "Waiting for " <> show (DL.length as) <> " jobs to complete before shutting down. myThreadId=" <> (show tid)

483+ log LevelDebug $ LogText $ toS $ "Waiting for " <> show (DL.length as) <> " jobs to complete before shutting down. myThreadId=" <> show tid

484484 delaySeconds (Seconds 1)

485485 waitForJobs

486486

@@ -490,7 +490,7 @@ getConcurrencyControlFn = getConcurrencyControl >>= \case

490490 UnlimitedConcurrentJobs -> pure $ pure True

491491 MaxConcurrentJobs maxJobs -> pure $ do

492492 curJobs <- getRunnerEnv >>= (readIORef . envJobThreadsRef)

493− pure $ (DL.length curJobs) < maxJobs

493+ pure $ DL.length curJobs < maxJobs

494494 DynamicConcurrency fn -> pure $ liftIO fn

495495

496496

@@ -504,9 +504,9 @@ jobPollingIO pollerDbConn processName tname lockTimeout = do

504504 , processName

505505 , tname

506506 , t

507− , (In [Queued, Retry])

507+ , In [Queued, Retry]

508508 , Locked

509− , (addUTCTime (fromIntegral $ negate $ unSeconds lockTimeout) t))

509+ , addUTCTime (fromIntegral $ negate $ unSeconds lockTimeout) t)

510510

511511-- | Executes 'jobPollingSql' every 'cfgPollingInterval' seconds to pick up jobs

512512-- for execution. Uses @UPDATE@ along with @SELECT...FOR UPDATE@ to efficiently

@@ -550,7 +550,7 @@ jobPoller = do

550550 void $ async $ runJob jid

551551 pure noDelayAction

552552

553− x -> error $ "WTF just happened? I was supposed to get only a single row, but got: " ++ (show x))

553+ x -> error $ "WTF just happened? I was supposed to get only a single row, but got: " ++ show x)

554554 where

555555 delayAction = delaySeconds =<< getPollingInterval

556556 noDelayAction = pure ()

@@ -568,15 +568,15 @@ jobEventListener = do

568568

569569 let tryLockingJob jid = do

570570 let q = "UPDATE ? SET status=?, locked_at=now(), locked_by=?, attempts=attempts+1 WHERE id=? AND status in ? RETURNING id"

571− (withDbConnection $ \conn -> (liftIO $ PGS.query conn q (tname, Locked, jwName, jid, In [Queued, Retry]))) >>= \case

571+ (withDbConnection $ \conn -> liftIO $ PGS.query conn q (tname, Locked, jwName, jid, In [Queued, Retry])) >>= \case

572572 [] -> do

573573 log LevelDebug $ LogText $ toS $ "Job was locked by someone else before I could start. Skipping it. JobId=" <> show jid

574574 pure Nothing

575575 [Only (_ :: JobId)] -> pure $ Just jid

576− x -> error $ "WTF just happned? Was expecting a single row to be returned, received " ++ (show x)

576+ x -> error $ "WTF just happned? Was expecting a single row to be returned, received " ++ show x

577577

578578 withResource pool $ \monitorDbConn -> do

579− void $ liftIO $ PGS.execute monitorDbConn ("LISTEN ?") (Only $ pgEventName tname)

579+ void $ liftIO $ PGS.execute monitorDbConn "LISTEN ?" (Only $ pgEventName tname)

580580 forever $ do

581581 log LevelDebug $ LogText "[LISTEN/NOTIFY] Event loop"

582582 notif <- liftIO $ getNotification monitorDbConn

@@ -585,16 +585,16 @@ jobEventListener = do

585585 True -> do

586586 let pload = notificationData notif

587587 log LevelDebug $ LogText $ toS $ "NOTIFY | " <> show pload

588− case (eitherDecode $ toS pload) of

588+ case eitherDecode $ toS pload of

589589 Left e -> log LevelError $ LogText $ toS $ "Unable to decode notification payload received from Postgres. Payload=" <> show pload <> " Error=" <> show e

590590

591591 -- Checking if job needs to be fired immediately AND it is not already

592592 -- taken by some othe thread, by the time it got to us

593− Right (v :: Value) -> case (Aeson.parseMaybe parser v) of

593+ Right (v :: Value) -> case Aeson.parseMaybe parser v of

594594 Nothing -> log LevelError $ LogText $ toS $ "Unable to extract id/run_at/locked_at from " <> show pload

595595 Just (jid, runAt_, mLockedAt_) -> do

596596 t <- liftIO getCurrentTime

597− if (runAt_ <= t) && (isNothing mLockedAt_)

597+ if (runAt_ <= t) && isNothing mLockedAt_

598598 then do log LevelDebug $ LogText $ toS $ "Job needs needs to be run immediately. Attempting to fork in background. JobId=" <> show jid

599599 void $ async $ do

600600 -- Let's try to lock the job first... it is possible that it has already

@@ -654,12 +654,12 @@ scheduleJob :: ToJSON p

654654 -> IO Job

655655scheduleJob conn tname payload runAt = do

656656 let args = ( tname, runAt, Queued, toJSON payload, Nothing :: Maybe Value, 0 :: Int, Nothing :: Maybe Text, Nothing :: Maybe Text )

657− queryFormatter = toS <$> (PGS.formatQuery conn createJobQuery args)

657+ queryFormatter = toS <$> PGS.formatQuery conn createJobQuery args

658658 rs <- PGS.query conn createJobQuery args

659659 case rs of

660− [] -> (Prelude.error . (<> "Not expecting a blank result set when creating a job. Query=")) <$> queryFormatter

660+ [] -> Prelude.error . (<> "Not expecting a blank result set when creating a job. Query=") <$> queryFormatter

661661 [r] -> pure r

662− _ -> (Prelude.error . (<> "Not expecting multiple rows when creating a single job. Query=")) <$> queryFormatter

662+ _ -> Prelude.error . (<> "Not expecting multiple rows when creating a single job. Query=") <$> queryFormatter

663663

664664

665665-- getRunnerEnv :: (HasJobRunner m) => m RunnerEnv

src/OddJobs/Migrations.hs+2−2

@@ -69,6 +69,6 @@ createJobTable conn tname = void $ do

6969 , fnName

7070 )

7171 where

72− fnName = PGS.Identifier $ "notify_job_monitor_for_" <> (getTnameTxt tname)

73− trgName = PGS.Identifier $ "trg_notify_job_monitor_for_" <> (getTnameTxt tname)

72+ fnName = PGS.Identifier $ "notify_job_monitor_for_" <> getTnameTxt tname

73+ trgName = PGS.Identifier $ "trg_notify_job_monitor_for_" <> getTnameTxt tname

7474 getTnameTxt (PGS.QualifiedIdentifier _ tname') = tname'

src/OddJobs/Web.hs+19−19

@@ -181,8 +181,8 @@ filterJobsQuery UIConfig{uicfgTableName, uicfgJobTypeSql} Filter{..} =

181181 let qFragment = "(" <> uicfgJobTypeSql <> ")=?"

182182 build ys (q, vs) = case ys of

183183 [] -> (q, vs)

184− [y] -> (qFragment <> q, (toField y):vs)

185− (y:ys_) -> build ys_ (" OR " <> qFragment <> q, (toField y):vs)

184+ [y] -> (qFragment <> q, toField y : vs)

185+ (y:ys_) -> build ys_ (" OR " <> qFragment <> q, toField y : vs)

186186 in Just $ build xs (mempty, [])

187187

188188 jobRunnerClause :: Maybe (Query, [Action])

@@ -275,13 +275,13 @@ sideNav Routes{..} jobTypes jobRunnerNames _t filter@Filter{..} = do

275275 div_ [ class_ "card" ] $ do

276276 ul_ [ class_ "list-group list-group-flush" ] $ do

277277 li_ [ class_ ("list-group-item " <> if filterStatuses == [] then "active-nav" else "") ] $ do

278− let lnk = (rFilterResults $ Just filter{filterStatuses = [], filterPage = (OddJobs.Web.filterPage blankFilter)})

278+ let lnk = rFilterResults $ Just filter{filterStatuses = [], filterPage = OddJobs.Web.filterPage blankFilter}

279279 a_ [ href_ lnk ] $ do

280280 "all"

281281 -- span_ [ class_ "badge badge-pill badge-secondary float-right" ] "12"

282282 forM_ ((\\) (enumFrom minBound) [Job.Success]) $ \st -> do

283− li_ [ class_ ("list-group-item " <> if (st `elem` filterStatuses) then "active-nav" else "") ] $ do

284− let lnk = (rFilterResults $ Just filter{filterStatuses = [st], filterPage = Nothing})

283+ li_ [ class_ ("list-group-item " <> if st `elem` filterStatuses then "active-nav" else "") ] $ do

284+ let lnk = rFilterResults $ Just filter{filterStatuses = [st], filterPage = Nothing}

285285 a_ [ href_ lnk ] $ do

286286 toHtml $ toText st

287287 -- span_ [ class_ "badge badge-pill badge-secondary float-right" ] "12"

@@ -296,10 +296,10 @@ sideNav Routes{..} jobTypes jobRunnerNames _t filter@Filter{..} = do

296296 div_ [ class_ "card" ] $ do

297297 ul_ [ class_ "list-group list-group-flush" ] $ do

298298 li_ [ class_ ("list-group-item " <> if filterJobRunner == [] then "active-nav" else "") ] $ do

299− let lnk = (rFilterResults $ Just filter{filterJobRunner = [], filterPage = (OddJobs.Web.filterPage blankFilter)})

299+ let lnk = rFilterResults $ Just filter{filterJobRunner = [], filterPage = OddJobs.Web.filterPage blankFilter}

300300 a_ [ href_ lnk ] "all"

301301 forM_ jobRunnerNames $ \jr -> do

302− li_ [ class_ ("list-group-item" <> if (jr `elem` filterJobRunner) then " active-nav" else "")] $ do

302+ li_ [ class_ ("list-group-item" <> if jr `elem` filterJobRunner then " active-nav" else "")] $ do

303303 a_ [ href_ "#" ] $ toHtml $ unJobRunnerName jr

304304

305305 jobTypeFilters = do

@@ -312,10 +312,10 @@ sideNav Routes{..} jobTypes jobRunnerNames _t filter@Filter{..} = do

312312 div_ [ class_ "card" ] $ do

313313 ul_ [ class_ "list-group list-group-flush" ] $ do

314314 li_ [ class_ ("list-group-item " <> if filterJobTypes == [] then "active-nav" else "") ] $ do

315− let lnk = (rFilterResults $ Just filter{filterJobTypes = [], filterPage = (OddJobs.Web.filterPage blankFilter)})

315+ let lnk = rFilterResults $ Just filter{filterJobTypes = [], filterPage = OddJobs.Web.filterPage blankFilter}

316316 a_ [ href_ lnk ] "all"

317317 forM_ jobTypes $ \jt -> do

318− li_ [ class_ ("list-group-item" <> if (jt `elem` filterJobTypes) then " active-nav" else "")] $ do

318+ li_ [ class_ ("list-group-item" <> if jt `elem` filterJobTypes then " active-nav" else "")] $ do

319319 a_ [ href_ (rFilterResults $ Just filter{filterJobTypes=[jt]}) ] $ toHtml jt

320320

321321searchBar :: Routes -> UTCTime -> Filter -> Html ()

@@ -359,10 +359,10 @@ timeDuration from to = (diff, str)

359359 where

360360 str = if diff <= 0

361361 then "under 1s"

362− else (if d>0 then (show d) <> "d" else "") <>

363− (if m>0 then (show m) <> "m" else "") <>

364− (if s>0 then (show s) <> "s" else "")

365− diff = (abs $ round $ diffUTCTime from to)

362+ else (if d>0 then show d <> "d" else "") <>

363+ (if m>0 then show m <> "m" else "") <>

364+ (if s>0 then show s <> "s" else "")

365+ diff = abs $ round $ diffUTCTime from to

366366 (m', s) = diff `divMod` 60

367367 (h', m) = m' `divMod` 60

368368 (d, _h) = h' `divMod` 24

@@ -392,13 +392,13 @@ jobRow routes t (job@Job{..}, jobHtml) = do

392392 td_ jobHtml

393393 td_ $ do

394394 let actionsFn = case jobStatus of

395− Job.Success -> (const mempty)

395+ Job.Success -> const mempty

396396 Job.Failed -> actionsFailed

397397 Job.Queued -> if jobRunAt > t

398398 then actionsFuture

399399 else actionsWaiting

400400 Job.Retry -> actionsRetry

401− Job.Locked -> (const mempty)

401+ Job.Locked -> const mempty

402402 actionsFn routes job

403403

404404

@@ -492,13 +492,13 @@ resultsPanel routes@Routes{..} t filter@Filter{filterPage} js runningCount = do

492492 nextLink = do

493493 let (extraClass, lnk) = case filterPage of

494494 Nothing ->

495− if (DL.length js) < 10

495+ if DL.length js < 10

496496 then ("disabled", "")

497− else ("", (rFilterResults $ Just $ filter {filterPage = Just (10, 10)}))

497+ else ("", rFilterResults $ Just $ filter {filterPage = Just (10, 10)})

498498 Just (l, o) ->

499− if (DL.length js) < l

499+ if DL.length js < l

500500 then ("disabled", "")

501− else ("", (rFilterResults $ Just $ filter {filterPage = Just (l, o + l)}))

501+ else ("", rFilterResults $ Just $ filter {filterPage = Just (l, o + l)})

502502 li_ [ class_ ("page-item next " <> extraClass) ] $ do

503503 a_ [ class_ "page-link", href_ lnk ] "Next"

504504

test/Test.hs+35−35

@@ -65,24 +65,24 @@ main = do

6565#if MIN_VERSION_resource_pool(0,3,0)

6666 createAppPool = Pool.newPool $ Pool.PoolConfig

6767 (PGS.connect connInfo) -- create a new resource

68− (PGS.close) -- destroy resource

68+ PGS.close -- destroy resource

6969 (fromRational 10) -- number of seconds unused resources are kept around

7070 45

7171 createJobPool = Pool.newPool $ Pool.PoolConfig

7272 (PGS.connect connInfo) -- create a new resource

73− (PGS.close) -- destroy resource

73+ PGS.close -- destroy resource

7474 (fromRational 10) -- number of seconds unused resources are kept around

7575 45

7676#else

7777 createAppPool = Pool.createPool

7878 (PGS.connect connInfo) -- create a new resource

79− (PGS.close) -- destroy resource

79+ PGS.close -- destroy resource

8080 1 -- stripes

8181 (fromRational 10) -- number of seconds unused resources are kept around

8282 45

8383 createJobPool = Pool.createPool

8484 (PGS.connect connInfo) -- create a new resource

85− (PGS.close) -- destroy resource

85+ PGS.close -- destroy resource

8686 1 -- stripes

8787 (fromRational 10) -- number of seconds unused resources are kept around

8888 45

@@ -139,15 +139,15 @@ testPayload :: Value

139139testPayload = toJSON (10 :: Int)

140140

141141jobRunner :: Job.Job -> IO ()

142−jobRunner Job{jobPayload, jobAttempts} = case (fromJSON jobPayload) of

142+jobRunner Job{jobPayload, jobAttempts} = case fromJSON jobPayload of

143143 Aeson.Error e -> error e

144144 Success (j :: JobPayload) ->

145145 let recur pload idx = case pload of

146− PayloadAlwaysFail delay -> (delaySeconds delay) >> (error $ "Forced error after " <> show delay <> " seconds")

146+ PayloadAlwaysFail delay -> delaySeconds delay >> (error $ "Forced error after " <> show delay <> " seconds")

147147 PayloadSucceed delay -> void $ delaySeconds delay

148148 PayloadFail delay innerpload -> if idx<jobAttempts

149149 then recur innerpload (idx + 1)

150− else (delaySeconds delay) >> (error $ "Forced error after " <> show delay <> " seconds. step=" <> show idx)

150+ else delaySeconds delay >> (error $ "Forced error after " <> show delay <> " seconds. step=" <> show idx)

151151 PayloadThrowStringException s -> throwString s

152152 PayloadThrowDivideByZero -> seq (1 `div` 0 :: Integer) (pure ())

153153 in recur j 0

@@ -176,7 +176,7 @@ logEventToJob le = case le of

176176 Job.LogWebUIRequest -> Nothing

177177 Job.LogText _ -> Nothing

178178

179−assertJobIdStatus :: (HasCallStack)

179+assertJobIdStatus :: HasCallStack

180180 => Connection

181181 -> Job.TableName

182182 -> IORef [Job.LogEvent]

@@ -190,13 +190,13 @@ assertJobIdStatus conn tname logRef msg st jid = do

190190 case st of

191191 Job.Success ->

192192 assertBool (msg <> ": Success event not found in job-logs for JobId=" <> show jid) $

193− (flip DL.any) logs $ \case

193+ flip DL.any logs $ \case

194194 Job.LogJobSuccess j _ -> jid == Job.jobId j

195195 _ -> False

196196

197197 Job.Queued ->

198198 assertBool (msg <> ": Not expecting to find a queued job in the the job-logs JobId=" <> show jid) $

199− not $ (flip DL.any) logs $ \case

199+ not $ flip DL.any logs $ \case

200200 Job.LogJobStart j -> jid == Job.jobId j

201201 Job.LogJobSuccess j _ -> jid == Job.jobId j

202202 Job.LogJobFailed j _ _ _ -> jid == Job.jobId j

@@ -207,19 +207,19 @@ assertJobIdStatus conn tname logRef msg st jid = do

207207

208208 Job.Failed ->

209209 assertBool (msg <> ": Failed event not found in job-logs for JobId=" <> show jid) $

210− (flip DL.any) logs $ \case

210+ flip DL.any logs $ \case

211211 Job.LogJobFailed j _ _ _ -> jid == Job.jobId j

212212 _ -> False

213213

214214 Job.Retry ->

215215 assertBool (msg <> ": Failed event not found in job-logs for JobId=" <> show jid) $

216− (flip DL.any) logs $ \case

216+ flip DL.any logs $ \case

217217 Job.LogJobFailed j _ _ _ -> jid == Job.jobId j

218218 _ -> False

219219

220220 Job.Locked ->

221221 assertBool (msg <> ": Start event should be present in the log for a locked job JobId=" <> show jid) $

222− (flip DL.any) logs $ \case

222+ flip DL.any logs $ \case

223223 Job.LogJobStart j -> jid == Job.jobId j

224224 _ -> False

225225

@@ -228,16 +228,16 @@ assertJobIdStatus conn tname logRef msg st jid = do

228228 Nothing -> assertFailure $ "Not expecting job to be deleted. JobId=" <> show jid

229229 Just (Job{jobStatus}) -> assertEqual msg st jobStatus

230230

231−ensureJobId :: (HasCallStack) => Connection -> Job.TableName -> JobId -> IO Job

231+ensureJobId :: HasCallStack => Connection -> Job.TableName -> JobId -> IO Job

232232ensureJobId conn tname jid = Job.findJobByIdIO conn tname jid >>= \case

233233 Nothing -> error $ "Not expecting job to be deleted. JobId=" <> show jid

234234 Just j -> pure j

235235

236236-- withRandomTable :: (MonadIO m) => Pool Connection -> (Job.TableName -> m a) -> m a

237237withRandomTable jobPool action = do

238− (tname :: Job.TableName) <- liftIO ((fromString . ("jobs_" <>)) <$> (replicateM 10 (R.randomRIO ('a', 'z'))))

238+ (tname :: Job.TableName) <- liftIO (fromString . ("jobs_" <>) <$> replicateM 10 (R.randomRIO ('a', 'z')))

239239 finally

240− ((Pool.withResource jobPool $ \conn -> (liftIO $ Migrations.createJobTable conn tname)) >> (action tname))

240+ ((Pool.withResource jobPool $ \conn -> liftIO $ Migrations.createJobTable conn tname) >> action tname)

241241 (Pool.withResource jobPool $ \conn -> liftIO $ void $ PGS.execute conn "drop table if exists ?" (Only tname))

242242

243243testMaxAttempts :: Int

@@ -253,7 +253,7 @@ withNamedJobMonitor tname jobPool cfgFn actualTest = do

253253 tcache <- newTimeCache simpleTimeFormat'

254254 withTimedFastLogger tcache LogNone $ \tlogger -> do

255255 let flogger logLevel logEvent = do

256− tlogger $ \t -> toLogStr t <> " | " <> (Job.defaultLogStr Job.defaultJobType logLevel logEvent)

256+ tlogger $ \t -> toLogStr t <> " | " <> Job.defaultLogStr Job.defaultJobType logLevel logEvent

257257 atomicModifyIORef' logRef (\logs -> (logEvent:logs, ()))

258258 cfg = Job.mkConfig flogger tname jobPool Job.UnlimitedConcurrentJobs jobRunner (\cfg' -> cfgFn $ cfg'{Job.cfgDefaultMaxAttempts=testMaxAttempts})

259259 withAsync (Job.startJobRunner cfg) (const $ actualTest logRef)

@@ -263,7 +263,7 @@ payloadGen = Gen.recursive Gen.choice nonRecursive recursive

263263 where

264264 nonRecursive = [ PayloadAlwaysFail <$> Gen.element [1, 2, 3]

265265 , PayloadSucceed <$> Gen.element [1, 2, 3]]

266− recursive = [ PayloadFail <$> (Gen.element [1, 2, 3]) <*> payloadGen ]

266+ recursive = [ PayloadFail <$> Gen.element [1, 2, 3] <*> payloadGen ]

267267

268268testJobCreation appPool jobPool = testCase "job creation" $ do

269269 withNewJobMonitor jobPool $ \tname logRef -> do

@@ -282,7 +282,7 @@ testEnsureShutdown appPool jobPool = testCase "ensure shutdown" $ do

282282 scheduleJob tname = withNamedJobMonitor tname jobPool Prelude.id $ \logRef -> do

283283 t <- getCurrentTime

284284 Pool.withResource appPool $ \conn -> do

285− Job{jobId} <- Job.scheduleJob conn tname (PayloadSucceed 0) (addUTCTime (fromIntegral (2 * (unSeconds Job.defaultPollingInterval))) t)

285+ Job{jobId} <- Job.scheduleJob conn tname (PayloadSucceed 0) (addUTCTime (fromIntegral (2 * unSeconds Job.defaultPollingInterval)) t)

286286 assertJobIdStatus conn tname logRef "Job is scheduled in future, should still be queueud" Job.Queued jobId

287287 pure (jobId, logRef)

288288

@@ -331,15 +331,15 @@ testJobScheduling appPool jobPool = testCase "job scheduling" $ do

331331 job@Job{jobId} <- Job.scheduleJob conn tname (PayloadSucceed 0) (addUTCTime (fromIntegral (3600 :: Integer)) t)

332332 delaySeconds $ Seconds 2

333333 assertJobIdStatus conn tname logRef "Job is scheduled in the future. It should NOT have been successful by now" Job.Queued jobId

334− _ <- Job.saveJobIO conn tname job{jobRunAt = (addUTCTime (fromIntegral (-1 :: Integer)) t)}

335− delaySeconds (Job.defaultPollingInterval + (Seconds 2))

334+ _ <- Job.saveJobIO conn tname job{jobRunAt = addUTCTime (fromIntegral (-1 :: Integer)) t}

335+ delaySeconds (Job.defaultPollingInterval + Seconds 2)

336336 assertJobIdStatus conn tname logRef "Job had a runAt date in the past. It should have been successful by now" Job.Success jobId

337337

338338testJobFailure appPool jobPool = testCase "job failure" $ do

339339 withNewJobMonitor jobPool $ \tname _logRef -> do

340340 Pool.withResource appPool $ \conn -> do

341341 Job{jobId} <- Job.createJob conn tname (PayloadAlwaysFail 0)

342− delaySeconds $ (calculateRetryDelay testMaxAttempts) + (Seconds 3)

342+ delaySeconds $ calculateRetryDelay testMaxAttempts + Seconds 3

343343 Job{jobAttempts, jobStatus} <- ensureJobId conn tname jobId

344344 assertEqual "Exepcting job to be in Failed status" Job.Failed jobStatus

345345 assertEqual ("Expecting job attempts to be 3. Found " <> show jobAttempts) 3 jobAttempts

@@ -531,7 +531,7 @@ timeGen t d = do

531531 pure $ Time.timeSince t (fromInteger i) u d

532532

533533anyTimeGen :: MonadGen m => UTCTime -> m UTCTime

534−anyTimeGen t = (Gen.element (enumFrom Time.Ago)) >>= (timeGen t)

534+anyTimeGen t = Gen.element (enumFrom Time.Ago) >>= timeGen t

535535

536536futureTimeGen :: MonadGen m => UTCTime -> m UTCTime

537537futureTimeGen t = timeGen t Time.FromThat

@@ -584,7 +584,7 @@ genFilter t = do

584584 Nothing -> Gen.maybe (anyTimeGen t)

585585 Just x -> Gen.maybe (futureTimeGen x)

586586 orderClause <- Gen.maybe ((,) <$> (Gen.element $ enumFrom Web.OrdCreatedAt) <*> (Gen.element $ enumFrom Web.Asc))

587− limitOffset <- Gen.maybe ((,) <$> (Gen.int (Range.constant 5 10)) <*> (Gen.int (Range.constant 0 30)))

587+ limitOffset <- Gen.maybe ((,) <$> Gen.int (Range.constant 5 10) <*> Gen.int (Range.constant 0 30))

588588 runAfter <- Gen.maybe (futureTimeGen t)

589589 pure Web.blankFilter

590590 { filterStatuses = statuses

@@ -602,21 +602,21 @@ filterJobs :: Filter -> [Job] -> [Job]

602602filterJobs Web.Filter{filterStatuses, filterCreatedAfter, filterCreatedBefore, filterUpdatedAfter, filterUpdatedBefore, filterOrder, filterPage, filterRunAfter} js =

603603 applyLimitOffset $

604604 applyOrdering (fromMaybe (Web.OrdUpdatedAt, Web.Desc) filterOrder) $

605− (flip DL.filter) js $ \j -> (filterByStatus j) &&

606− (filterByCreatedAfter j) &&

607− (filterByCreatedBefore j) &&

608− (filterByUpdatedAfter j) &&

609− (filterByUpdatedBefore j) &&

610− (filterByRunAfter j)

605+ flip DL.filter js $ \j -> filterByStatus j &&

606+ filterByCreatedAfter j &&

607+ filterByCreatedBefore j &&

608+ filterByUpdatedAfter j &&

609+ filterByUpdatedBefore j &&

610+ filterByRunAfter j

611611 where

612− applyLimitOffset = maybe Prelude.id (\(l, o) -> (Prelude.take l). (Prelude.drop o)) filterPage

612+ applyLimitOffset = maybe Prelude.id (\(l, o) -> Prelude.take l . Prelude.drop o) filterPage

613613

614614 applyOrdering (fld, dir) lst =

615615 let comparer = resultOrder $ case fld of

616− Web.OrdCreatedAt -> (comparing jobCreatedAt)

617− Web.OrdUpdatedAt -> (comparing jobUpdatedAt)

618− Web.OrdLockedAt -> (comparing jobLockedAt)

619− Web.OrdStatus -> (comparing jobStatus)

616+ Web.OrdCreatedAt -> comparing jobCreatedAt

617+ Web.OrdUpdatedAt -> comparing jobUpdatedAt

618+ Web.OrdLockedAt -> comparing jobLockedAt

619+ Web.OrdStatus -> comparing jobStatus

620620 Web.OrdJobType -> comparing Job.defaultJobType

621621 resultOrder fn x y = case fn x y of

622622 EQ -> compare (Down $ jobId x) (Down $ jobId y)