diff options
author | stuebinm | 2022-02-16 15:32:57 +0100 |
---|---|---|
committer | stuebinm | 2022-02-16 15:32:57 +0100 |
commit | 1fed9563fd75e6528740471f04746138284257b3 (patch) | |
tree | ac019f57296aeae244f170c7d6e73b964c8d402a /server/Main.hs | |
parent | 662a01a74a13979830dacf1dc8c18161040f32cc (diff) |
internal state: sort according to org
(also, more lenses i guess)
Diffstat (limited to '')
-rw-r--r-- | server/Main.hs | 13 |
1 files changed, 8 insertions, 5 deletions
diff --git a/server/Main.hs b/server/Main.hs index 02f7ed3..0d5dfd6 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -37,19 +37,20 @@ import Servant.HTML.Lucid (HTML) import Servant.Server.StaticFiles (serveDirectoryWebApp) import Server (JobStatus, Org (..), ServerState, Sha1, - defaultState, interval, + emptyState, interval, loadConfig, orgs, port, - verbose) + unState, verbose) import Worker (Job (Job), linterThread) --- | Main API type +-- | abstract api type API format = -- "submit" :> ReqBody '[JSON] RemoteRef :> Post '[format] UUID - "status" :> Capture "jobid" Sha1 :> Get '[format] JobStatus + "status" :> Capture "org" Text :> Capture "jobid" Sha1 :> Get '[format] JobStatus -- :<|> "relint" :> Capture "jobid" UUID :> Get '[format] NoContent :<|> "admin" :> "overview" :> Get '[format] AdminOverview +-- | actual set of routes: api for json & html + static pages from disk type Routes = "api" :> API JSON :<|> API HTML -- websites mirror the API exactly :<|> Raw @@ -71,7 +72,7 @@ app = serve (Proxy @Routes) . server main :: IO () main = do config <- loadConfig "./config.toml" - state <- newMVar defaultState + state <- newMVar (emptyState config) queue :: TQueue Job <- newTQueueIO -- TODO: i really don't like all this cli logging stuff, replace it with -- fast-logger at some point … @@ -84,6 +85,8 @@ main = do -- periodically ‘pokes’ jobs to re-lint each repo poker <- async $ forever $ do + readMVar state >>= \state -> + print (length $ view unState state) atomically $ forM_ (view orgs config) $ \org -> forM_ (orgRepos org) $ \repo -> writeTQueue queue (Job repo org) |