use TList for ChangePool

This commit is contained in:
Joey Hess 2013-04-24 16:13:22 -04:00
parent 25aabf4ffe
commit 76431520e4
3 changed files with 31 additions and 24 deletions

View file

@ -1,6 +1,6 @@
{- git-annex assistant change tracking {- 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. - Licensed under the GNU GPL version 3 or higher.
-} -}
@ -9,7 +9,7 @@ module Assistant.Changes where
import Assistant.Common import Assistant.Common
import Assistant.Types.Changes import Assistant.Types.Changes
import Utility.TSet import Utility.TList
import Data.Time.Clock import Data.Time.Clock
import Control.Concurrent.STM import Control.Concurrent.STM
@ -28,17 +28,17 @@ pendingAddChange f = Just <$> (PendingAddChange <$> liftIO getCurrentTime <*> pu
{- Gets all unhandled changes. {- Gets all unhandled changes.
- Blocks until at least one change is made. -} - Blocks until at least one change is made. -}
getChanges :: Assistant [Change] getChanges :: Assistant [Change]
getChanges = fmap concat $ (atomically . getTSet) <<~ changeChan getChanges = (atomically . getTList) <<~ changePool
{- Gets all unhandled changes, without blocking. -} {- Gets all unhandled changes, without blocking. -}
getAnyChanges :: Assistant [Change] 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. -} - Note: Original order is not preserved. -}
refillChanges :: [Change] -> Assistant () 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 :: Change -> Assistant ()
recordChange c = (atomically . flip putTSet1 [c]) <<~ changeChan recordChange c = (atomically . flip snocTList c) <<~ changePool

View file

@ -66,7 +66,7 @@ data AssistantData = AssistantData
, transferrerPool :: TransferrerPool , transferrerPool :: TransferrerPool
, failedPushMap :: FailedPushMap , failedPushMap :: FailedPushMap
, commitChan :: CommitChan , commitChan :: CommitChan
, changeChan :: ChangeChan , changePool :: ChangePool
, branchChangeHandle :: BranchChangeHandle , branchChangeHandle :: BranchChangeHandle
, buddyList :: BuddyList , buddyList :: BuddyList
, netMessager :: NetMessager , netMessager :: NetMessager
@ -83,7 +83,7 @@ newAssistantData st dstatus = AssistantData
<*> newTransferrerPool <*> newTransferrerPool
<*> newFailedPushMap <*> newFailedPushMap
<*> newCommitChan <*> newCommitChan
<*> newChangeChan <*> newChangePool
<*> newBranchChangeHandle <*> newBranchChangeHandle
<*> newBuddyList <*> newBuddyList
<*> newNetMessager <*> newNetMessager

View file

@ -1,6 +1,6 @@
{- git-annex assistant change tracking {- 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. - Licensed under the GNU GPL version 3 or higher.
-} -}
@ -9,23 +9,22 @@ module Assistant.Types.Changes where
import Types.KeySource import Types.KeySource
import Types.Key import Types.Key
import Utility.TSet import Utility.TList
import Data.Time.Clock
import Control.Concurrent.STM import Control.Concurrent.STM
import Data.Time.Clock
data ChangeInfo = AddKeyChange Key | AddFileChange | LinkChange (Maybe Key) | RmChange {- An un-ordered pool of Changes that have been noticed and should be
deriving (Show, Eq) - 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 newChangePool :: IO ChangePool
changeInfoKey (AddKeyChange k) = Just k newChangePool = atomically newTList
changeInfoKey (LinkChange (Just k)) = Just k
changeInfoKey _ = Nothing
type ChangeChan = TSet [Change]
newChangeChan :: IO ChangeChan
newChangeChan = atomically newTSet
data Change data Change
= Change = Change
@ -43,6 +42,14 @@ data Change
} }
deriving (Show) 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 -> FilePath
changeFile (Change _ f _) = f changeFile (Change _ f _) = f
changeFile (PendingAddChange _ f) = f changeFile (PendingAddChange _ f) = f