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)
|
1
debian/control
vendored
1
debian/control
vendored
|
@ -17,6 +17,7 @@ Build-Depends:
|
||||||
libghc-quickcheck2-dev,
|
libghc-quickcheck2-dev,
|
||||||
libghc-monad-control-dev (>= 0.3),
|
libghc-monad-control-dev (>= 0.3),
|
||||||
libghc-lifted-base-dev,
|
libghc-lifted-base-dev,
|
||||||
|
libghc-dlist-dev,
|
||||||
libghc-uuid-dev,
|
libghc-uuid-dev,
|
||||||
libghc-json-dev,
|
libghc-json-dev,
|
||||||
libghc-ifelse-dev,
|
libghc-ifelse-dev,
|
||||||
|
|
|
@ -13,6 +13,7 @@ quite a lot.
|
||||||
* [QuickCheck 2](http://hackage.haskell.org/package/QuickCheck)
|
* [QuickCheck 2](http://hackage.haskell.org/package/QuickCheck)
|
||||||
* [json](http://hackage.haskell.org/package/json)
|
* [json](http://hackage.haskell.org/package/json)
|
||||||
* [IfElse](http://hackage.haskell.org/package/IfElse)
|
* [IfElse](http://hackage.haskell.org/package/IfElse)
|
||||||
|
* [dlist](http://hackage.haskell.org/package/dlist)
|
||||||
* [bloomfilter](http://hackage.haskell.org/package/bloomfilter)
|
* [bloomfilter](http://hackage.haskell.org/package/bloomfilter)
|
||||||
* [edit-distance](http://hackage.haskell.org/package/edit-distance)
|
* [edit-distance](http://hackage.haskell.org/package/edit-distance)
|
||||||
* [hS3](http://hackage.haskell.org/package/hS3) (optional)
|
* [hS3](http://hackage.haskell.org/package/hS3) (optional)
|
||||||
|
|
|
@ -70,7 +70,7 @@ Executable git-annex
|
||||||
extensible-exceptions, dataenc, SHA, process, json,
|
extensible-exceptions, dataenc, SHA, process, json,
|
||||||
base (>= 4.5 && < 4.8), monad-control, transformers-base, lifted-base,
|
base (>= 4.5 && < 4.8), monad-control, transformers-base, lifted-base,
|
||||||
IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process,
|
IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process,
|
||||||
SafeSemaphore, uuid, random, regex-tdfa
|
SafeSemaphore, uuid, random, regex-tdfa, dlist
|
||||||
-- Need to list these because they're generated from .hsc files.
|
-- Need to list these because they're generated from .hsc files.
|
||||||
Other-Modules: Utility.Touch Utility.Mounts
|
Other-Modules: Utility.Touch Utility.Mounts
|
||||||
Include-Dirs: Utility
|
Include-Dirs: Utility
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue