module Control.Concurrent.STM.TChan.TChanL_ where
import Control.Concurrent
import Control.Concurrent.STM
import Control.Concurrent.STM.TChan.ExtsCommons
import Control.Monad
import Data.Foldable
import Data.List
import Data.MyHelpers
data TChanL a =
TChanL {
tclChan :: TChan a
, tclLoad :: TVar ChanLoad
}
chanLoad :: TChanL a -> STM ChanLoad
chanLoad tchl = readTVar $ tclLoad tchl
newTChanL :: STM (TChanL a)
newTChanL = do
tch <- newTChan
tv <- newTVar 0
return TChanL {
tclChan = tch
, tclLoad = tv
}
newTChanL_IO :: IO (TChanL a)
newTChanL_IO = atomically newTChanL
writeTChanL :: TChanL a -> a -> STM ()
writeTChanL tchl a = do
modifyTVar_ (tclLoad tchl) (+ 1)
writeTChan (tclChan tchl) a
readTChanL :: TChanL a -> STM a
readTChanL tchl = do
modifyTVar_ (tclLoad tchl) (\ v -> v 1)
readTChan (tclChan tchl)
isEmptyTChanL :: TChanL a -> STM Bool
isEmptyTChanL tchl = isEmptyTChan (tclChan tchl)
tryReadTChanL :: TChanL a -> STM (Maybe a)
tryReadTChanL tchl = do
emp <- isEmptyTChanL tchl
case emp of
True -> return Nothing
False -> Just `liftM` readTChanL tchl
getTChanLContents :: TChanL a -> STM [a]
getTChanLContents tchl = do
writeTVar (tclLoad tchl) 0
reverse `liftM` whileJustM_1 (:) [] (tryReadTChan (tclChan tchl))
writeList2TChanL :: TChanL a -> [a] -> STM ()
writeList2TChanL tchl l = do
load_add <- foldlM (\ load_accum e -> writeTChan (tclChan tchl) e >> return (load_accum + 1)) 0 l
modifyTVar_ (tclLoad tchl) (\ v -> v + load_add)
filterOutTChanLElements :: (a -> TakeElementOutShouldWe) -> TChanL a -> STM [a]
filterOutTChanLElements p tchl = do
l <- getTChanLContents tchl
let (takeout, stay) = partition p l
writeList2TChanL tchl stay
return takeout
viewChanLContent :: TChanL a -> STM [a]
viewChanLContent tchl = do
l <- getTChanLContents tchl
writeList2TChanL tchl l
return l