diff options
| author | stuebinm | 2022-02-16 15:32:57 +0100 |
|---|---|---|
| committer | stuebinm | 2022-03-19 19:26:32 +0100 |
| commit | 410151c85b1e6c7629934e0ef0bc199d92da64e9 (patch) | |
| tree | 7c6ad2d51e5a3606b9a91d9895236ad55d0e0db0 /server/Main.hs | |
| parent | 3e0026151485858de6025f27eebe1f941329687a (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) |