module Distribution.Utils.Progress
( Progress
, stepProgress
, failProgress
, foldProgress
) where
import Prelude ()
import Distribution.Compat.Prelude
import qualified Data.Monoid as Mon
data Progress step fail done = Step step (Progress step fail done)
| Fail fail
| Done done
deriving (Functor)
stepProgress :: step -> Progress step fail ()
stepProgress step = Step step (Done ())
failProgress :: fail -> Progress step fail done
failProgress err = Fail err
foldProgress :: (step -> a -> a) -> (fail -> a) -> (done -> a)
-> Progress step fail done -> a
foldProgress step err done = fold
where fold (Step s p) = step s (fold p)
fold (Fail f) = err f
fold (Done r) = done r
instance Monad (Progress step fail) where
return = pure
p >>= f = foldProgress Step Fail f p
instance Applicative (Progress step fail) where
pure a = Done a
p <*> x = foldProgress Step Fail (flip fmap x) p
instance Monoid fail => Alternative (Progress step fail) where
empty = Fail Mon.mempty
p <|> q = foldProgress Step (const q) Done p