convert TMVars that are never left empty into TVars

This is probably more efficient, and it avoids mistakenly leaving them
empty.
This commit is contained in:
Joey Hess 2016-09-30 19:51:16 -04:00
parent b025500352
commit 166d70db77
No known key found for this signature in database
GPG key ID: C910D9222512E3C7
6 changed files with 46 additions and 62 deletions

View file

@ -86,8 +86,7 @@ data DaemonStatus = DaemonStatus
type TransferMap = M.Map Transfer TransferInfo
{- This TMVar is never left empty, so accessing it will never block. -}
type DaemonStatusHandle = TMVar DaemonStatus
type DaemonStatusHandle = TVar DaemonStatus
newDaemonStatus :: IO DaemonStatus
newDaemonStatus = DaemonStatus

View file

@ -13,8 +13,7 @@ import Assistant.Types.DaemonStatus
import Control.Concurrent.STM hiding (check)
{- This TMVar is never left empty. -}
type TransferrerPool = TMVar (MkCheckTransferrer, [TransferrerPoolItem])
type TransferrerPool = TVar (MkCheckTransferrer, [TransferrerPoolItem])
type CheckTransferrer = IO Bool
type MkCheckTransferrer = IO (IO Bool)
@ -31,24 +30,22 @@ data Transferrer = Transferrer
}
newTransferrerPool :: MkCheckTransferrer -> IO TransferrerPool
newTransferrerPool c = newTMVarIO (c, [])
newTransferrerPool c = newTVarIO (c, [])
popTransferrerPool :: TransferrerPool -> STM (Maybe TransferrerPoolItem, Int)
popTransferrerPool p = do
(c, l) <- takeTMVar p
(c, l) <- readTVar p
case l of
[] -> do
putTMVar p (c, [])
return (Nothing, 0)
[] -> return (Nothing, 0)
(i:is) -> do
putTMVar p (c, is)
writeTVar p (c, is)
return $ (Just i, length is)
pushTransferrerPool :: TransferrerPool -> TransferrerPoolItem -> STM ()
pushTransferrerPool p i = do
(c, l) <- takeTMVar p
(c, l) <- readTVar p
let l' = i:l
putTMVar p (c, l')
writeTVar p (c, l')
{- Note that making a CheckTransferrer may allocate resources,
- such as a NotificationHandle, so it's important that the returned
@ -56,12 +53,12 @@ pushTransferrerPool p i = do
- garbage collected. -}
mkTransferrerPoolItem :: TransferrerPool -> Transferrer -> IO TransferrerPoolItem
mkTransferrerPoolItem p t = do
mkcheck <- atomically $ fst <$> readTMVar p
mkcheck <- atomically $ fst <$> readTVar p
check <- mkcheck
return $ TransferrerPoolItem (Just t) check
checkNetworkConnections :: DaemonStatusHandle -> MkCheckTransferrer
checkNetworkConnections dstatushandle = do
dstatus <- atomically $ readTMVar dstatushandle
dstatus <- atomically $ readTVar dstatushandle
h <- newNotificationHandle False (networkConnectedNotifier dstatus)
return $ not <$> checkNotification h