From b98e5e27d03d6be915343bc04f39b7b0d3c9862f Mon Sep 17 00:00:00 2001
From: Dennis Frieberg <nerfingen@yahoo.de>
Date: Wed, 14 Apr 2021 10:48:59 +0200
Subject: [PATCH] forced evaluation of logging message before blocking

---
 app/Environment.hs     | 3 ++-
 package.yaml           | 2 ++
 tickLeisteServer.cabal | 2 ++
 3 files changed, 6 insertions(+), 1 deletion(-)

diff --git a/app/Environment.hs b/app/Environment.hs
index 1f69bec..ba5e8a0 100644
--- a/app/Environment.hs
+++ b/app/Environment.hs
@@ -18,6 +18,7 @@ import System.IO.Unsafe(unsafePerformIO)
 import qualified Control.Concurrent.MVar as M
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
+import Control.Parallel(pseq)
 
 newtype Env m = Env {logAction :: LogAction m Message}
 
@@ -54,7 +55,7 @@ syncMVar = unsafePerformIO $ newMVar ()
 {-# NOINLINE syncMVar #-}
 
 myLogAction :: LogAction EnvM Message
-myLogAction = LogAction $ \x -> EnvM . lift $ modifyMVar_ syncMVar (const (T.putStrLn . formatMessage $ x))
+myLogAction = LogAction $ \x -> let m = formatMessage x in EnvM . lift $ m `pseq` modifyMVar_ syncMVar (const (T.putStrLn m))
 
 formatMessage :: Message -> T.Text
 formatMessage Msg{..} =
diff --git a/package.yaml b/package.yaml
index b902fa2..36dc1f0 100644
--- a/package.yaml
+++ b/package.yaml
@@ -49,6 +49,8 @@ dependencies:
 - unliftio-core
 - unliftio
 - mtl
+# for pseq in logging
+- parallel
 
 when:
   - condition: flag(http)
diff --git a/tickLeisteServer.cabal b/tickLeisteServer.cabal
index c14f24d..e93b88c 100644
--- a/tickLeisteServer.cabal
+++ b/tickLeisteServer.cabal
@@ -56,6 +56,7 @@ executable tickLeisteServer
     , http-types
     , mtl
     , optparse-applicative
+    , parallel
     , text
     , tickLeiste
     , tickLeiste-aeson
@@ -97,6 +98,7 @@ test-suite tickLeisteServer-test
     , http-types
     , mtl
     , optparse-applicative
+    , parallel
     , text
     , tickLeiste
     , tickLeiste-aeson