aboutsummaryrefslogtreecommitdiff
path: root/Assistant
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-04-24 16:13:22 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-04-24 16:13:22 -0400
commit5c49f7ef10b8d61cfabd8ca9602d852ae5abe452 (patch)
tree259f4088b02c3ed08d488572bfde314dec21b181 /Assistant
parent6148b926959ce5cbbc12aafc60a119788ca6d97f (diff)
use TList for ChangePool
Diffstat (limited to 'Assistant')
-rw-r--r--Assistant/Changes.hs16
-rw-r--r--Assistant/Monad.hs4
-rw-r--r--Assistant/Types/Changes.hs35
3 files changed, 31 insertions, 24 deletions
diff --git a/Assistant/Changes.hs b/Assistant/Changes.hs
index 05f2795d3..0a93d6335 100644
--- a/Assistant/Changes.hs
+++ b/Assistant/Changes.hs
@@ -1,6 +1,6 @@
{- git-annex assistant change tracking
-
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -9,7 +9,7 @@ module Assistant.Changes where
import Assistant.Common
import Assistant.Types.Changes
-import Utility.TSet
+import Utility.TList
import Data.Time.Clock
import Control.Concurrent.STM
@@ -28,17 +28,17 @@ pendingAddChange f = Just <$> (PendingAddChange <$> liftIO getCurrentTime <*> pu
{- Gets all unhandled changes.
- Blocks until at least one change is made. -}
getChanges :: Assistant [Change]
-getChanges = fmap concat $ (atomically . getTSet) <<~ changeChan
+getChanges = (atomically . getTList) <<~ changePool
{- Gets all unhandled changes, without blocking. -}
getAnyChanges :: Assistant [Change]
-getAnyChanges = fmap concat $ (atomically . readTSet) <<~ changeChan
+getAnyChanges = (atomically . readTList) <<~ changePool
-{- Puts unhandled changes back into the channel.
+{- Puts unhandled changes back into the pool.
- Note: Original order is not preserved. -}
refillChanges :: [Change] -> Assistant ()
-refillChanges cs = (atomically . flip putTSet1 cs) <<~ changeChan
+refillChanges cs = (atomically . flip appendTList cs) <<~ changePool
-{- Records a change in the channel. -}
+{- Records a change to the pool. -}
recordChange :: Change -> Assistant ()
-recordChange c = (atomically . flip putTSet1 [c]) <<~ changeChan
+recordChange c = (atomically . flip snocTList c) <<~ changePool
diff --git a/Assistant/Monad.hs b/Assistant/Monad.hs
index 5a0fc1570..b8a471566 100644
--- a/Assistant/Monad.hs
+++ b/Assistant/Monad.hs
@@ -66,7 +66,7 @@ data AssistantData = AssistantData
, transferrerPool :: TransferrerPool
, failedPushMap :: FailedPushMap
, commitChan :: CommitChan
- , changeChan :: ChangeChan
+ , changePool :: ChangePool
, branchChangeHandle :: BranchChangeHandle
, buddyList :: BuddyList
, netMessager :: NetMessager
@@ -83,7 +83,7 @@ newAssistantData st dstatus = AssistantData
<*> newTransferrerPool
<*> newFailedPushMap
<*> newCommitChan
- <*> newChangeChan
+ <*> newChangePool
<*> newBranchChangeHandle
<*> newBuddyList
<*> newNetMessager
diff --git a/Assistant/Types/Changes.hs b/Assistant/Types/Changes.hs
index 3b6e8501a..81fd527a6 100644
--- a/Assistant/Types/Changes.hs
+++ b/Assistant/Types/Changes.hs
@@ -1,6 +1,6 @@
{- git-annex assistant change tracking
-
- - Copyright 2012 Joey Hess <joey@kitenet.net>
+ - Copyright 2012-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -9,23 +9,22 @@ module Assistant.Types.Changes where
import Types.KeySource
import Types.Key
-import Utility.TSet
+import Utility.TList
-import Data.Time.Clock
import Control.Concurrent.STM
+import Data.Time.Clock
-data ChangeInfo = AddKeyChange Key | AddFileChange | LinkChange (Maybe Key) | RmChange
- deriving (Show, Eq)
-
-changeInfoKey :: ChangeInfo -> Maybe Key
-changeInfoKey (AddKeyChange k) = Just k
-changeInfoKey (LinkChange (Just k)) = Just k
-changeInfoKey _ = Nothing
-
-type ChangeChan = TSet [Change]
+{- An un-ordered pool of Changes that have been noticed and should be
+ - staged and committed. Changes will typically be in order, but ordering
+ - may be lost. In any case, order should not matter, as any given Change
+ - may later be reverted by a later Change (ie, a file is added and then
+ - deleted). Code that processes the changes needs to deal with such
+ - scenarios.
+ -}
+type ChangePool = TList Change
-newChangeChan :: IO ChangeChan
-newChangeChan = atomically newTSet
+newChangePool :: IO ChangePool
+newChangePool = atomically newTList
data Change
= Change
@@ -43,6 +42,14 @@ data Change
}
deriving (Show)
+data ChangeInfo = AddKeyChange Key | AddFileChange | LinkChange (Maybe Key) | RmChange
+ deriving (Show, Eq, Ord)
+
+changeInfoKey :: ChangeInfo -> Maybe Key
+changeInfoKey (AddKeyChange k) = Just k
+changeInfoKey (LinkChange (Just k)) = Just k
+changeInfoKey _ = Nothing
+
changeFile :: Change -> FilePath
changeFile (Change _ f _) = f
changeFile (PendingAddChange _ f) = f