diff options
| -rw-r--r-- | Utility/TList.hs | 52 | ||||
| -rw-r--r-- | debian/control | 1 | ||||
| -rw-r--r-- | doc/install/fromscratch.mdwn | 1 | ||||
| -rw-r--r-- | git-annex.cabal | 2 |
4 files changed, 55 insertions, 1 deletions
diff --git a/Utility/TList.hs b/Utility/TList.hs new file mode 100644 index 000000000..33a50b7dd --- /dev/null +++ b/Utility/TList.hs @@ -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) diff --git a/debian/control b/debian/control index 152479748..32f8a4779 100644 --- a/debian/control +++ b/debian/control @@ -17,6 +17,7 @@ Build-Depends: libghc-quickcheck2-dev, libghc-monad-control-dev (>= 0.3), libghc-lifted-base-dev, + libghc-dlist-dev, libghc-uuid-dev, libghc-json-dev, libghc-ifelse-dev, diff --git a/doc/install/fromscratch.mdwn b/doc/install/fromscratch.mdwn index d62af115e..cf8f95c4f 100644 --- a/doc/install/fromscratch.mdwn +++ b/doc/install/fromscratch.mdwn @@ -13,6 +13,7 @@ quite a lot. * [QuickCheck 2](http://hackage.haskell.org/package/QuickCheck) * [json](http://hackage.haskell.org/package/json) * [IfElse](http://hackage.haskell.org/package/IfElse) + * [dlist](http://hackage.haskell.org/package/dlist) * [bloomfilter](http://hackage.haskell.org/package/bloomfilter) * [edit-distance](http://hackage.haskell.org/package/edit-distance) * [hS3](http://hackage.haskell.org/package/hS3) (optional) diff --git a/git-annex.cabal b/git-annex.cabal index 8663f212c..318de85eb 100644 --- a/git-annex.cabal +++ b/git-annex.cabal @@ -70,7 +70,7 @@ Executable git-annex extensible-exceptions, dataenc, SHA, process, json, base (>= 4.5 && < 4.8), monad-control, transformers-base, lifted-base, 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. Other-Modules: Utility.Touch Utility.Mounts Include-Dirs: Utility |