add TList, built on DList
This commit is contained in:
parent
28d4113832
commit
25aabf4ffe
4 changed files with 55 additions and 1 deletions
52
Utility/TList.hs
Normal file
52
Utility/TList.hs
Normal file
|
@ -0,0 +1,52 @@
|
|||
{- Transactional lists
|
||||
-
|
||||
- Based on DLists, a transactional list can quickly and efficiently
|
||||
- have items inserted at either end, or a whole list appended to it.
|
||||
-
|
||||
- Copyright 2013 Joey Hess <joey@kitenet.net>
|
||||
-}
|
||||
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
|
||||
module Utility.TList where
|
||||
|
||||
import Common
|
||||
|
||||
import Control.Concurrent.STM
|
||||
import qualified Data.DList as D
|
||||
|
||||
type TList a = TMVar (D.DList a)
|
||||
|
||||
newTList :: STM (TList a)
|
||||
newTList = newEmptyTMVar
|
||||
|
||||
{- Gets the contents of the TList. Blocks when empty.
|
||||
- TList is left empty. -}
|
||||
getTList :: TList a -> STM [a]
|
||||
getTList tlist = D.toList <$> takeTMVar tlist
|
||||
|
||||
{- Gets anything currently in the TList, without blocking.
|
||||
- TList is left empty. -}
|
||||
readTList :: TList a -> STM [a]
|
||||
readTList tlist = maybe [] D.toList <$> tryTakeTMVar tlist
|
||||
|
||||
{- Mutates a TList. -}
|
||||
modifyTList :: TList a -> (D.DList a -> D.DList a) -> STM ()
|
||||
modifyTList tlist a = do
|
||||
dl <- fromMaybe D.empty <$> tryTakeTMVar tlist
|
||||
let !dl' = a dl
|
||||
{- The TMVar is left empty when the list is empty.
|
||||
- Thus attempts to read it automatically block. -}
|
||||
unless (emptyDList dl') $
|
||||
putTMVar tlist dl'
|
||||
where
|
||||
emptyDList = D.list True (\_ _ -> False)
|
||||
|
||||
consTList :: TList a -> a -> STM ()
|
||||
consTList tlist v = modifyTList tlist $ \dl -> D.cons v dl
|
||||
|
||||
snocTList :: TList a -> a -> STM ()
|
||||
snocTList tlist v = modifyTList tlist $ \dl -> D.snoc dl v
|
||||
|
||||
appendTList :: TList a -> [a] -> STM ()
|
||||
appendTList tlist l = modifyTList tlist $ \dl -> D.append dl (D.fromList l)
|
Loading…
Add table
Add a link
Reference in a new issue