summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-04-24 16:01:01 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-04-24 16:01:01 -0400
commit6148b926959ce5cbbc12aafc60a119788ca6d97f (patch)
tree738a801b7d4b49dbfee254d0baa6674444f93551
parentc7f3bfbc5e25109629cb3df871dc1f4844f6c560 (diff)
add TList, built on DList
-rw-r--r--Utility/TList.hs52
-rw-r--r--debian/control1
-rw-r--r--doc/install/fromscratch.mdwn1
-rw-r--r--git-annex.cabal2
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