diff options
Diffstat (limited to 'server/Main.hs')
| -rw-r--r-- | server/Main.hs | 16 |
1 files changed, 7 insertions, 9 deletions
diff --git a/server/Main.hs b/server/Main.hs index cb1a65b..d9a8db7 100644 --- a/server/Main.hs +++ b/server/Main.hs @@ -49,6 +49,7 @@ import Worker (Job (Job), linterThread) import Servant.API (Header) import Servant.Client (ClientM, client, mkClientEnv, runClientM) +import Control.Monad.Logger (logInfoN, runStdoutLoggingT) type family PolyEndpoint method format payload where PolyEndpoint Get format payload = @@ -94,8 +95,6 @@ main = do config <- loadConfig "./config.toml" 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 … loggerMiddleware <- mkRequestLogger $ def { outputFormat = Detailed (view verbose config) } @@ -104,8 +103,6 @@ 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) @@ -115,13 +112,13 @@ main = do -- TODO: what about tls / https? whenJust (view exneuland config) $ \baseurl -> do manager' <- newManager defaultManagerSettings - updater <- async $ forever $ do + updater <- async $ runStdoutLoggingT $ forever $ do done <- readMVar state - res <- runClientM + res <- liftIO $ runClientM (postNewMaps (view token config) (MapService done)) (mkClientEnv manager' baseurl) - print res - threadDelay (view interval config * 1000000) + logInfoN $ "exneuland maps POST request: " <> show res + liftIO $ threadDelay (view interval config * 1000000) link updater -- spawns threads for each job in the queue @@ -133,6 +130,7 @@ main = do setPort (view port config) defaultSettings + putTextLn $ "starting server on port " <> show (view port config) runSettings warpsettings . loggerMiddleware $ app state @@ -140,4 +138,4 @@ main = do waitEither_ linter poker where showInfo org = - "→ org "+|orgSlug org|+" divoc ("+|length (orgRepos org)|+" repositoryies)\n" :: Text + "→ org "+|orgSlug org|+" ("+|length (orgRepos org)|+" repositories)\n" :: Text |