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

synchronized logging

Browse source
This commit is contained in:
Dennis Frieberg 2021-04-09 02:52:00 +02:00
parent 2bd93583d7
commit 3194f40cdc
1 changed files with 7 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

12
app/Environment.hs
View file

@ -13,6 +13,8 @@ import Colog
import Control.Monad.Reader (ReaderT (..), MonadReader) import Control.Monad.Reader (ReaderT (..), MonadReader)
import Control.Monad.Trans import Control.Monad.Trans
import Control.Monad.IO.Unlift 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 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
@ -43,16 +45,16 @@ instance MonadUnliftIO EnvM where
modifyMVar :: M.MVar a -> (a -> EnvM (a,b)) -> EnvM b modifyMVar :: M.MVar a -> (a -> EnvM (a,b)) -> EnvM b
modifyMVar mvar action = withRunInIO $ \run -> M.modifyMVar mvar (run . action) 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 -> EnvM a -> IO a
runEnvM env envm = runReaderT (unEnvM envm) env runEnvM env envm = runReaderT (unEnvM envm) env
myLogAction :: LogAction EnvM Message syncMVar :: MVar ()
myLogAction = LogAction $ EnvM . lift . T.putStrLn . formatMessage 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 :: Message -> T.Text
formatMessage Msg{..} = formatMessage Msg{..} =