forced evaluation of logging message before blocking
This commit is contained in:
parent
069bf3fde8
commit
b98e5e27d0
3 changed files with 6 additions and 1 deletions
|
@ -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{..} =
|
||||
|
|
|
@ -49,6 +49,8 @@ dependencies:
|
|||
- unliftio-core
|
||||
- unliftio
|
||||
- mtl
|
||||
# for pseq in logging
|
||||
- parallel
|
||||
|
||||
when:
|
||||
- condition: flag(http)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue