Splittertech/tickLeisteServer
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

forced evaluation of logging message before blocking

Browse source
This commit is contained in:
Dennis Frieberg 2021-04-14 10:48:59 +02:00
parent 069bf3fde8
commit b98e5e27d0
3 changed files with 6 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

3
app/Environment.hs
View file

@ -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{..} =