1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
{- 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 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 <$> 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. -}
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)
|
