diff options
author | Joey Hess <joey@kitenet.net> | 2012-06-26 12:36:42 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-06-26 12:36:42 -0400 |
commit | f2bce89055da1a453d420a7f46b5f86ab0c4c1ff (patch) | |
tree | 4d864122f8fc077e563d07bc50e6a67337d1b980 /Assistant | |
parent | 75e8690ccae90dec358f701dadb60d18aa473105 (diff) |
better data type for push records
Not yet plumbed thru
Diffstat (limited to 'Assistant')
-rw-r--r-- | Assistant/Pushes.hs | 37 |
1 files changed, 19 insertions, 18 deletions
diff --git a/Assistant/Pushes.hs b/Assistant/Pushes.hs index f3bffbf79..61d2b798b 100644 --- a/Assistant/Pushes.hs +++ b/Assistant/Pushes.hs @@ -8,29 +8,30 @@ module Assistant.Pushes where import Common.Annex -import Utility.TSet +import Control.Concurrent.SampleVar import Data.Time.Clock +import qualified Data.Map as M -type FailedPushChan = TSet FailedPush - -data FailedPush = FailedPush - { failedRemote :: Remote - , failedTimeStamp :: UTCTime - } +{- Track the most recent push failure for each remote. -} +type PushMap = M.Map Remote UTCTime +type FailedPushes = SampleVar PushMap newFailedPushChan :: IO FailedPushChan -newFailedPushChan = newTSet +newFailedPushChan = newEmptySampleVar + +{- Gets all failed pushes. Blocks until set. -} +getFailedPushes :: FailedPushChan -> IO PushMap +getFailedPushes = readSampleVar -{- Gets all failed pushes. Blocks until there is at least one failed push. -} -getFailedPushes :: FailedPushChan -> IO [FailedPush] -getFailedPushes = getTSet +{- Sets all failed pushes to passed PushMap -} +setFailedPushes :: FailedPushChan -> PushMap -> IO () +setFailedPushes = writeSampleVar -{- Puts failed pushes back into the channel. - - Note: Original order is not preserved. -} -refillFailedPushes :: FailedPushChan -> [FailedPush] -> IO () -refillFailedPushes = putTSet +{- Indicates a failure to push to a single remote. -} +failedPush :: FailedPushChan -> Remote -> IO () +failedPush c r = -{- Records a failed push in the channel. -} -recordFailedPush :: FailedPushChan -> FailedPush -> IO () -recordFailedPush = putTSet1 +{- Indicates that a remote was pushed to successfully. -} +successfulPush :: FailedPushChan -> Remote -> IO () +successfulPush c r = |