module Distribution.Solver.Modular.Log
    ( displayLogMessages
    , SolverFailure(..)
    ) where

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

import Distribution.Solver.Types.Progress
    ( Progress(Done, Fail), foldProgress )
import Distribution.Solver.Modular.ConflictSet
    ( ConflictMap, ConflictSet )
import Distribution.Solver.Modular.RetryLog
    ( RetryLog, toProgress, fromProgress )
import Distribution.Solver.Modular.Message (Message, summarizeMessages)
import Distribution.Solver.Types.SummarizedMessage
    ( SummarizedMessage(..) )
-- | Information about a dependency solver failure.
data SolverFailure =
    ExhaustiveSearch ConflictSet ConflictMap
  | BackjumpLimitReached

-- | Postprocesses a log file. This function discards all log messages and
-- avoids calling 'showMessages' if the log isn't needed (specified by
-- 'keepLog'), for efficiency.
displayLogMessages :: Bool
                   -> RetryLog Message SolverFailure a
                   -> RetryLog SummarizedMessage SolverFailure a
displayLogMessages :: forall a.
Bool
-> RetryLog Message SolverFailure a
-> RetryLog SummarizedMessage SolverFailure a
displayLogMessages Bool
keepLog RetryLog Message SolverFailure a
lg = Progress SummarizedMessage SolverFailure a
-> RetryLog SummarizedMessage SolverFailure a
forall step fail done.
Progress step fail done -> RetryLog step fail done
fromProgress (Progress SummarizedMessage SolverFailure a
 -> RetryLog SummarizedMessage SolverFailure a)
-> Progress SummarizedMessage SolverFailure a
-> RetryLog SummarizedMessage SolverFailure a
forall a b. (a -> b) -> a -> b
$
    if Bool
keepLog
    then Progress Message SolverFailure a
-> Progress SummarizedMessage SolverFailure a
forall a b. Progress Message a b -> Progress SummarizedMessage a b
summarizeMessages Progress Message SolverFailure a
progress
    else (Message
 -> Progress SummarizedMessage SolverFailure a
 -> Progress SummarizedMessage SolverFailure a)
-> (SolverFailure -> Progress SummarizedMessage SolverFailure a)
-> (a -> Progress SummarizedMessage SolverFailure a)
-> Progress Message SolverFailure a
-> Progress SummarizedMessage SolverFailure a
forall step a fail done.
(step -> a -> a)
-> (fail -> a) -> (done -> a) -> Progress step fail done -> a
foldProgress ((Progress SummarizedMessage SolverFailure a
 -> Progress SummarizedMessage SolverFailure a)
-> Message
-> Progress SummarizedMessage SolverFailure a
-> Progress SummarizedMessage SolverFailure a
forall a b. a -> b -> a
const Progress SummarizedMessage SolverFailure a
-> Progress SummarizedMessage SolverFailure a
forall a. a -> a
id) SolverFailure -> Progress SummarizedMessage SolverFailure a
forall step fail done. fail -> Progress step fail done
Fail a -> Progress SummarizedMessage SolverFailure a
forall step fail done. done -> Progress step fail done
Done Progress Message SolverFailure a
progress
  where
    progress :: Progress Message SolverFailure a
progress = RetryLog Message SolverFailure a
-> Progress Message SolverFailure a
forall step fail done.
RetryLog step fail done -> Progress step fail done
toProgress RetryLog Message SolverFailure a
lg