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 Control.Concurrent.MVar as M
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T
|
import qualified Data.Text.IO as T
|
||||||
|
import Control.Parallel(pseq)
|
||||||
|
|
||||||
newtype Env m = Env {logAction :: LogAction m Message}
|
newtype Env m = Env {logAction :: LogAction m Message}
|
||||||
|
|
||||||
|
@ -54,7 +55,7 @@ syncMVar = unsafePerformIO $ newMVar ()
|
||||||
{-# NOINLINE syncMVar #-}
|
{-# NOINLINE syncMVar #-}
|
||||||
|
|
||||||
myLogAction :: LogAction EnvM Message
|
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 :: Message -> T.Text
|
||||||
formatMessage Msg{..} =
|
formatMessage Msg{..} =
|
||||||
|
|
|
@ -49,6 +49,8 @@ dependencies:
|
||||||
- unliftio-core
|
- unliftio-core
|
||||||
- unliftio
|
- unliftio
|
||||||
- mtl
|
- mtl
|
||||||
|
# for pseq in logging
|
||||||
|
- parallel
|
||||||
|
|
||||||
when:
|
when:
|
||||||
- condition: flag(http)
|
- condition: flag(http)
|
||||||
|
|
|
@ -56,6 +56,7 @@ executable tickLeisteServer
|
||||||
, http-types
|
, http-types
|
||||||
, mtl
|
, mtl
|
||||||
, optparse-applicative
|
, optparse-applicative
|
||||||
|
, parallel
|
||||||
, text
|
, text
|
||||||
, tickLeiste
|
, tickLeiste
|
||||||
, tickLeiste-aeson
|
, tickLeiste-aeson
|
||||||
|
@ -97,6 +98,7 @@ test-suite tickLeisteServer-test
|
||||||
, http-types
|
, http-types
|
||||||
, mtl
|
, mtl
|
||||||
, optparse-applicative
|
, optparse-applicative
|
||||||
|
, parallel
|
||||||
, text
|
, text
|
||||||
, tickLeiste
|
, tickLeiste
|
||||||
, tickLeiste-aeson
|
, tickLeiste-aeson
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue