f557551...master · sc-build

git.iko.soy/sc-build

4 files changed+56−2

since splitsnapshots

unifiedsplit

src/Control/Task/Scheduler.hs+4−1 src/Control/Task/Scheduler/Query.hs+3 src/Server/Schema.hs+3−1 src/Server/Schema/V2.hs+46

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

@@ -21,6 +21,7 @@ import Data.Word

2121import GHC.TypeLits

2222import Server.Schema

2323import Squeal.PostgreSQL

24+import UnliftIO.Exception

2425

2526scheduleTask ::

2627 (StaticPQ m, WithLog env Message m, Task t s, MonadUnliftIO m) =>

@@ -66,7 +67,9 @@ instance

6667 <> e

6768 A.Success t -> do

6869 logInfo . T.pack $ "running task " <> task <> " with " <> show t <> " created at " <> show initialStartTime

69− r <- performTask @t @ts @m t

70+ r <- performTask @t @ts @m t `catchAny` \e -> do

71+ logError . T.pack . displayException $ e

72+ return Failure

7073 when (r == Failure) $ logWarning . T.pack $ "Task " <> task <> " failed"

7174 case r of

7275 Success -> completeTaskQuery t

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

@@ -41,6 +41,7 @@ scheduleTaskQuery task = do

4141 :* Set (param @2) `as` #payload

4242 :* Default `as` #creation_time

4343 :* Default `as` #started

44+ :* Default `as` #failures

4445 )

4546 ( OnConflict

4647 (OnConstraint #pk_task_payload)

@@ -87,6 +88,7 @@ rescheduleTaskQuery payload = do

8788 #tasks

8889 ( Default `as` #creation_time

8990 :* Default `as` #started

91+ :* Set (#failures + 1) `as` #failures

9092 )

9193 (param @1 .== #task .&& param @2 .== #payload)

9294 dbWrite (const $ return ()) $

@@ -112,6 +114,7 @@ pickTasksQuery tasks limitCount = do

112114 ( from (table #tasks)

113115 & where_ (#task `in_` (literal <$> tasks))

114116 & where_ (not_ . notNull $ #started)

117+ & where_ (#failures .< 20)

115118 & orderBy [#creation_time & Asc]

116119 & limit limitCount

117120 & orderBy [#creation_time & Desc]

src/Server/Schema.hs+3−1

@@ -6,13 +6,15 @@ module Server.Schema

66where

88import Server.Schema.V1

9+import Server.Schema.V2

910import Squeal.PostgreSQL

1011

1112type StaticPQ m = MonadPQ Schema m

1213

13−type Schema = SchemaV1

14+type Schema = SchemaV2

1415

1516migration :: AlignedList (Migration (Terminally PQ IO)) (Public '[]) Schema

1617migration =

1718 pureMigration schemaMigrationV1

19+ :>> pureMigration schemaMigrationV2

1820 :>> Done

src/Server/Schema/V2.hsnew file+46

@@ -0,0 +1,46 @@

1+module Server.Schema.V2

2+ ( SchemaV2,

3+ schemaMigrationV2,

4+ )

5+where

7+import Data.Aeson

8+import Data.Int

9+import Data.Submission

10+import Data.Text (Text)

11+import Data.Time

12+import Server.Schema.V1

13+import Squeal.PostgreSQL

14+

15+type SchemaV2 =

16+ Public

17+ '[ "tasks"

18+ ::: 'Table

19+ ( '[ "pk_task_payload" :=> 'PrimaryKey '["task", "payload"]

20+ ]

21+ :=> '[ "task" ::: 'NoDef :=> 'NotNull (PG Text),

22+ "payload" ::: 'NoDef :=> 'NotNull (PG (Jsonb Value)),

23+ "creation_time" ::: 'Def :=> 'NotNull (PG UTCTime),

24+ "started" ::: 'Def :=> 'NotNull (PG Bool),

25+ "failures" ::: 'Def :=> 'NotNull (PG Int32)

26+ ]

27+ ),

28+ "submissions"

29+ ::: 'Table

30+ ( '["pk_submission_repo_full_name_sha" :=> 'PrimaryKey '["repo_full_name", "sha"]]

31+ :=> '[ "user_name" ::: 'NoDef :=> 'NotNull (PG String),

32+ "repo_full_name" ::: 'NoDef :=> 'NotNull (PG String),

33+ "problem" ::: 'NoDef :=> 'NotNull (PG String),

34+ "sha" ::: 'NoDef :=> 'NotNull (PG String),

35+ "status" ::: 'NoDef :=> 'NotNull (PG (Jsonb SubmissionStatus))

36+ ]

37+ )

38+ ]

39+

40+schemaMigrationV2 :: Migration Definition SchemaV1 SchemaV2

41+schemaMigrationV2 =

42+ Migration

43+ { name = "v2",

44+ up = alterTable #tasks (addColumn #failures (default_ 0 $ notNullable int)),

45+ down = alterTable #tasks (dropColumn #failures)

46+ }