use TList for ChangePool
This commit is contained in:
parent
25aabf4ffe
commit
76431520e4
3 changed files with 31 additions and 24 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue