synchronized logging

This commit is contained in:
Dennis Frieberg 2021-04-09 02:52:00 +02:00
parent 2bd93583d7
commit 3194f40cdc

View file

@ -13,6 +13,8 @@ import Colog
import Control.Monad.Reader (ReaderT (..), MonadReader)
import Control.Monad.Trans
import Control.Monad.IO.Unlift
import Control.Concurrent.MVar (MVar,modifyMVar_,newMVar)
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
@ -43,16 +45,16 @@ instance MonadUnliftIO EnvM where
modifyMVar :: M.MVar a -> (a -> EnvM (a,b)) -> EnvM b
modifyMVar mvar action = withRunInIO $ \run -> M.modifyMVar mvar (run . action)
-- logTest :: EnvM ()
logTest = logError "This is an Error"
runEnvM :: Env EnvM -> EnvM a -> IO a
runEnvM env envm = runReaderT (unEnvM envm) env
myLogAction :: LogAction EnvM Message
myLogAction = LogAction $ EnvM . lift . T.putStrLn . formatMessage
syncMVar :: MVar ()
syncMVar = unsafePerformIO $ newMVar ()
{-# NOINLINE syncMVar #-}
logTest' = runEnvM (Env myLogAction) logTest
myLogAction :: LogAction EnvM Message
myLogAction = LogAction $ \x -> EnvM . lift $ modifyMVar_ syncMVar (const (T.putStrLn . formatMessage $ x))
formatMessage :: Message -> T.Text
formatMessage Msg{..} =