103 lines
2.5 KiB
Haskell
103 lines
2.5 KiB
Haskell
{- 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.
|
|
-
|
|
- Unlike a TQueue, the entire contents of a TList can be efficiently
|
|
- read without modifying it.
|
|
-
|
|
- Copyright 2013-2020 Joey Hess <id@joeyh.name>
|
|
-
|
|
- License: BSD-2-clause
|
|
-}
|
|
|
|
{-# LANGUAGE BangPatterns #-}
|
|
{-# LANGUAGE CPP #-}
|
|
|
|
module Utility.TList (
|
|
TList,
|
|
newTList,
|
|
getTList,
|
|
setTList,
|
|
takeTList,
|
|
readTList,
|
|
consTList,
|
|
snocTList,
|
|
appendTList,
|
|
headTList,
|
|
) 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
|
|
|
|
{- Takes the head of the TList, leaving the rest.
|
|
- Blocks when empty.
|
|
-
|
|
- O(n) due to use of D.tail
|
|
-}
|
|
headTList :: TList a -> STM a
|
|
headTList tlist = do
|
|
dl <- takeTMVar tlist
|
|
#if MIN_VERSION_dlist(1,0,0)
|
|
let !dl' = D.fromList $ D.tail dl
|
|
#else
|
|
let !dl' = D.tail dl
|
|
#endif
|
|
unless (emptyDList dl') $
|
|
putTMVar tlist dl'
|
|
return (D.head dl)
|
|
|
|
{- Gets the contents of the TList. Blocks when empty.
|
|
- TList is left empty. -}
|
|
getTList :: TList a -> STM [a]
|
|
getTList tlist = D.toList <$> getTDList tlist
|
|
|
|
getTDList :: TList a -> STM (D.DList a)
|
|
getTDList = takeTMVar
|
|
|
|
{- Replaces the contents of the TList. -}
|
|
setTList :: TList a -> [a] -> STM ()
|
|
setTList tlist = setTDList tlist . D.fromList
|
|
|
|
setTDList :: TList a -> D.DList a -> STM ()
|
|
setTDList tlist = modifyTList tlist . const
|
|
|
|
{- Takes anything currently in the TList, without blocking.
|
|
- TList is left empty. -}
|
|
takeTList :: TList a -> STM [a]
|
|
takeTList tlist = maybe [] D.toList <$> tryTakeTMVar tlist
|
|
|
|
{- Reads anything in the list, without modifying it, or blocking. -}
|
|
readTList :: TList a -> STM [a]
|
|
readTList tlist = maybe [] D.toList <$> tryReadTMVar tlist
|
|
|
|
{- Mutates a TList.
|
|
-
|
|
- O(n) due to the use of emptyDList -}
|
|
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'
|
|
|
|
emptyDList :: D.DList a -> Bool
|
|
emptyDList = null . D.toList
|
|
|
|
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)
|