debugMinor
Repeat an action for a set of elements until all succeed, or progression halts
Viewed 0 times
haltsrepeatelementsuntilallsucceedactionforsetprogression
Problem
Context
I'm trying to write a function that drops a list of tables from a database (e.g., tables A, B and C).
This function has the following type, it returns a list of booleans indicating whether each table was successfully dropped:
Now, imagine table C depends on table B, i.e., table B cannot be dropped while table C exists. The function will be able to drop tables A and C, but not B, and so it will return
So, I wanted to write a function that takes a list of tables, and calls
This was my first stab at it:
I then tried to generalize the core algorithm, and remove all references to tables and database connections:
```
-- Repeats a given action for a set of elements, until it succeeds for all elements, or fails for all elements.
-- Elements for which the operation succeeds are not passed onto the next iteration.
-- Returns the elements for which the action failed.
repeatUntilAll :: Monad m => [a] -> ([a] -> m [Bool]) -> m [a]
repeatUntilAll xs f =
let
go [] = return []
go failures
| length failures == length xs = return failures -- halt
| otherwise = repeatUntilAll failures f
in
do
results <- f xs
I'm trying to write a function that drops a list of tables from a database (e.g., tables A, B and C).
This function has the following type, it returns a list of booleans indicating whether each table was successfully dropped:
dropTables :: (IConnection conn) => conn -> [String] -> IO [Bool]Now, imagine table C depends on table B, i.e., table B cannot be dropped while table C exists. The function will be able to drop tables A and C, but not B, and so it will return
[True, False, True].So, I wanted to write a function that takes a list of tables, and calls
dropTables. If any of the operations fail, it calls dropTables again but this time only with the tables that could not be dropped in the first iteration. And so on, until either all tables have been dropped, or progression halts (i.e. all operations in a given iteration fail, due to e.g. a connection being closed)This was my first stab at it:
dropTablesRec :: IConnection conn => conn -> [String] -> IO ()
dropTablesRec conn tables = do
results <- dropTables conn tables
let failures = map fst $ filter (not . snd) $ zip tables results
unless (null failures) $
if length failures == length tables
then print $ "Failed to drop the following tables: " ++ intercalate ", " failures
else dropTablesRec conn failuresI then tried to generalize the core algorithm, and remove all references to tables and database connections:
```
-- Repeats a given action for a set of elements, until it succeeds for all elements, or fails for all elements.
-- Elements for which the operation succeeds are not passed onto the next iteration.
-- Returns the elements for which the action failed.
repeatUntilAll :: Monad m => [a] -> ([a] -> m [Bool]) -> m [a]
repeatUntilAll xs f =
let
go [] = return []
go failures
| length failures == length xs = return failures -- halt
| otherwise = repeatUntilAll failures f
in
do
results <- f xs
Solution
I quite like your aim for simplifying the function and factoring out the generic part. One solution (untested, just compiled) could be done using
We pass an additional boolean flag that tells if a particular step was an improvement or not. Note that we don't need to check for the final condition - if everything succeeds, there will be one final step with an empty list and then we'll stop.
However, I like a bit more yet another solution. Notice this: Let's say the first removal succeeds, the second fails and because of this, everything else. Then we iterate through the whole list, and then once more, before we finish. But in fact we know that we're bound to fail when we fail to remove all the other elements. In this second solution, we loop over all elements without distinguishing a full pass. Instead we "reset" the state every time we succeed and try all the failed elements again. I also like its simplicity, compared to the previous one:
(Again compiled but untested.) Note that in
A tiny nit, unrelated to the main problem: Haddock comments allow you to generate nice documentation.
iterateUntilM from Control.Monad.Loops:repeatUntilAll :: (Monad m) => ([a] -> m [Bool]) -> [a] -> m [a]
repeatUntilAll f = fmap snd . iterateUntilM fst step . ((,) True)
where
step (_, xs) = do
results length ys, ys)We pass an additional boolean flag that tells if a particular step was an improvement or not. Note that we don't need to check for the final condition - if everything succeeds, there will be one final step with an empty list and then we'll stop.
However, I like a bit more yet another solution. Notice this: Let's say the first removal succeeds, the second fails and because of this, everything else. Then we iterate through the whole list, and then once more, before we finish. But in fact we know that we're bound to fail when we fail to remove all the other elements. In this second solution, we loop over all elements without distinguishing a full pass. Instead we "reset" the state every time we succeed and try all the failed elements again. I also like its simplicity, compared to the previous one:
-- | Tries to repeatedly act on each element until the action succeeds on each.
-- Alternatively stops when the action fails for all unfinished elements in one full round.
tryOnAll :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
tryOnAll f = loop []
where
loop fs [] = return fs
loop fs (w : ws) = do
r <- f w
if r then loop [] (fs ++ ws)
else loop (w : fs) ws(Again compiled but untested.) Note that in
fs ++ ws we change the order of elements. This shouldn't be a problem, as we need to try out all before we fail anyway, but if you don't like it, you can use Seq instead of [] and maintain sequential order. Or you could also replace it with ws ++ reverse fs, but only if the total number of elements is moderate, otherwise you could start having problems with its O(n) complexity.A tiny nit, unrelated to the main problem: Haddock comments allow you to generate nice documentation.
Code Snippets
repeatUntilAll :: (Monad m) => ([a] -> m [Bool]) -> [a] -> m [a]
repeatUntilAll f = fmap snd . iterateUntilM fst step . ((,) True)
where
step (_, xs) = do
results <- f xs
let ys = map fst $ filter (not . snd) $ zip xs results
return (length xs > length ys, ys)-- | Tries to repeatedly act on each element until the action succeeds on each.
-- Alternatively stops when the action fails for all unfinished elements in one full round.
tryOnAll :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
tryOnAll f = loop []
where
loop fs [] = return fs
loop fs (w : ws) = do
r <- f w
if r then loop [] (fs ++ ws)
else loop (w : fs) wsContext
StackExchange Code Review Q#146802, answer score: 2
Revisions (0)
No revisions yet.