git.iko.soy/sc-build
on master help sign in
Added builderCount
1b7e155iko
src/Control/Task/Scheduler/Query.hs+17−4
compare with master
unifiedsplit
@@ -10,6 +10,7 @@ module Control.Task.Scheduler.Query
10where
10where
11
11
12import Colog
12import Colog
13+import Control.Arrow
13import Control.Monad.IO.Unlift
14import Control.Monad.IO.Unlift
14import Control.Squeal
15import Control.Squeal
15import Control.Task
16import Control.Task
@@ -38,6 +39,7 @@ scheduleTaskQuery task = do
38 Set (param @1) `as` #task
39 Set (param @1) `as` #task
39 :* Set (param @2) `as` #payload
40 :* Set (param @2) `as` #payload
40 :* Default `as` #creation_time
41 :* Default `as` #creation_time
42+ :* Default `as` #started
41 )
43 )
42 ( OnConflict
44 ( OnConflict
43 (OnConstraint #pk_task_payload)
45 (OnConstraint #pk_task_payload)
@@ -82,7 +84,9 @@ rescheduleTaskQuery payload = do
82 query =
84 query =
83 update_
85 update_
84 #tasks
86 #tasks
85− (Default `as` #creation_time)
87+ ( Default `as` #creation_time
88+ :* Default `as` #started
89+ )
86 (param @1 .== #task .&& param @2 .== #payload)
90 (param @1 .== #task .&& param @2 .== #payload)
87 dbWrite (const $ return ()) $
91 dbWrite (const $ return ()) $
88 manipulateParams_
92 manipulateParams_
@@ -106,11 +110,20 @@ pickTasksQuery tasks limitCount = do
106 )
110 )
107 ( from (table #tasks)
111 ( from (table #tasks)
108 & where_ (#task `in_` (literal <$> tasks))
112 & where_ (#task `in_` (literal <$> tasks))
109− & orderBy [#creation_time & Asc]
113+ & where_ (not_ . notNull $ #started)
110 & limit limitCount
114 & limit limitCount
111 )
115 )
116+ startedMan :: Manipulation_ Schema (String, Jsonb Value) ()
117+ startedMan =
118+ update_
119+ #tasks
120+ ( Set true `as` #started
121+ )
122+ (param @1 .== #task .&& param @2 .== #payload)
112− dbRead (const $ return []) $
123+ dbWrite (const $ return []) $ do
113− runQuery query >>= getRows
124+ pickedTasks <- runQuery query >>= getRows
125+ traversePrepared_ startedMan $ (task &&& payload) <$> pickedTasks
126+ return pickedTasks
114
127
115data PickedTask
128data PickedTask
116 = PickedTask
129 = PickedTask
src/Server.hs+3−3
@@ -193,13 +193,13 @@ runServer = do
193 repeatIfNotEmpty n f
193 repeatIfNotEmpty n f
194 printingErrors =
194 printingErrors =
195 handleAny (logError . T.pack . displayException >=> const (return 0))
195 handleAny (logError . T.pack . displayException >=> const (return 0))
196− _ <-
196+ replicateM_ builderCount
197− forkIO . repeatIfNotEmpty (10 ^ (6 :: Int))
197+ $ forkIO . repeatIfNotEmpty (10 ^ (6 :: Int))
198 . usingConnectionPool pool
198 . usingConnectionPool pool
199 . (`runReaderT` serverData)
199 . (`runReaderT` serverData)
200 . unApp
200 . unApp
201 . printingErrors
201 . printingErrors
202− $ runTasks @'[Build] 1
202+ $ runTasks @'[Build] 1
203 _ <-
203 _ <-
204 forkIO . repeatIfNotEmpty (10 ^ (6 :: Int))
204 forkIO . repeatIfNotEmpty (10 ^ (6 :: Int))
205 . usingConnectionPool pool
205 . usingConnectionPool pool
src/Server/Config.hs+4−2
@@ -31,7 +31,8 @@ data Config
31 baseSiteUrl :: !String,
31 baseSiteUrl :: !String,
32 cfgDockerUrl :: !String,
32 cfgDockerUrl :: !String,
33 cfgDockerFile :: !FilePath,
33 cfgDockerFile :: !FilePath,
34− logSeverity :: !Severity
34+ logSeverity :: !Severity,
35+ builderCount :: !Int
35 }
36 }
36 deriving (Show, Generic)
37 deriving (Show, Generic)
37
38
@@ -58,7 +59,8 @@ defaultConfig =
58 baseSiteUrl = "http://localhost:8080",
59 baseSiteUrl = "http://localhost:8080",
59 cfgDockerUrl = "http://localhost:1234",
60 cfgDockerUrl = "http://localhost:1234",
60 cfgDockerFile = "TmpDockerfile",
61 cfgDockerFile = "TmpDockerfile",
61− logSeverity = Info
62+ logSeverity = Info,
63+ builderCount = 2
62 }
64 }
63
65
64getConfig :: IO Config
66getConfig :: IO Config
src/Server/Schema/V1.hs+25−22
@@ -18,7 +18,8 @@ type SchemaV1 =
18 ]
18 ]
19 :=> '[ "task" ::: 'NoDef :=> 'NotNull (PG Text),
19 :=> '[ "task" ::: 'NoDef :=> 'NotNull (PG Text),
20 "payload" ::: 'NoDef :=> 'NotNull (PG (Jsonb Value)),
20 "payload" ::: 'NoDef :=> 'NotNull (PG (Jsonb Value)),
21− "creation_time" ::: 'Def :=> 'NotNull (PG UTCTime)
21+ "creation_time" ::: 'Def :=> 'NotNull (PG UTCTime),
22+ "started" ::: 'Def :=> 'NotNull (PG Bool)
22 ]
23 ]
23 ),
24 ),
24 "submissions"
25 "submissions"
@@ -34,28 +35,30 @@ type SchemaV1 =
34 ]
35 ]
35
36
36schemaMigrationV1 :: Migration Definition (Public '[]) SchemaV1
37schemaMigrationV1 :: Migration Definition (Public '[]) SchemaV1
37−schemaMigrationV1 = Migration
38+schemaMigrationV1 =
39+ Migration
38− { name = "v1",
40+ { name = "v1",
39− up =
41+ up =
40− createTable
42+ createTable
41− #tasks
43+ #tasks
42− ( notNullable text `as` #task
44+ ( notNullable text `as` #task
43− :* notNullable jsonb `as` #payload
45+ :* notNullable jsonb `as` #payload
44− :* default_ now (notNullable timestampWithTimeZone) `as` #creation_time
46+ :* default_ now (notNullable timestampWithTimeZone) `as` #creation_time
45− )
46− (primaryKey (#task :* #payload) `as` #pk_task_payload)
47− >>> createTable
48− #submissions
49− ( notNullable text `as` #user_name
47+ :* default_ false (notNullable bool) `as` #started
50− :* notNullable text `as` #repo_full_name
51− :* notNullable text `as` #problem
52− :* notNullable text `as` #sha
53− :* notNullable jsonb `as` #status
54 )
48 )
49+ (primaryKey (#task :* #payload) `as` #pk_task_payload)
50+ >>> createTable
51+ #submissions
52+ ( notNullable text `as` #user_name
53+ :* notNullable text `as` #repo_full_name
54+ :* notNullable text `as` #problem
55+ :* notNullable text `as` #sha
56+ :* notNullable jsonb `as` #status
57+ )
55− (primaryKey (#repo_full_name :* #sha) `as` #pk_submission_repo_full_name_sha)
58+ (primaryKey (#repo_full_name :* #sha) `as` #pk_submission_repo_full_name_sha)
56− >>> createIndexes,
59+ >>> createIndexes,
57− down = dropTable #tasks >>> dropTable #submissions
60+ down = dropTable #tasks >>> dropTable #submissions
58− }
61+ }
59 where
62 where
60 createIndexes :: Definition sch sch
63 createIndexes :: Definition sch sch
61 createIndexes =
64 createIndexes =