{-# LANGUAGE Rank2Types #-}
module Distribution.Solver.Modular.RetryLog
    ( RetryLog
    , toProgress
    , fromProgress
    , mapFailure
    , retry
    , failWith
    , succeedWith
    , continueWith
    , tryWith
    ) where

import Distribution.Solver.Compat.Prelude
import Prelude ()

import Distribution.Solver.Modular.Message
import Distribution.Solver.Types.Progress

-- | 'Progress' as a difference list that allows efficient appends at failures.
newtype RetryLog step fail done = RetryLog {
    forall step fail done.
RetryLog step fail done
-> forall fail2.
   (fail -> Progress step fail2 done) -> Progress step fail2 done
unRetryLog :: forall fail2 . (fail -> Progress step fail2 done)
               -> Progress step fail2 done
  }

-- | /O(1)/. Convert a 'RetryLog' to a 'Progress'.
toProgress :: RetryLog step fail done -> Progress step fail done
toProgress :: forall step fail done.
RetryLog step fail done -> Progress step fail done
toProgress (RetryLog forall fail2.
(fail -> Progress step fail2 done) -> Progress step fail2 done
f) = forall fail2.
(fail -> Progress step fail2 done) -> Progress step fail2 done
f forall step fail done. fail -> Progress step fail done
Fail

-- | /O(N)/. Convert a 'Progress' to a 'RetryLog'.
fromProgress :: Progress step fail done -> RetryLog step fail done
fromProgress :: forall step fail done.
Progress step fail done -> RetryLog step fail done
fromProgress Progress step fail done
l = forall step fail done.
(forall fail2.
 (fail -> Progress step fail2 done) -> Progress step fail2 done)
-> RetryLog step fail done
RetryLog forall a b. (a -> b) -> a -> b
$ \fail -> Progress step fail2 done
f -> forall fail1 step fail2 done.
(fail1 -> Progress step fail2 done)
-> Progress step fail1 done -> Progress step fail2 done
go fail -> Progress step fail2 done
f Progress step fail done
l
  where
    go :: (fail1 -> Progress step fail2 done)
       -> Progress step fail1 done
       -> Progress step fail2 done
    go :: forall fail1 step fail2 done.
(fail1 -> Progress step fail2 done)
-> Progress step fail1 done -> Progress step fail2 done
go fail1 -> Progress step fail2 done
_ (Done done
d) = forall step fail done. done -> Progress step fail done
Done done
d
    go fail1 -> Progress step fail2 done
f (Fail fail1
failure) = fail1 -> Progress step fail2 done
f fail1
failure
    go fail1 -> Progress step fail2 done
f (Step step
m Progress step fail1 done
ms) = forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step step
m (forall fail1 step fail2 done.
(fail1 -> Progress step fail2 done)
-> Progress step fail1 done -> Progress step fail2 done
go fail1 -> Progress step fail2 done
f Progress step fail1 done
ms)

-- | /O(1)/. Apply a function to the failure value in a log.
mapFailure :: (fail1 -> fail2)
           -> RetryLog step fail1 done
           -> RetryLog step fail2 done
mapFailure :: forall fail1 fail2 step done.
(fail1 -> fail2)
-> RetryLog step fail1 done -> RetryLog step fail2 done
mapFailure fail1 -> fail2
f RetryLog step fail1 done
l = forall step fail1 done fail2.
RetryLog step fail1 done
-> (fail1 -> RetryLog step fail2 done) -> RetryLog step fail2 done
retry RetryLog step fail1 done
l forall a b. (a -> b) -> a -> b
$ \fail1
failure -> forall step fail done.
(forall fail2.
 (fail -> Progress step fail2 done) -> Progress step fail2 done)
-> RetryLog step fail done
RetryLog forall a b. (a -> b) -> a -> b
$ \fail2 -> Progress step fail2 done
g -> fail2 -> Progress step fail2 done
g (fail1 -> fail2
f fail1
failure)

-- | /O(1)/. If the first log leads to failure, continue with the second.
retry :: RetryLog step fail1 done
      -> (fail1 -> RetryLog step fail2 done)
      -> RetryLog step fail2 done
retry :: forall step fail1 done fail2.
RetryLog step fail1 done
-> (fail1 -> RetryLog step fail2 done) -> RetryLog step fail2 done
retry (RetryLog forall fail2.
(fail1 -> Progress step fail2 done) -> Progress step fail2 done
f) fail1 -> RetryLog step fail2 done
g =
    forall step fail done.
(forall fail2.
 (fail -> Progress step fail2 done) -> Progress step fail2 done)
-> RetryLog step fail done
RetryLog forall a b. (a -> b) -> a -> b
$ \fail2 -> Progress step fail2 done
extendLog -> forall fail2.
(fail1 -> Progress step fail2 done) -> Progress step fail2 done
f forall a b. (a -> b) -> a -> b
$ \fail1
failure -> forall step fail done.
RetryLog step fail done
-> forall fail2.
   (fail -> Progress step fail2 done) -> Progress step fail2 done
unRetryLog (fail1 -> RetryLog step fail2 done
g fail1
failure) fail2 -> Progress step fail2 done
extendLog

-- | /O(1)/. Create a log with one message before a failure.
failWith :: step -> fail -> RetryLog step fail done
failWith :: forall step fail done. step -> fail -> RetryLog step fail done
failWith step
m fail
failure = forall step fail done.
(forall fail2.
 (fail -> Progress step fail2 done) -> Progress step fail2 done)
-> RetryLog step fail done
RetryLog forall a b. (a -> b) -> a -> b
$ \fail -> Progress step fail2 done
f -> forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step step
m (fail -> Progress step fail2 done
f fail
failure)

-- | /O(1)/. Create a log with one message before a success.
succeedWith :: step -> done -> RetryLog step fail done
succeedWith :: forall step done fail. step -> done -> RetryLog step fail done
succeedWith step
m done
d = forall step fail done.
(forall fail2.
 (fail -> Progress step fail2 done) -> Progress step fail2 done)
-> RetryLog step fail done
RetryLog forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step step
m (forall step fail done. done -> Progress step fail done
Done done
d)

-- | /O(1)/. Prepend a message to a log.
continueWith :: step
             -> RetryLog step fail done
             -> RetryLog step fail done
continueWith :: forall step fail done.
step -> RetryLog step fail done -> RetryLog step fail done
continueWith step
m (RetryLog forall fail2.
(fail -> Progress step fail2 done) -> Progress step fail2 done
f) = forall step fail done.
(forall fail2.
 (fail -> Progress step fail2 done) -> Progress step fail2 done)
-> RetryLog step fail done
RetryLog forall a b. (a -> b) -> a -> b
$ forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step step
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall fail2.
(fail -> Progress step fail2 done) -> Progress step fail2 done
f

-- | /O(1)/. Prepend the given message and 'Enter' to the log, and insert
-- 'Leave' before the failure if the log fails.
tryWith :: Message -> RetryLog Message fail done -> RetryLog Message fail done
tryWith :: forall fail done.
Message -> RetryLog Message fail done -> RetryLog Message fail done
tryWith Message
m RetryLog Message fail done
f =
  forall step fail done.
(forall fail2.
 (fail -> Progress step fail2 done) -> Progress step fail2 done)
-> RetryLog step fail done
RetryLog forall a b. (a -> b) -> a -> b
$ forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step Message
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall step fail done.
step -> Progress step fail done -> Progress step fail done
Step Message
Enter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall step fail done.
RetryLog step fail done
-> forall fail2.
   (fail -> Progress step fail2 done) -> Progress step fail2 done
unRetryLog (forall step fail1 done fail2.
RetryLog step fail1 done
-> (fail1 -> RetryLog step fail2 done) -> RetryLog step fail2 done
retry RetryLog Message fail done
f (forall step fail done. step -> fail -> RetryLog step fail done
failWith Message
Leave))