From 1a11fb5e4ad891d4f3230f386e78de3f6499fd30 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 3 Mar 2022 18:13:30 +0100
Subject: mapserver: somewhat more decent logging

---
 server/Main.hs | 16 +++++++---------
 1 file changed, 7 insertions(+), 9 deletions(-)

(limited to 'server/Main.hs')

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
-- 
cgit v1.2.3