From 487e06bf875ba8a835399b26095c756899b1209f Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Thu, 17 Feb 2022 00:06:22 +0100
Subject: server: remove a thunk leak

(really a lot of these data structures should be eagerly evaluated into
normal form, i suspect there's still a lot to be gained)
---
 server/Main.hs | 28 +++++++++++++---------------
 1 file changed, 13 insertions(+), 15 deletions(-)

(limited to 'server/Main.hs')

diff --git a/server/Main.hs b/server/Main.hs
index 1a18c6a..d9c548b 100644
--- a/server/Main.hs
+++ b/server/Main.hs
@@ -31,9 +31,9 @@ import           Network.Wai.Middleware.RequestLogger (OutputFormat (..),
                                                        RequestLoggerSettings (..),
                                                        mkRequestLogger)
 import           Servant                              (Application, Capture,
-                                                       EmptyAPI, Get, JSON,
-                                                       PlainText, Post, Raw,
-                                                       ReqBody, Server, serve,
+                                                       Get, JSON, PlainText,
+                                                       Post, Raw, ReqBody,
+                                                       Server, serve,
                                                        type (:<|>) (..),
                                                        type (:>))
 import           Servant.HTML.Lucid                   (HTML)
@@ -47,10 +47,8 @@ import           Server                               (JobStatus, Org (..),
 import           Worker                               (Job (Job), linterThread)
 
 import           Servant.API                          (Header)
-import           Servant.Client                       (BaseUrl (BaseUrl),
-                                                       ClientM, Scheme (Http),
-                                                       client, mkClientEnv,
-                                                       runClientM)
+import           Servant.Client                       (ClientM, client,
+                                                       mkClientEnv, runClientM)
 
 type family PolyEndpoint method format payload where
   PolyEndpoint Get format payload = Get format payload
@@ -114,19 +112,19 @@ main = do
 
   -- TODO: what about tls / https?
   manager' <- newManager defaultManagerSettings
-  updater <- async $ forever $ do
-    done <- readMVar state
-    res <- runClientM
-           (postNewMaps (view token config) (MapService done))
-           (mkClientEnv manager' (view exneuland config))
-    print res
-    threadDelay (view interval config * 1000000)
+  -- updater <- async $ forever $ do
+  --   done <- readMVar state
+  --   res <- runClientM
+  --          (postNewMaps (view token config) (MapService done))
+  --          (mkClientEnv manager' (view exneuland config))
+  --   print res
+  --   threadDelay (view interval config * 1000000)
 
   -- spawns threads for each job in the queue
   linter <- async $ void $ linterThread config queue state
   link linter
   link poker
-  link updater
+  -- link updater
 
   let warpsettings =
        setPort (view port config)
-- 
cgit v1.2.3