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

added some reasoning about deadlocks and removed unneeded code

Browse source
This commit is contained in:
Dennis Frieberg 2021-04-14 16:19:39 +02:00
parent b98e5e27d0
commit f45297d86b
1 changed files with 5 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

11
app/Environment.hs
View file

@ -11,11 +11,10 @@ module Environment(Env (..), EnvM, runEnvM, myLogAction,defaultEnv) where
import Prelude hiding (log) import Prelude hiding (log)
import Colog import Colog
import Control.Monad.Reader (ReaderT (..), MonadReader) import Control.Monad.Reader (ReaderT (..), MonadReader)
import Control.Monad.Trans import Control.Monad.Trans(lift)
import Control.Monad.IO.Unlift import Control.Monad.IO.Unlift
import Control.Concurrent.MVar (MVar,modifyMVar_,newMVar) import Control.Concurrent.MVar (MVar,modifyMVar_,newMVar)
import System.IO.Unsafe(unsafePerformIO) import System.IO.Unsafe(unsafePerformIO)
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) import Control.Parallel(pseq)
@ -43,17 +42,17 @@ instance MonadUnliftIO EnvM where
withRunInIO inner = EnvM $ withRunInIO (\fromReader -> inner (fromReader . unEnvM)) withRunInIO inner = EnvM $ withRunInIO (\fromReader -> inner (fromReader . unEnvM))
{-# INLINE withRunInIO #-} {-# INLINE withRunInIO #-}
modifyMVar :: M.MVar a -> (a -> EnvM (a,b)) -> EnvM b
modifyMVar mvar action = withRunInIO $ \run -> M.modifyMVar mvar (run . action)
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
-- we do not export this MVar (which makes it easier to reason about deadlocks
syncMVar :: MVar () syncMVar :: MVar ()
syncMVar = unsafePerformIO $ newMVar () syncMVar = unsafePerformIO $ newMVar ()
{-# NOINLINE syncMVar #-} {-# NOINLINE syncMVar #-}
-- Every time you do something like this you should ask yourself: Is this a potential deadlock? And the answer
-- is in this case is NO. Even if m diverges it won't be able to lock up other threads as it will be forced to
-- evaluate before we take the MVar. So as long printing to stdout terminates we will always put back the mvar.
myLogAction :: LogAction EnvM Message myLogAction :: LogAction EnvM Message
myLogAction = LogAction $ \x -> let m = formatMessage x in EnvM . lift $ m `pseq` modifyMVar_ syncMVar (const (T.putStrLn m)) myLogAction = LogAction $ \x -> let m = formatMessage x in EnvM . lift $ m `pseq` modifyMVar_ syncMVar (const (T.putStrLn m))