From 76431520e406be2805b4eccc3a3dc3b3678ebcbf Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 24 Apr 2013 16:13:22 -0400 Subject: [PATCH] use TList for ChangePool --- Assistant/Changes.hs | 16 ++++++++-------- Assistant/Monad.hs | 4 ++-- Assistant/Types/Changes.hs | 35 +++++++++++++++++++++-------------- 3 files changed, 31 insertions(+), 24 deletions(-) diff --git a/Assistant/Changes.hs b/Assistant/Changes.hs index 05f2795d38..0a93d6335d 100644 --- a/Assistant/Changes.hs +++ b/Assistant/Changes.hs @@ -1,6 +1,6 @@ {- git-annex assistant change tracking - - - Copyright 2012 Joey Hess + - Copyright 2012-2013 Joey Hess - - 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 5a0fc1570e..b8a4715665 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 3b6e8501af..81fd527a63 100644 --- a/Assistant/Types/Changes.hs +++ b/Assistant/Types/Changes.hs @@ -1,6 +1,6 @@ {- git-annex assistant change tracking - - - Copyright 2012 Joey Hess + - Copyright 2012-2013 Joey Hess - - 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) +{- 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 -changeInfoKey :: ChangeInfo -> Maybe Key -changeInfoKey (AddKeyChange k) = Just k -changeInfoKey (LinkChange (Just k)) = Just k -changeInfoKey _ = Nothing - -type ChangeChan = TSet [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