{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
-- Note: This module was copied from cabal-install.

-- | A progress monad, which we use to report failure and logging from
-- otherwise pure code.
module Distribution.Utils.Progress
    ( Progress
    , stepProgress
    , failProgress
    , foldProgress
    ) where

import Prelude ()
import Distribution.Compat.Prelude

import qualified Data.Monoid as Mon


-- | A type to represent the unfolding of an expensive long running
-- calculation that may fail (or maybe not expensive, but complicated!)
-- We may get intermediate steps before the final
-- result which may be used to indicate progress and\/or logging messages.
--
-- TODO: Apply Codensity to avoid left-associativity problem.
-- See http://comonad.com/reader/2011/free-monads-for-less/ and
-- http://blog.ezyang.com/2012/01/problem-set-the-codensity-transformation/
--
data Progress step fail done = Step step (Progress step fail done)
                             | Fail fail
                             | Done done
  deriving ((forall a b.
 (a -> b) -> Progress step fail a -> Progress step fail b)
-> (forall a b. a -> Progress step fail b -> Progress step fail a)
-> Functor (Progress step fail)
forall a b. a -> Progress step fail b -> Progress step fail a
forall a b.
(a -> b) -> Progress step fail a -> Progress step fail b
forall step fail a b.
a -> Progress step fail b -> Progress step fail a
forall step fail a b.
(a -> b) -> Progress step fail a -> Progress step fail b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall step fail a b.
(a -> b) -> Progress step fail a -> Progress step fail b
fmap :: forall a b.
(a -> b) -> Progress step fail a -> Progress step fail b
$c<$ :: forall step fail a b.
a -> Progress step fail b -> Progress step fail a
<$ :: forall a b. a -> Progress step fail b -> Progress step fail a
Functor)

-- | Emit a step and then continue.
--
stepProgress :: step -> Progress step fail ()
stepProgress :: forall step fail. step -> Progress step fail ()
stepProgress step
step = step -> Progress step fail () -> Progress step fail ()
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step step
step (() -> Progress step fail ()
forall step fail done. done -> Progress step fail done
Done ())

-- | Fail the computation.
failProgress :: fail -> Progress step fail done
failProgress :: forall fail step done. fail -> Progress step fail done
failProgress fail
err = fail -> Progress step fail done
forall step fail done. fail -> Progress step fail done
Fail fail
err

-- | Consume a 'Progress' calculation. Much like 'foldr' for lists but with two
-- base cases, one for a final result and one for failure.
--
-- Eg to convert into a simple 'Either' result use:
--
-- > foldProgress (flip const) Left Right
--
foldProgress :: (step -> a -> a) -> (fail -> a) -> (done -> a)
             -> Progress step fail done -> a
foldProgress :: forall step a fail done.
(step -> a -> a)
-> (fail -> a) -> (done -> a) -> Progress step fail done -> a
foldProgress step -> a -> a
step fail -> a
err done -> a
done = Progress step fail done -> a
fold
  where fold :: Progress step fail done -> a
fold (Step step
s Progress step fail done
p) = step -> a -> a
step step
s (Progress step fail done -> a
fold Progress step fail done
p)
        fold (Fail fail
f)   = fail -> a
err fail
f
        fold (Done done
r)   = done -> a
done done
r

instance Monad (Progress step fail) where
  return :: forall a. a -> Progress step fail a
return   = a -> Progress step fail a
forall a. a -> Progress step fail a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Progress step fail a
p >>= :: forall a b.
Progress step fail a
-> (a -> Progress step fail b) -> Progress step fail b
>>= a -> Progress step fail b
f  = (step -> Progress step fail b -> Progress step fail b)
-> (fail -> Progress step fail b)
-> (a -> Progress step fail b)
-> Progress step fail a
-> Progress step fail b
forall step a fail done.
(step -> a -> a)
-> (fail -> a) -> (done -> a) -> Progress step fail done -> a
foldProgress step -> Progress step fail b -> Progress step fail b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step fail -> Progress step fail b
forall step fail done. fail -> Progress step fail done
Fail a -> Progress step fail b
f Progress step fail a
p

instance Applicative (Progress step fail) where
  pure :: forall a. a -> Progress step fail a
pure a
a  = a -> Progress step fail a
forall step fail done. done -> Progress step fail done
Done a
a
  Progress step fail (a -> b)
p <*> :: forall a b.
Progress step fail (a -> b)
-> Progress step fail a -> Progress step fail b
<*> Progress step fail a
x = (step -> Progress step fail b -> Progress step fail b)
-> (fail -> Progress step fail b)
-> ((a -> b) -> Progress step fail b)
-> Progress step fail (a -> b)
-> Progress step fail b
forall step a fail done.
(step -> a -> a)
-> (fail -> a) -> (done -> a) -> Progress step fail done -> a
foldProgress step -> Progress step fail b -> Progress step fail b
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step fail -> Progress step fail b
forall step fail done. fail -> Progress step fail done
Fail (((a -> b) -> Progress step fail a -> Progress step fail b)
-> Progress step fail a -> (a -> b) -> Progress step fail b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> b) -> Progress step fail a -> Progress step fail b
forall a b.
(a -> b) -> Progress step fail a -> Progress step fail b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Progress step fail a
x) Progress step fail (a -> b)
p

instance Monoid fail => Alternative (Progress step fail) where
  empty :: forall a. Progress step fail a
empty   = fail -> Progress step fail a
forall step fail done. fail -> Progress step fail done
Fail fail
forall a. Monoid a => a
Mon.mempty
  Progress step fail a
p <|> :: forall a.
Progress step fail a
-> Progress step fail a -> Progress step fail a
<|> Progress step fail a
q = (step -> Progress step fail a -> Progress step fail a)
-> (fail -> Progress step fail a)
-> (a -> Progress step fail a)
-> Progress step fail a
-> Progress step fail a
forall step a fail done.
(step -> a -> a)
-> (fail -> a) -> (done -> a) -> Progress step fail done -> a
foldProgress step -> Progress step fail a -> Progress step fail a
forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step (Progress step fail a -> fail -> Progress step fail a
forall a b. a -> b -> a
const Progress step fail a
q) a -> Progress step fail a
forall step fail done. done -> Progress step fail done
Done Progress step fail a
p