From 16d6ab71124876f7cffb79778cf8de1b23b5c1ba Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Tue, 29 Oct 2013 14:22:56 -0400 Subject: add post-repair actions --- Assistant/RepoProblem.hs | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) (limited to 'Assistant/RepoProblem.hs') diff --git a/Assistant/RepoProblem.hs b/Assistant/RepoProblem.hs index d2e5a5cf1..6913fefc6 100644 --- a/Assistant/RepoProblem.hs +++ b/Assistant/RepoProblem.hs @@ -8,16 +8,27 @@ module Assistant.RepoProblem where import Assistant.Common +import Assistant.Types.RepoProblem import Utility.TList import Control.Concurrent.STM -{- Gets all repositories that have problems. - - Blocks until there is at least one. -} -getRepoProblems :: Assistant [UUID] -getRepoProblems = (atomically . getTList) <<~ repoProblemChan +{- Gets all repositories that have problems. Blocks until there is at + - least one. -} +getRepoProblems :: Assistant [RepoProblem] +getRepoProblems = nubBy sameRepoProblem + <$> (atomically . getTList) <<~ repoProblemChan -{- Indicates that there was a problem accessing a repo, and the problem - - appears to not be a transient (eg network connection) problem. -} -repoHasProblem :: UUID -> Assistant () -repoHasProblem r = (atomically . flip consTList r) <<~ repoProblemChan +{- Indicates that there was a problem with a repository, and the problem + - appears to not be a transient (eg network connection) problem. + - + - If the problem is able to be repaired, the passed action will be run. + - (However, if multiple problems are reported with a single repository, + - only a single action will be run.) + -} +repoHasProblem :: UUID -> Assistant () -> Assistant () +repoHasProblem u afterrepair = do + rp <- RepoProblem + <$> pure u + <*> asIO afterrepair + (atomically . flip consTList rp) <<~ repoProblemChan -- cgit v1.2.3