on master help sign in
Added builderCount
commit1b7e15557df0b9b412d12b5d533fe1d579d9b136 authoriko <ilyakooo0@gmail.com> dateMon 24 Feb 2020, 14:20 (7 years ago) parent4597fdc
4 files changed+49−31
src/Control/Task/Scheduler/Query.hs+17−4 src/Server.hs+3−3 src/Server/Config.hs+4−2 src/Server/Schema/V1.hs+25−22
src/Control/Task/Scheduler/Query.hs+17−4
@@ -10,6 +10,7 @@ module Control.Task.Scheduler.Query
1010where
1111
1212import Colog
13+import Control.Arrow
1314import Control.Monad.IO.Unlift
1415import Control.Squeal
1516import Control.Task
@@ -38,6 +39,7 @@ scheduleTaskQuery task = do
3839 Set (param @1) `as` #task
3940 :* Set (param @2) `as` #payload
4041 :* Default `as` #creation_time
42+ :* Default `as` #started
4143 )
4244 ( OnConflict
4345 (OnConstraint #pk_task_payload)
@@ -82,7 +84,9 @@ rescheduleTaskQuery payload = do
8284 query =
8385 update_
8486 #tasks
85− (Default `as` #creation_time)
87+ ( Default `as` #creation_time
88+ :* Default `as` #started
89+ )
8690 (param @1 .== #task .&& param @2 .== #payload)
8791 dbWrite (const $ return ()) $
8892 manipulateParams_
@@ -106,11 +110,20 @@ pickTasksQuery tasks limitCount = do
106110 )
107111 ( from (table #tasks)
108112 & where_ (#task `in_` (literal <$> tasks))
109− & orderBy [#creation_time & Asc]
113+ & where_ (not_ . notNull $ #started)
110114 & limit limitCount
111115 )
112− dbRead (const $ return []) $
113− runQuery query >>= getRows
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)
123+ dbWrite (const $ return []) $ do
124+ pickedTasks <- runQuery query >>= getRows
125+ traversePrepared_ startedMan $ (task &&& payload) <$> pickedTasks
126+ return pickedTasks
114127
115128data PickedTask
116129 = PickedTask
src/Server.hs+3−3
@@ -193,13 +193,13 @@ runServer = do
193193 repeatIfNotEmpty n f
194194 printingErrors =
195195 handleAny (logError . T.pack . displayException >=> const (return 0))
196− _ <-
197− forkIO . repeatIfNotEmpty (10 ^ (6 :: Int))
196+ replicateM_ builderCount
197+ $ forkIO . repeatIfNotEmpty (10 ^ (6 :: Int))
198198 . usingConnectionPool pool
199199 . (`runReaderT` serverData)
200200 . unApp
201201 . printingErrors
202− $ runTasks @'[Build] 1
202+ $ runTasks @'[Build] 1
203203 _ <-
204204 forkIO . repeatIfNotEmpty (10 ^ (6 :: Int))
205205 . usingConnectionPool pool
src/Server/Config.hs+4−2
@@ -31,7 +31,8 @@ data Config
3131 baseSiteUrl :: !String,
3232 cfgDockerUrl :: !String,
3333 cfgDockerFile :: !FilePath,
34− logSeverity :: !Severity
34+ logSeverity :: !Severity,
35+ builderCount :: !Int
3536 }
3637 deriving (Show, Generic)
3738
@@ -58,7 +59,8 @@ defaultConfig =
5859 baseSiteUrl = "http://localhost:8080",
5960 cfgDockerUrl = "http://localhost:1234",
6061 cfgDockerFile = "TmpDockerfile",
61− logSeverity = Info
62+ logSeverity = Info,
63+ builderCount = 2
6264 }
6365
6466getConfig :: IO Config
src/Server/Schema/V1.hs+25−22
@@ -18,7 +18,8 @@ type SchemaV1 =
1818 ]
1919 :=> '[ "task" ::: 'NoDef :=> 'NotNull (PG Text),
2020 "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)
2223 ]
2324 ),
2425 "submissions"
@@ -34,28 +35,30 @@ type SchemaV1 =
3435 ]
3536
3637schemaMigrationV1 :: Migration Definition (Public '[]) SchemaV1
37−schemaMigrationV1 = Migration
38− { name = "v1",
39− up =
40− createTable
41− #tasks
42− ( notNullable text `as` #task
43− :* notNullable jsonb `as` #payload
44− :* 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
50− :* notNullable text `as` #repo_full_name
51− :* notNullable text `as` #problem
52− :* notNullable text `as` #sha
53− :* notNullable jsonb `as` #status
38+schemaMigrationV1 =
39+ Migration
40+ { name = "v1",
41+ up =
42+ createTable
43+ #tasks
44+ ( notNullable text `as` #task
45+ :* notNullable jsonb `as` #payload
46+ :* default_ now (notNullable timestampWithTimeZone) `as` #creation_time
47+ :* default_ false (notNullable bool) `as` #started
5448 )
55− (primaryKey (#repo_full_name :* #sha) `as` #pk_submission_repo_full_name_sha)
56− >>> createIndexes,
57− down = dropTable #tasks >>> dropTable #submissions
58− }
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+ )
58+ (primaryKey (#repo_full_name :* #sha) `as` #pk_submission_repo_full_name_sha)
59+ >>> createIndexes,
60+ down = dropTable #tasks >>> dropTable #submissions
61+ }
5962 where
6063 createIndexes :: Definition sch sch
6164 createIndexes =