master..f557551 · sc-build

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

since splitsnapshots

unifiedsplit

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

21import GHC.TypeLits

22import Server.Schema

23import Squeal.PostgreSQL

24−import UnliftIO.Exception

25

24

26scheduleTask ::

25scheduleTask ::

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

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

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

67 <> e

66 <> e

68 A.Success t -> do

67 A.Success t -> do

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

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

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

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

71− logError . T.pack . displayException $ e

72− return Failure

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

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

74 case r of

71 case r of

75 Success -> completeTaskQuery t

72 Success -> completeTaskQuery t

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

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

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

42 :* Default `as` #creation_time

43 :* Default `as` #started

44− :* Default `as` #failures

45 )

44 )

46 ( OnConflict

45 ( OnConflict

47 (OnConstraint #pk_task_payload)

46 (OnConstraint #pk_task_payload)

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

88 #tasks

87 #tasks

89 ( Default `as` #creation_time

88 ( Default `as` #creation_time

90 :* Default `as` #started

89 :* Default `as` #started

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

92 )

90 )

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

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

94 dbWrite (const $ return ()) $

92 dbWrite (const $ return ()) $

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

114 ( from (table #tasks)

112 ( from (table #tasks)

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

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

116 & where_ (not_ . notNull $ #started)

114 & where_ (not_ . notNull $ #started)

117− & where_ (#failures .< 20)

118 & orderBy [#creation_time & Asc]

115 & orderBy [#creation_time & Asc]

119 & limit limitCount

116 & limit limitCount

120 & orderBy [#creation_time & Desc]

117 & orderBy [#creation_time & Desc]

src/Server/Schema.hs+1−3

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

6where

7

8import Server.Schema.V1

9−import Server.Schema.V2

10import Squeal.PostgreSQL

9import Squeal.PostgreSQL

11

10

12type StaticPQ m = MonadPQ Schema m

11type StaticPQ m = MonadPQ Schema m

13

12

14−type Schema = SchemaV2

13+type Schema = SchemaV1

15

14

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

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

17migration =

16migration =

18 pureMigration schemaMigrationV1

17 pureMigration schemaMigrationV1

19− :>> pureMigration schemaMigrationV2

20 :>> Done

18 :>> Done

src/Server/Schema/V2.hsdeleted−46

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

1−module Server.Schema.V2

2− ( SchemaV2,

3− schemaMigrationV2,

4− )

5−where

6−

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− }