a2edc92 · sc-build · git.iko.soy

src/Control/Task/Scheduler.hs+1−3

compare with master

unifiedsplit

@@ -3,6 +3,7 @@

3module Control.Task.Scheduler

4 ( scheduleTask,

5 runTasks,

6+ makeAllRunnable,

6 )

7 )

7where

8where

8

9

@@ -45,7 +46,6 @@ rescheduleTaskTime ::

45rescheduleTaskTime = rescheduleTaskQuery

46rescheduleTaskTime = rescheduleTaskQuery

46

47

47class RunTasks (ts :: [*]) m where

48class RunTasks (ts :: [*]) m where

48−

49 runTask :: WithLog env Message m => PickedTask -> m ()

50

51 taskNames :: [String]

@@ -55,7 +55,6 @@ instance

55 (Task t ts, TaskMonad t m, StaticPQ m, RunTasks tt m, MonadUnliftIO m) =>

56 RunTasks (t ': tt) m

57 where

58−

59 runTask (PickedTask s (Jsonb v) initialStartTime) | symbolVal @ts Proxy == s =

58 runTask (PickedTask s (Jsonb v) initialStartTime) | symbolVal @ts Proxy == s =

60 case fromJSON @t v of

59 case fromJSON @t v of

61 A.Error e ->

60 A.Error e ->

@@ -79,7 +78,6 @@ instance

79 taskNames = symbolVal @ts Proxy : taskNames @tt @m

78 taskNames = symbolVal @ts Proxy : taskNames @tt @m

80

79

81instance RunTasks '[] m where

80instance RunTasks '[] m where

82−

83 runTask (PickedTask s (Jsonb v) _) =

81 runTask (PickedTask s (Jsonb v) _) =

84 logError . T.pack $ "Unknown task " <> s <> " with payload " <> show v

82 logError . T.pack $ "Unknown task " <> s <> " with payload " <> show v

85

83

src/Control/Task/Scheduler/Query.hs+15

@@ -5,6 +5,7 @@ module Control.Task.Scheduler.Query

5 completeTaskQuery,

6 rescheduleTaskQuery,

7 pickTasksQuery,

8+ makeAllRunnable,

8 PickedTask (..),

9 PickedTask (..),

9 )

10 )

10where

11where

@@ -132,3 +133,17 @@ data PickedTask

132 creationTime :: UTCTime

133 creationTime :: UTCTime

133 }

134 }

134 deriving (Eq, Show, Generic, SOP.Generic, SOP.HasDatatypeInfo)

135 deriving (Eq, Show, Generic, SOP.Generic, SOP.HasDatatypeInfo)

136+

137+makeAllRunnable ::

138+ (StaticPQ m, WithLog env Message m, MonadUnliftIO m) =>

139+ m ()

140+makeAllRunnable = do

141+ let startAll :: Manipulation_ Schema () ()

142+ startAll =

143+ update_

144+ #tasks

145+ ( Set false `as` #started

146+ )

147+ (notNull #started)

148+ dbWrite (const $ return ()) $

149+ manipulate_ startAll

src/Server.hs+5

@@ -193,6 +193,11 @@ runServer = do

193 repeatIfNotEmpty n f

194 printingErrors =

195 handleAny (logError . T.pack . displayException >=> const (return 0))

196+ usingConnectionPool pool

197+ . (`runReaderT` serverData)

198+ . unApp

199+ . handleAny (error . displayException)

200+ $ makeAllRunnable

196 replicateM_ builderCount

201 replicateM_ builderCount

197 $ forkIO . repeatIfNotEmpty (10 ^ (6 :: Int))

202 $ forkIO . repeatIfNotEmpty (10 ^ (6 :: Int))

198 . usingConnectionPool pool

203 . usingConnectionPool pool