summaryrefslogtreecommitdiff
path: root/server/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--server/Main.hs16
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