    {-# LANGUAGE RecordWildCards, CPP, ViewPatterns, ForeignFunctionInterface, TupleSections #-}

    -- | Progress tracking
    module Development.Shake.Internal.Progress(
        progress,
        progressSimple, progressDisplay, progressTitlebar, progressProgram,
        ProgressEntry(..), progressReplay, writeProgressReport -- INTERNAL USE ONLY
        ) where

    import Control.Applicative
    import Data.Tuple.Extra
    import Control.Exception.Extra
    import Control.Monad.Extra
    import System.Directory
    import System.Process
    import System.FilePath
    import Data.Char
    import Data.IORef
    import Data.List
    import Data.Maybe
    import Development.Shake.Internal.Options
    import Development.Shake.Internal.Core.Types
    import Development.Shake.Internal.Core.Database
    import qualified Data.ByteString.Char8 as BS
    import qualified Data.ByteString.Lazy.Char8 as LBS
    import Numeric.Extra
    import General.Template
    import General.EscCodes
    import General.Extra
    import Development.Shake.Internal.Paths
    import System.Time.Extra

    #ifdef mingw32_HOST_OS

    import Foreign.C.String

    #ifdef x86_64_HOST_ARCH
    #define CALLCONV ccall
    #else
    #define CALLCONV stdcall
    #endif

    foreign import CALLCONV "Windows.h SetConsoleTitleW" c_setConsoleTitleW :: CWString -> IO Bool

    #endif

    ---------------------------------------------------------------------
    -- PROGRESS

    progress :: Database -> Step -> IO Progress
    progress :: Database -> Step -> IO Progress
    progress Database
    db Step
    step = do
        xs <- Database -> IO [(Key, Status)]
    forall k v. DatabasePoly k v -> IO [(k, v)]
    getKeyValues Database
    db
        pure $! foldl' f mempty $ map snd xs
        where
            g :: Float -> Double
    g = Float -> Double
    floatToDouble

            f :: Progress -> Status -> Progress
    f Progress
    s (Ready Result{Float
    [Depends]
    [Trace]
    (Value, OneShot BS_Store)
    Step
    result :: (Value, OneShot BS_Store)
    built :: Step
    changed :: Step
    depends :: [Depends]
    execution :: Float
    traces :: [Trace]
    traces :: forall a. Result a -> [Trace]
    execution :: forall a. Result a -> Float
    depends :: forall a. Result a -> [Depends]
    changed :: forall a. Result a -> Step
    built :: forall a. Result a -> Step
    result :: forall a. Result a -> a
    ..}) = if Step
    step Step -> Step -> Bool
    forall a. Eq a => a -> a -> Bool
    == Step
    built
                then Progress
    s{countBuilt = countBuilt s + 1, timeBuilt = timeBuilt s + g execution}
                else Progress
    s{countSkipped = countSkipped s + 1, timeSkipped = timeSkipped s + g execution}
            f Progress
    s (Loaded Result{Float
    [Depends]
    [Trace]
    OneShot BS_Store
    Step
    traces :: forall a. Result a -> [Trace]
    execution :: forall a. Result a -> Float
    depends :: forall a. Result a -> [Depends]
    changed :: forall a. Result a -> Step
    built :: forall a. Result a -> Step
    result :: forall a. Result a -> a
    result :: OneShot BS_Store
    built :: Step
    changed :: Step
    depends :: [Depends]
    execution :: Float
    traces :: [Trace]
    ..}) = Progress
    s{countUnknown = countUnknown s + 1, timeUnknown = timeUnknown s + g execution}
            f Progress
    s (Running NoShow
      (Either SomeException (Result (Value, OneShot BS_Store))
       -> Locked ())
    _ Maybe (Result (OneShot BS_Store))
    r) =
                let (Double
    d,Int
    c) = Progress -> (Double, Int)
    timeTodo Progress
    s
                    t :: (Double, Int)
    t | Just Result{Float
    [Depends]
    [Trace]
    OneShot BS_Store
    Step
    traces :: forall a. Result a -> [Trace]
    execution :: forall a. Result a -> Float
    depends :: forall a. Result a -> [Depends]
    changed :: forall a. Result a -> Step
    built :: forall a. Result a -> Step
    result :: forall a. Result a -> a
    result :: OneShot BS_Store
    built :: Step
    changed :: Step
    depends :: [Depends]
    execution :: Float
    traces :: [Trace]
    ..} <- Maybe (Result (OneShot BS_Store))
    r = let d2 :: Double
    d2 = Double
    d Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + Float -> Double
    g Float
    execution in Double
    d2 Double -> (Double, Int) -> (Double, Int)
    forall a b. a -> b -> b
    `seq` (Double
    d2,Int
    c)
                      | Bool
    otherwise = let c2 :: Int
    c2 = Int
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1 in Int
    c2 Int -> (Double, Int) -> (Double, Int)
    forall a b. a -> b -> b
    `seq` (Double
    d,Int
    c2)
                in Progress
    s{countTodo = countTodo s + 1, timeTodo = t}
            f Progress
    s Status
    _ = Progress
    s

    ---------------------------------------------------------------------
    -- MEALY TYPE - for writing the progress functions
    -- See <https://hackage.haskell.org/package/machines-0.2.3.1/docs/Data-Machine-Mealy.html>

    -- | A machine that takes inputs and produces outputs
    newtype Mealy i a = Mealy {forall i a. Mealy i a -> i -> (a, Mealy i a)
    runMealy :: i -> (a, Mealy i a)}

    instance Functor (Mealy i) where
        fmap :: forall a b. (a -> b) -> Mealy i a -> Mealy i b
    fmap a -> b
    f (Mealy i -> (a, Mealy i a)
    m) = (i -> (b, Mealy i b)) -> Mealy i b
    forall i a. (i -> (a, Mealy i a)) -> Mealy i a
    Mealy ((i -> (b, Mealy i b)) -> Mealy i b)
    -> (i -> (b, Mealy i b)) -> Mealy i b
    forall a b. (a -> b) -> a -> b
    $ \i
    i -> case i -> (a, Mealy i a)
    m i
    i of
            (a
    x, Mealy i a
    m) -> (a -> b
    f a
    x, (a -> b) -> Mealy i a -> Mealy i b
    forall a b. (a -> b) -> Mealy i a -> Mealy i b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f Mealy i a
    m)

    instance Applicative (Mealy i) where
        pure :: forall a. a -> Mealy i a
    pure a
    x = let r :: Mealy i a
    r = (i -> (a, Mealy i a)) -> Mealy i a
    forall i a. (i -> (a, Mealy i a)) -> Mealy i a
    Mealy ((a, Mealy i a) -> i -> (a, Mealy i a)
    forall a b. a -> b -> a
    const (a
    x, Mealy i a
    r)) in Mealy i a
    forall {i}. Mealy i a
    r
        Mealy i -> (a -> b, Mealy i (a -> b))
    mf <*> :: forall a b. Mealy i (a -> b) -> Mealy i a -> Mealy i b
    <*> Mealy i -> (a, Mealy i a)
    mx = (i -> (b, Mealy i b)) -> Mealy i b
    forall i a. (i -> (a, Mealy i a)) -> Mealy i a
    Mealy ((i -> (b, Mealy i b)) -> Mealy i b)
    -> (i -> (b, Mealy i b)) -> Mealy i b
    forall a b. (a -> b) -> a -> b
    $ \i
    i -> case i -> (a -> b, Mealy i (a -> b))
    mf i
    i of
            (a -> b
    f, Mealy i (a -> b)
    mf) -> case i -> (a, Mealy i a)
    mx i
    i of
                (a
    x, Mealy i a
    mx) -> (a -> b
    f a
    x, Mealy i (a -> b)
    mf Mealy i (a -> b) -> Mealy i a -> Mealy i b
    forall a b. Mealy i (a -> b) -> Mealy i a -> Mealy i b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Mealy i a
    mx)

    echoMealy :: Mealy i i
    echoMealy :: forall i. Mealy i i
    echoMealy = (i -> (i, Mealy i i)) -> Mealy i i
    forall i a. (i -> (a, Mealy i a)) -> Mealy i a
    Mealy (,Mealy i i
    forall i. Mealy i i
    echoMealy)

    scanMealy :: (a -> b -> a) -> a -> Mealy i b -> Mealy i a
    scanMealy :: forall a b i. (a -> b -> a) -> a -> Mealy i b -> Mealy i a
    scanMealy a -> b -> a
    f a
    z (Mealy i -> (b, Mealy i b)
    m) = (i -> (a, Mealy i a)) -> Mealy i a
    forall i a. (i -> (a, Mealy i a)) -> Mealy i a
    Mealy ((i -> (a, Mealy i a)) -> Mealy i a)
    -> (i -> (a, Mealy i a)) -> Mealy i a
    forall a b. (a -> b) -> a -> b
    $ \i
    i -> case i -> (b, Mealy i b)
    m i
    i of
        (b
    x, Mealy i b
    m) -> let z2 :: a
    z2 = a -> b -> a
    f a
    z b
    x in (a
    z2, (a -> b -> a) -> a -> Mealy i b -> Mealy i a
    forall a b i. (a -> b -> a) -> a -> Mealy i b -> Mealy i a
    scanMealy a -> b -> a
    f a
    z2 Mealy i b
    m)

    ---------------------------------------------------------------------
    -- MEALY UTILITIES

    oldMealy :: a -> Mealy i a -> Mealy i (a,a)
    oldMealy :: forall a i. a -> Mealy i a -> Mealy i (a, a)
    oldMealy a
    old = ((a, a) -> a -> (a, a)) -> (a, a) -> Mealy i a -> Mealy i (a, a)
    forall a b i. (a -> b -> a) -> a -> Mealy i b -> Mealy i a
    scanMealy (\(a
    _,a
    old) a
    new -> (a
    old,a
    new)) (a
    old,a
    old)

    latch :: Mealy i (Bool, a) -> Mealy i a
    latch :: forall i a. Mealy i (Bool, a) -> Mealy i a
    latch Mealy i (Bool, a)
    s = Maybe a -> a
    forall a. Partial => Maybe a -> a
    fromJust (Maybe a -> a) -> Mealy i (Maybe a) -> Mealy i a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Maybe a -> (Bool, a) -> Maybe a)
    -> Maybe a -> Mealy i (Bool, a) -> Mealy i (Maybe a)
    forall a b i. (a -> b -> a) -> a -> Mealy i b -> Mealy i a
    scanMealy Maybe a -> (Bool, a) -> Maybe a
    forall {a}. Maybe a -> (Bool, a) -> Maybe a
    f Maybe a
    forall a. Maybe a
    Nothing Mealy i (Bool, a)
    s
        where f :: Maybe a -> (Bool, a) -> Maybe a
    f Maybe a
    old (Bool
    b,a
    v) = a -> Maybe a
    forall a. a -> Maybe a
    Just (a -> Maybe a) -> a -> Maybe a
    forall a b. (a -> b) -> a -> b
    $ if Bool
    b then a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe a
    v Maybe a
    old else a
    v

    iff :: Mealy i Bool -> Mealy i a -> Mealy i a -> Mealy i a
    iff :: forall i a. Mealy i Bool -> Mealy i a -> Mealy i a -> Mealy i a
    iff Mealy i Bool
    c Mealy i a
    t Mealy i a
    f = (\Bool
    c a
    t a
    f -> if Bool
    c then a
    t else a
    f) (Bool -> a -> a -> a) -> Mealy i Bool -> Mealy i (a -> a -> a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Mealy i Bool
    c Mealy i (a -> a -> a) -> Mealy i a -> Mealy i (a -> a)
    forall a b. Mealy i (a -> b) -> Mealy i a -> Mealy i b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Mealy i a
    t Mealy i (a -> a) -> Mealy i a -> Mealy i a
    forall a b. Mealy i (a -> b) -> Mealy i a -> Mealy i b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Mealy i a
    f

    -- decay'd division, compute a/b, with a decay of f
    -- r' is the new result, r is the last result
    -- r' ~= a' / b'
    -- r' = r*b + f*(a'-a)
    --      -------------
    --      b + f*(b'-b)
    -- when f == 1, r == r'
    --
    -- both streams must only ever increase
    decay :: Double -> Mealy i Double -> Mealy i Double -> Mealy i Double
    decay :: forall i.
    Double -> Mealy i Double -> Mealy i Double -> Mealy i Double
    decay Double
    f Mealy i Double
    a Mealy i Double
    b = (Double -> ((Double, Double), (Double, Double)) -> Double)
    -> Double
    -> Mealy i ((Double, Double), (Double, Double))
    -> Mealy i Double
    forall a b i. (a -> b -> a) -> a -> Mealy i b -> Mealy i a
    scanMealy Double -> ((Double, Double), (Double, Double)) -> Double
    step Double
    0 (Mealy i ((Double, Double), (Double, Double)) -> Mealy i Double)
    -> Mealy i ((Double, Double), (Double, Double)) -> Mealy i Double
    forall a b. (a -> b) -> a -> b
    $ (,) ((Double, Double)
     -> (Double, Double) -> ((Double, Double), (Double, Double)))
    -> Mealy i (Double, Double)
    -> Mealy
         i ((Double, Double) -> ((Double, Double), (Double, Double)))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Double -> Mealy i Double -> Mealy i (Double, Double)
    forall a i. a -> Mealy i a -> Mealy i (a, a)
    oldMealy Double
    0 Mealy i Double
    a Mealy i ((Double, Double) -> ((Double, Double), (Double, Double)))
    -> Mealy i (Double, Double)
    -> Mealy i ((Double, Double), (Double, Double))
    forall a b. Mealy i (a -> b) -> Mealy i a -> Mealy i b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Double -> Mealy i Double -> Mealy i (Double, Double)
    forall a i. a -> Mealy i a -> Mealy i (a, a)
    oldMealy Double
    0 Mealy i Double
    b
        where step :: Double -> ((Double, Double), (Double, Double)) -> Double
    step Double
    r ((Double
    a,Double
    a'),(Double
    b,Double
    b')) = if Double -> Bool
    forall a. RealFloat a => a -> Bool
    isNaN Double
    r then Double
    a' Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    b' else ((Double
    rDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    *Double
    b) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + Double
    fDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    *(Double
    a'Double -> Double -> Double
    forall a. Num a => a -> a -> a
    -Double
    a)) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / (Double
    b Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + Double
    fDouble -> Double -> Double
    forall a. Num a => a -> a -> a
    *(Double
    b'Double -> Double -> Double
    forall a. Num a => a -> a -> a
    -Double
    b))

    ---------------------------------------------------------------------
    -- MESSAGE GENERATOR

    formatMessage :: Double -> Double -> String
    formatMessage :: Double -> Double -> [Char]
    formatMessage Double
    secs Double
    perc =
        (if Double -> Bool
    forall a. RealFloat a => a -> Bool
    isNaN Double
    secs Bool -> Bool -> Bool
    || Double
    secs Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    < Double
    0 then [Char]
    "??s" else Int -> [Char]
    showMinSec (Int -> [Char]) -> Int -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling Double
    secs) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
        (if Double -> Bool
    forall a. RealFloat a => a -> Bool
    isNaN Double
    perc Bool -> Bool -> Bool
    || Double
    perc Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    < Double
    0 Bool -> Bool -> Bool
    || Double
    perc Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    > Double
    100 then [Char]
    "??" else Integer -> [Char]
    forall a. Show a => a -> [Char]
    show (Integer -> [Char]) -> Integer -> [Char]
    forall a b. (a -> b) -> a -> b
    $ Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor Double
    perc) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "%)"

    showMinSec :: Int -> String
    showMinSec :: Int -> [Char]
    showMinSec Int
    secs = (if Int
    m Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then [Char]
    "" else Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    m [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "m" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char
    '0' | Int
    s Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    10]) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    s [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "s"
        where (Int
    m,Int
    s) = Int -> Int -> (Int, Int)
    forall a. Integral a => a -> a -> (a, a)
    divMod Int
    secs Int
    60

    liftA2' :: Applicative m => m a -> m b -> (a -> b -> c) -> m c
    liftA2' :: forall (m :: * -> *) a b c.
    Applicative m =>
    m a -> m b -> (a -> b -> c) -> m c
    liftA2' m a
    a m b
    b a -> b -> c
    f = (a -> b -> c) -> m a -> m b -> m c
    forall a b c. (a -> b -> c) -> m a -> m b -> m c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 a -> b -> c
    f m a
    a m b
    b

    -- | return (number of seconds, percentage, explanation)
    message :: Mealy (Double, Progress) (Double, Progress) -> Mealy (Double, Progress) (Double, Double, String)
    message :: Mealy (Double, Progress) (Double, Progress)
    -> Mealy (Double, Progress) (Double, Double, [Char])
    message Mealy (Double, Progress) (Double, Progress)
    input = (Double -> Double -> [Char] -> (Double, Double, [Char]))
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) [Char]
    -> Mealy (Double, Progress) (Double, Double, [Char])
    forall (f :: * -> *) a b c d.
    Applicative f =>
    (a -> b -> c -> d) -> f a -> f b -> f c -> f d
    liftA3 (,,) Mealy (Double, Progress) Double
    time Mealy (Double, Progress) Double
    perc Mealy (Double, Progress) [Char]
    debug
        where
            progress :: Mealy (Double, Progress) Progress
    progress = (Double, Progress) -> Progress
    forall a b. (a, b) -> b
    snd ((Double, Progress) -> Progress)
    -> Mealy (Double, Progress) (Double, Progress)
    -> Mealy (Double, Progress) Progress
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Mealy (Double, Progress) (Double, Progress)
    input
            secs :: Mealy (Double, Progress) Double
    secs = (Double, Progress) -> Double
    forall a b. (a, b) -> a
    fst ((Double, Progress) -> Double)
    -> Mealy (Double, Progress) (Double, Progress)
    -> Mealy (Double, Progress) Double
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Mealy (Double, Progress) (Double, Progress)
    input
            debug :: Mealy (Double, Progress) [Char]
    debug = (\Double
    donePerSec Double
    ruleTime (Double
    todoKnown,Int
    todoUnknown) ->
                [Char]
    "Progress: " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                    [Char]
    "((known=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> Double -> [Char]
    forall a. RealFloat a => Int -> a -> [Char]
    showDP Int
    2 Double
    todoKnown [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "s) + " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                    [Char]
    "(unknown=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    todoUnknown [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    " * time=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> Double -> [Char]
    forall a. RealFloat a => Int -> a -> [Char]
    showDP Int
    2 Double
    ruleTime [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "s)) " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                    [Char]
    "(rate=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Int -> Double -> [Char]
    forall a. RealFloat a => Int -> a -> [Char]
    showDP Int
    2 Double
    donePerSec [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "))")
                (Double -> Double -> (Double, Int) -> [Char])
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) (Double -> (Double, Int) -> [Char])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Mealy (Double, Progress) Double
    donePerSec Mealy (Double, Progress) (Double -> (Double, Int) -> [Char])
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) ((Double, Int) -> [Char])
    forall a b.
    Mealy (Double, Progress) (a -> b)
    -> Mealy (Double, Progress) a -> Mealy (Double, Progress) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Mealy (Double, Progress) Double
    ruleTime Mealy (Double, Progress) ((Double, Int) -> [Char])
    -> Mealy (Double, Progress) (Double, Int)
    -> Mealy (Double, Progress) [Char]
    forall a b.
    Mealy (Double, Progress) (a -> b)
    -> Mealy (Double, Progress) a -> Mealy (Double, Progress) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Progress -> (Double, Int)
    timeTodo (Progress -> (Double, Int))
    -> Mealy (Double, Progress) Progress
    -> Mealy (Double, Progress) (Double, Int)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Mealy (Double, Progress) Progress
    progress)

            -- Number of seconds work completed in this build run
            -- Ignores timeSkipped which would be more truthful, but it makes the % drop sharply
            -- which isn't what users want
            done :: Mealy (Double, Progress) Double
    done = Progress -> Double
    timeBuilt (Progress -> Double)
    -> Mealy (Double, Progress) Progress
    -> Mealy (Double, Progress) Double
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Mealy (Double, Progress) Progress
    progress

            -- Work done per second, don't divide by 0 and don't update if 'done' doesn't change
            donePerSec :: Mealy (Double, Progress) Double
    donePerSec = Mealy (Double, Progress) Bool
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    forall i a. Mealy i Bool -> Mealy i a -> Mealy i a -> Mealy i a
    iff (Double -> Double -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) Double
    0 (Double -> Bool)
    -> Mealy (Double, Progress) Double -> Mealy (Double, Progress) Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Mealy (Double, Progress) Double
    done) (Double -> Mealy (Double, Progress) Double
    forall a. a -> Mealy (Double, Progress) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Double
    1) Mealy (Double, Progress) Double
    perSecStable
                where perSecStable :: Mealy (Double, Progress) Double
    perSecStable = Mealy (Double, Progress) (Bool, Double)
    -> Mealy (Double, Progress) Double
    forall i a. Mealy i (Bool, a) -> Mealy i a
    latch (Mealy (Double, Progress) (Bool, Double)
     -> Mealy (Double, Progress) Double)
    -> Mealy (Double, Progress) (Bool, Double)
    -> Mealy (Double, Progress) Double
    forall a b. (a -> b) -> a -> b
    $ (Bool -> Double -> (Bool, Double))
    -> Mealy (Double, Progress) Bool
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) (Bool, Double)
    forall a b c.
    (a -> b -> c)
    -> Mealy (Double, Progress) a
    -> Mealy (Double, Progress) b
    -> Mealy (Double, Progress) c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 (,) ((Double -> Double -> Bool) -> (Double, Double) -> Bool
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry Double -> Double -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) ((Double, Double) -> Bool)
    -> Mealy (Double, Progress) (Double, Double)
    -> Mealy (Double, Progress) Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Double
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) (Double, Double)
    forall a i. a -> Mealy i a -> Mealy i (a, a)
    oldMealy Double
    0 Mealy (Double, Progress) Double
    done) Mealy (Double, Progress) Double
    perSecRaw
                      perSecRaw :: Mealy (Double, Progress) Double
    perSecRaw = Double
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    forall i.
    Double -> Mealy i Double -> Mealy i Double -> Mealy i Double
    decay Double
    1.2 Mealy (Double, Progress) Double
    done Mealy (Double, Progress) Double
    secs

            -- Predicted build time for a rule that has never been built before
            -- The high decay means if a build goes in "phases" - lots of source files, then lots of compiling
            -- we reach a reasonable number fairly quickly, without bouncing too much
            ruleTime :: Mealy (Double, Progress) Double
    ruleTime = ((Int, Double) -> (Int, Double) -> Double)
    -> Mealy (Double, Progress) (Int, Double)
    -> Mealy (Double, Progress) (Int, Double)
    -> Mealy (Double, Progress) Double
    forall a b c.
    (a -> b -> c)
    -> Mealy (Double, Progress) a
    -> Mealy (Double, Progress) b
    -> Mealy (Double, Progress) c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 (Int, Double) -> (Int, Double) -> Double
    weightedAverage
                ((Mealy (Double, Progress) Double
     -> Mealy (Double, Progress) Double
     -> Mealy (Double, Progress) Double)
    -> (Progress -> Double)
    -> (Progress -> Int)
    -> Mealy (Double, Progress) (Int, Double)
    forall {b} {b}.
    (Mealy (Double, Progress) b
     -> Mealy (Double, Progress) Double -> Mealy (Double, Progress) b)
    -> (Progress -> b)
    -> (Progress -> Int)
    -> Mealy (Double, Progress) (Int, b)
    f (Double
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    forall i.
    Double -> Mealy i Double -> Mealy i Double -> Mealy i Double
    decay Double
    10) Progress -> Double
    timeBuilt Progress -> Int
    countBuilt)
                ((Mealy (Double, Progress) Double
     -> Mealy (Double, Progress) Double
     -> Mealy (Double, Progress) Double)
    -> (Progress -> Double)
    -> (Progress -> Int)
    -> Mealy (Double, Progress) (Int, Double)
    forall {b} {b}.
    (Mealy (Double, Progress) b
     -> Mealy (Double, Progress) Double -> Mealy (Double, Progress) b)
    -> (Progress -> b)
    -> (Progress -> Int)
    -> Mealy (Double, Progress) (Int, b)
    f ((Double -> Double -> Double)
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    forall a b c.
    (a -> b -> c)
    -> Mealy (Double, Progress) a
    -> Mealy (Double, Progress) b
    -> Mealy (Double, Progress) c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    (/)) ((Double, Int) -> Double
    forall a b. (a, b) -> a
    fst ((Double, Int) -> Double)
    -> (Progress -> (Double, Int)) -> Progress -> Double
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Progress -> (Double, Int)
    timeTodo) (\Progress{Double
    Int
    Maybe [Char]
    (Double, Int)
    countBuilt :: Progress -> Int
    timeBuilt :: Progress -> Double
    countSkipped :: Progress -> Int
    timeSkipped :: Progress -> Double
    countUnknown :: Progress -> Int
    timeUnknown :: Progress -> Double
    timeTodo :: Progress -> (Double, Int)
    countTodo :: Progress -> Int
    isFailure :: Maybe [Char]
    countSkipped :: Int
    countBuilt :: Int
    countUnknown :: Int
    countTodo :: Int
    timeSkipped :: Double
    timeBuilt :: Double
    timeUnknown :: Double
    timeTodo :: (Double, Int)
    isFailure :: Progress -> Maybe [Char]
    ..} -> Int
    countTodo Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - (Double, Int) -> Int
    forall a b. (a, b) -> b
    snd (Double, Int)
    timeTodo))
                -- don't call decay on todo, since it goes up and down (as things get done)
                where
                    weightedAverage :: (Int, Double) -> (Int, Double) -> Double
    weightedAverage (Int
    w1,Double
    x1) (Int
    w2,Double
    x2)
                        | Int
    w1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 Bool -> Bool -> Bool
    && Int
    w2 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 = Double
    0
                        | Bool
    otherwise = ((Int
    w1 Int -> Double -> Double
    *. Double
    x1) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + (Int
    w2 Int -> Double -> Double
    *. Double
    x2)) Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Int -> Double
    intToDouble (Int
    w1Int -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    w2)
                        where Int
    i *. :: Int -> Double -> Double
    *. Double
    d = if Int
    i Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0 then Double
    0 else Int -> Double
    intToDouble Int
    i Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    d -- since d might be NaN

                    f :: (Mealy (Double, Progress) b
     -> Mealy (Double, Progress) Double -> Mealy (Double, Progress) b)
    -> (Progress -> b)
    -> (Progress -> Int)
    -> Mealy (Double, Progress) (Int, b)
    f Mealy (Double, Progress) b
    -> Mealy (Double, Progress) Double -> Mealy (Double, Progress) b
    divide Progress -> b
    time Progress -> Int
    count = let xs :: Mealy (Double, Progress) Int
    xs = Progress -> Int
    count (Progress -> Int)
    -> Mealy (Double, Progress) Progress
    -> Mealy (Double, Progress) Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Mealy (Double, Progress) Progress
    progress in (Int -> b -> (Int, b))
    -> Mealy (Double, Progress) Int
    -> Mealy (Double, Progress) b
    -> Mealy (Double, Progress) (Int, b)
    forall a b c.
    (a -> b -> c)
    -> Mealy (Double, Progress) a
    -> Mealy (Double, Progress) b
    -> Mealy (Double, Progress) c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 (,) Mealy (Double, Progress) Int
    xs (Mealy (Double, Progress) b -> Mealy (Double, Progress) (Int, b))
    -> Mealy (Double, Progress) b -> Mealy (Double, Progress) (Int, b)
    forall a b. (a -> b) -> a -> b
    $ Mealy (Double, Progress) b
    -> Mealy (Double, Progress) Double -> Mealy (Double, Progress) b
    divide (Progress -> b
    time (Progress -> b)
    -> Mealy (Double, Progress) Progress -> Mealy (Double, Progress) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Mealy (Double, Progress) Progress
    progress) (Int -> Double
    intToDouble (Int -> Double)
    -> Mealy (Double, Progress) Int -> Mealy (Double, Progress) Double
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Mealy (Double, Progress) Int
    xs)

            -- Number of seconds work remaining, ignoring multiple threads
            todo :: Mealy (Double, Progress) Double
    todo = Progress -> Double -> Double
    f (Progress -> Double -> Double)
    -> Mealy (Double, Progress) Progress
    -> Mealy (Double, Progress) (Double -> Double)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Mealy (Double, Progress) Progress
    progress Mealy (Double, Progress) (Double -> Double)
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    forall a b.
    Mealy (Double, Progress) (a -> b)
    -> Mealy (Double, Progress) a -> Mealy (Double, Progress) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Mealy (Double, Progress) Double
    ruleTime
                where f :: Progress -> Double -> Double
    f Progress{Double
    Int
    Maybe [Char]
    (Double, Int)
    countBuilt :: Progress -> Int
    timeBuilt :: Progress -> Double
    countSkipped :: Progress -> Int
    timeSkipped :: Progress -> Double
    countUnknown :: Progress -> Int
    timeUnknown :: Progress -> Double
    timeTodo :: Progress -> (Double, Int)
    countTodo :: Progress -> Int
    isFailure :: Progress -> Maybe [Char]
    isFailure :: Maybe [Char]
    countSkipped :: Int
    countBuilt :: Int
    countUnknown :: Int
    countTodo :: Int
    timeSkipped :: Double
    timeBuilt :: Double
    timeUnknown :: Double
    timeTodo :: (Double, Int)
    ..} Double
    ruleTime = (Double, Int) -> Double
    forall a b. (a, b) -> a
    fst (Double, Int)
    timeTodo Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + (Int -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral ((Double, Int) -> Int
    forall a b. (a, b) -> b
    snd (Double, Int)
    timeTodo) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    ruleTime)

            -- Display information
            time :: Mealy (Double, Progress) Double
    time = (Double -> Double -> Double)
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    forall a b c.
    (a -> b -> c)
    -> Mealy (Double, Progress) a
    -> Mealy (Double, Progress) b
    -> Mealy (Double, Progress) c
    forall (f :: * -> *) a b c.
    Applicative f =>
    (a -> b -> c) -> f a -> f b -> f c
    liftA2 Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    (/) Mealy (Double, Progress) Double
    todo Mealy (Double, Progress) Double
    donePerSec
            perc :: Mealy (Double, Progress) Double
    perc = Mealy (Double, Progress) Bool
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    forall i a. Mealy i Bool -> Mealy i a -> Mealy i a -> Mealy i a
    iff (Double -> Double -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) Double
    0 (Double -> Bool)
    -> Mealy (Double, Progress) Double -> Mealy (Double, Progress) Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Mealy (Double, Progress) Double
    done) (Double -> Mealy (Double, Progress) Double
    forall a. a -> Mealy (Double, Progress) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Double
    0) (Mealy (Double, Progress) Double
     -> Mealy (Double, Progress) Double)
    -> Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    forall a b. (a -> b) -> a -> b
    $
                Mealy (Double, Progress) Double
    -> Mealy (Double, Progress) Double
    -> (Double -> Double -> Double)
    -> Mealy (Double, Progress) Double
    forall (m :: * -> *) a b c.
    Applicative m =>
    m a -> m b -> (a -> b -> c) -> m c
    liftA2' Mealy (Double, Progress) Double
    done Mealy (Double, Progress) Double
    todo ((Double -> Double -> Double) -> Mealy (Double, Progress) Double)
    -> (Double -> Double -> Double) -> Mealy (Double, Progress) Double
    forall a b. (a -> b) -> a -> b
    $ \Double
    done Double
    todo -> Double
    100 Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    done Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / (Double
    done Double -> Double -> Double
    forall a. Num a => a -> a -> a
    + Double
    todo)

    ---------------------------------------------------------------------
    -- EXPOSED FUNCTIONS

    -- | Given a sampling interval (in seconds) and a way to display the status message,
    --   produce a function suitable for using as 'Development.Shake.shakeProgress'.
    --   This function polls the progress information every /n/ seconds, produces a status
    --   message and displays it using the display function.
    --
    --   Typical status messages will take the form of @1m25s (15%)@, indicating that the build
    --   is predicted to complete in 1 minute 25 seconds (85 seconds total), and 15% of the necessary build time has elapsed.
    --   This function uses past observations to predict future behaviour, and as such, is only
    --   guessing. The time is likely to go up as well as down, and will be less accurate from a
    --   clean build (as the system has fewer past observations).
    --
    --   The current implementation is to predict the time remaining (based on 'timeTodo') and the
    --   work already done ('timeBuilt'). The percentage is then calculated as @remaining / (done + remaining)@,
    --   while time left is calculated by scaling @remaining@ by the observed work rate in this build,
    --   roughly @done / time_elapsed@.
    progressDisplay :: Double -> (String -> IO ()) -> IO Progress -> IO ()
    progressDisplay :: Double -> ([Char] -> IO ()) -> IO Progress -> IO ()
    progressDisplay Double
    sample [Char] -> IO ()
    disp IO Progress
    prog = do
        [Char] -> IO ()
    disp [Char]
    "Starting..." -- no useful info at this stage
        time <- IO (IO Double)
    offsetTime
        catchJust (\AsyncException
    x -> if AsyncException
    x AsyncException -> AsyncException -> Bool
    forall a. Eq a => a -> a -> Bool
    == AsyncException
    ThreadKilled then () -> Maybe ()
    forall a. a -> Maybe a
    Just () else Maybe ()
    forall a. Maybe a
    Nothing)
            (loop time $ message echoMealy)
            (const $ do t <- time; disp $ "Finished in " ++ showDuration t)
        where
            loop :: IO Double -> Mealy (Double, Progress) (Double, Double, String) -> IO ()
            loop :: IO Double
    -> Mealy (Double, Progress) (Double, Double, [Char]) -> IO ()
    loop IO Double
    time Mealy (Double, Progress) (Double, Double, [Char])
    mealy = do
                Double -> IO ()
    sleep Double
    sample
                p <- IO Progress
    prog
                t <- time
                ((secs,perc,_debug), mealy)<- pure $ runMealy mealy (t, p)
                -- putStrLn _debug
                let done = Progress -> Int
    countSkipped Progress
    p Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Progress -> Int
    countBuilt Progress
    p
                let todo = Int
    done Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Progress -> Int
    countUnknown Progress
    p Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Progress -> Int
    countTodo Progress
    p
                disp $
                    "Running for " ++ showDurationSecs t ++ " [" ++ show done ++ "/" ++ show todo ++ "]" ++
                    ", predicted " ++ formatMessage secs perc ++
                    maybe "" (", Failure! " ++) (isFailure p)
                loop time mealy

    data ProgressEntry = ProgressEntry
        {ProgressEntry -> Double
    idealSecs :: Double, ProgressEntry -> Double
    idealPerc :: Double
        ,ProgressEntry -> Double
    actualSecs :: Double, ProgressEntry -> Double
    actualPerc :: Double
        }

    isInvalid :: ProgressEntry -> Bool
    isInvalid :: ProgressEntry -> Bool
    isInvalid ProgressEntry{Double
    idealSecs :: ProgressEntry -> Double
    idealPerc :: ProgressEntry -> Double
    actualSecs :: ProgressEntry -> Double
    actualPerc :: ProgressEntry -> Double
    idealSecs :: Double
    idealPerc :: Double
    actualSecs :: Double
    actualPerc :: Double
    ..} = Double -> Bool
    forall a. RealFloat a => a -> Bool
    isNaN Double
    actualSecs Bool -> Bool -> Bool
    || Double -> Bool
    forall a. RealFloat a => a -> Bool
    isNaN Double
    actualPerc

    -- | Given a list of progress inputs, what would you have suggested (seconds, percentage)
    progressReplay :: [(Double, Progress)] -> [ProgressEntry]
    progressReplay :: [(Double, Progress)] -> [ProgressEntry]
    progressReplay [] = []
    progressReplay [(Double, Progress)]
    ps = (Mealy (Double, Progress) (Double, Double, [Char]),
     [ProgressEntry])
    -> [ProgressEntry]
    forall a b. (a, b) -> b
    snd ((Mealy (Double, Progress) (Double, Double, [Char]),
      [ProgressEntry])
     -> [ProgressEntry])
    -> (Mealy (Double, Progress) (Double, Double, [Char]),
        [ProgressEntry])
    -> [ProgressEntry]
    forall a b. (a -> b) -> a -> b
    $ (Mealy (Double, Progress) (Double, Double, [Char])
     -> (Double, Progress)
     -> (Mealy (Double, Progress) (Double, Double, [Char]),
         ProgressEntry))
    -> Mealy (Double, Progress) (Double, Double, [Char])
    -> [(Double, Progress)]
    -> (Mealy (Double, Progress) (Double, Double, [Char]),
        [ProgressEntry])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL Mealy (Double, Progress) (Double, Double, [Char])
    -> (Double, Progress)
    -> (Mealy (Double, Progress) (Double, Double, [Char]),
        ProgressEntry)
    forall {b} {c}.
    Mealy (Double, b) (Double, Double, c)
    -> (Double, b)
    -> (Mealy (Double, b) (Double, Double, c), ProgressEntry)
    f (Mealy (Double, Progress) (Double, Progress)
    -> Mealy (Double, Progress) (Double, Double, [Char])
    message Mealy (Double, Progress) (Double, Progress)
    forall i. Mealy i i
    echoMealy) [(Double, Progress)]
    ps
        where
            end :: Double
    end = (Double, Progress) -> Double
    forall a b. (a, b) -> a
    fst ((Double, Progress) -> Double) -> (Double, Progress) -> Double
    forall a b. (a -> b) -> a -> b
    $ [(Double, Progress)] -> (Double, Progress)
    forall a. Partial => [a] -> a
    last [(Double, Progress)]
    ps
            f :: Mealy (Double, b) (Double, Double, c)
    -> (Double, b)
    -> (Mealy (Double, b) (Double, Double, c), ProgressEntry)
    f Mealy (Double, b) (Double, Double, c)
    a (Double
    time,b
    p) = (Mealy (Double, b) (Double, Double, c)
    a2, Double -> Double -> Double -> Double -> ProgressEntry
    ProgressEntry (Double
    end Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - Double
    time) (Double
    time Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    100 Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / Double
    end) Double
    secs Double
    perc)
                where ((Double
    secs,Double
    perc,c
    _),Mealy (Double, b) (Double, Double, c)
    a2) = Mealy (Double, b) (Double, Double, c)
    -> (Double, b)
    -> ((Double, Double, c), Mealy (Double, b) (Double, Double, c))
    forall i a. Mealy i a -> i -> (a, Mealy i a)
    runMealy Mealy (Double, b) (Double, Double, c)
    a (Double
    time,b
    p)

    -- | Given a trace, display information about how well we did
    writeProgressReport :: FilePath -> [(FilePath, [(Double, Progress)])] -> IO ()
    writeProgressReport :: [Char] -> [([Char], [(Double, Progress)])] -> IO ()
    writeProgressReport [Char]
    out ((([Char], [(Double, Progress)]) -> ([Char], [ProgressEntry]))
    -> [([Char], [(Double, Progress)])] -> [([Char], [ProgressEntry])]
    forall a b. (a -> b) -> [a] -> [b]
    map (([(Double, Progress)] -> [ProgressEntry])
    -> ([Char], [(Double, Progress)]) -> ([Char], [ProgressEntry])
    forall b b' a. (b -> b') -> (a, b) -> (a, b')
    second [(Double, Progress)] -> [ProgressEntry]
    progressReplay) -> [([Char], [ProgressEntry])]
    xs)
        | ([Char]
    bad,[ProgressEntry]
    _):[([Char], [ProgressEntry])]
    _ <- (([Char], [ProgressEntry]) -> Bool)
    -> [([Char], [ProgressEntry])] -> [([Char], [ProgressEntry])]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((ProgressEntry -> Bool) -> [ProgressEntry] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ProgressEntry -> Bool
    isInvalid ([ProgressEntry] -> Bool)
    -> (([Char], [ProgressEntry]) -> [ProgressEntry])
    -> ([Char], [ProgressEntry])
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char], [ProgressEntry]) -> [ProgressEntry]
    forall a b. (a, b) -> b
    snd) [([Char], [ProgressEntry])]
    xs = [Char] -> IO ()
    forall a. Partial => [Char] -> IO a
    errorIO ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "Progress generates NaN for " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    bad
        | [Char] -> [Char]
    takeExtension [Char]
    out [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    ".js" = [Char] -> [Char] -> IO ()
    writeFile [Char]
    out ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "var shake = \n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [([Char], [ProgressEntry])] -> [Char]
    generateJSON [([Char], [ProgressEntry])]
    xs
        | [Char] -> [Char]
    takeExtension [Char]
    out [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    ".json" = [Char] -> [Char] -> IO ()
    writeFile [Char]
    out ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [([Char], [ProgressEntry])] -> [Char]
    generateJSON [([Char], [ProgressEntry])]
    xs
        | [Char]
    out [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "-" = [Char] -> IO ()
    putStr ([Char] -> IO ()) -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [[Char]] -> [Char]
    unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [([Char], [ProgressEntry])] -> [[Char]]
    generateSummary [([Char], [ProgressEntry])]
    xs
        | Bool
    otherwise = [Char] -> ByteString -> IO ()
    LBS.writeFile [Char]
    out (ByteString -> IO ()) -> IO ByteString -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< [([Char], [ProgressEntry])] -> IO ByteString
    generateHTML [([Char], [ProgressEntry])]
    xs

    generateSummary :: [(FilePath, [ProgressEntry])] -> [String]
    generateSummary :: [([Char], [ProgressEntry])] -> [[Char]]
    generateSummary [([Char], [ProgressEntry])]
    xs = ((([Char], [ProgressEntry]) -> [[Char]])
     -> [([Char], [ProgressEntry])] -> [[Char]])
    -> [([Char], [ProgressEntry])]
    -> (([Char], [ProgressEntry]) -> [[Char]])
    -> [[Char]]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (([Char], [ProgressEntry]) -> [[Char]])
    -> [([Char], [ProgressEntry])] -> [[Char]]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap [([Char], [ProgressEntry])]
    xs ((([Char], [ProgressEntry]) -> [[Char]]) -> [[Char]])
    -> (([Char], [ProgressEntry]) -> [[Char]]) -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ \([Char]
    file,[ProgressEntry]
    xs) ->
        [[Char]
    "# " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    file, [ProgressEntry]
    -> [Char]
    -> (ProgressEntry -> Double)
    -> (ProgressEntry -> Double)
    -> [Char]
    forall {a} {a}.
    RealFrac a =>
    [a] -> [Char] -> (a -> a) -> (a -> a) -> [Char]
    f [ProgressEntry]
    xs [Char]
    "Seconds" ProgressEntry -> Double
    idealSecs ProgressEntry -> Double
    actualSecs, [ProgressEntry]
    -> [Char]
    -> (ProgressEntry -> Double)
    -> (ProgressEntry -> Double)
    -> [Char]
    forall {a} {a}.
    RealFrac a =>
    [a] -> [Char] -> (a -> a) -> (a -> a) -> [Char]
    f [ProgressEntry]
    xs [Char]
    "Percent" ProgressEntry -> Double
    idealPerc ProgressEntry -> Double
    actualPerc]
        where
            levels :: [Int]
    levels = [Int
    100,Int
    90,Int
    80,Int
    50]
            f :: [a] -> [Char] -> (a -> a) -> (a -> a) -> [Char]
    f [a]
    xs [Char]
    lbl a -> a
    ideal a -> a
    actual = [Char]
    lbl [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ": " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    ", "
                [Int -> [Char]
    forall a. Show a => a -> [Char]
    show Int
    l [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "% within " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ Integer -> [Char]
    forall a. Show a => a -> [Char]
    show (a -> Integer
    forall b. Integral b => a -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling (a -> Integer) -> a -> Integer
    forall a b. (a -> b) -> a -> b
    $ [a] -> a
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([a] -> a) -> [a] -> a
    forall a b. (a -> b) -> a -> b
    $ a
    0 a -> [a] -> [a]
    forall a. a -> [a] -> [a]
    : Int -> [a] -> [a]
    forall a. Int -> [a] -> [a]
    take (([a] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [a]
    xs Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    l) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    100) [a]
    diff) | Int
    l <- [Int]
    levels]
                where diff :: [a]
    diff = [a] -> [a]
    forall a. Ord a => [a] -> [a]
    sort [a -> a
    forall a. Num a => a -> a
    abs (a -> a) -> a -> a
    forall a b. (a -> b) -> a -> b
    $ a -> a
    ideal a
    x a -> a -> a
    forall a. Num a => a -> a -> a
    - a -> a
    actual a
    x | a
    x <- [a]
    xs]

    generateHTML :: [(FilePath, [ProgressEntry])] -> IO LBS.ByteString
    generateHTML :: [([Char], [ProgressEntry])] -> IO ByteString
    generateHTML [([Char], [ProgressEntry])]
    xs = do
        report <- [Char] -> IO ByteString
    readDataFileHTML [Char]
    "progress.html"
        let f [Char]
    "data/progress-data.js" = ByteString -> f ByteString
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ByteString -> f ByteString) -> ByteString -> f ByteString
    forall a b. (a -> b) -> a -> b
    $ [Char] -> ByteString
    LBS.pack ([Char] -> ByteString) -> [Char] -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "var progress =\n" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [([Char], [ProgressEntry])] -> [Char]
    generateJSON [([Char], [ProgressEntry])]
    xs
        runTemplate f report

    generateJSON :: [(FilePath, [ProgressEntry])] -> String
    generateJSON :: [([Char], [ProgressEntry])] -> [Char]
    generateJSON = [[Char]] -> [Char]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[Char]] -> [Char])
    -> ([([Char], [ProgressEntry])] -> [[Char]])
    -> [([Char], [ProgressEntry])]
    -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Char]] -> [[Char]]
    jsonList ([[Char]] -> [[Char]])
    -> ([([Char], [ProgressEntry])] -> [[Char]])
    -> [([Char], [ProgressEntry])]
    -> [[Char]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (([Char], [ProgressEntry]) -> [Char])
    -> [([Char], [ProgressEntry])] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map (([Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++[Char]
    "}") ([Char] -> [Char])
    -> (([Char], [ProgressEntry]) -> [Char])
    -> ([Char], [ProgressEntry])
    -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Char]] -> [Char]
    unlines ([[Char]] -> [Char])
    -> (([Char], [ProgressEntry]) -> [[Char]])
    -> ([Char], [ProgressEntry])
    -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Char], [ProgressEntry]) -> [[Char]]
    f)
        where
            f :: ([Char], [ProgressEntry]) -> [[Char]]
    f ([Char]
    file,[ProgressEntry]
    ps) =
                ([Char]
    "{\"name\":" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [Char]
    forall a. Show a => a -> [Char]
    show ([Char] -> [Char]
    takeFileName [Char]
    file) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ", \"values\":") [Char] -> [[Char]] -> [[Char]]
    forall a. a -> [a] -> [a]
    :
                [[Char]] -> [[Char]]
    indent ([[Char]] -> [[Char]]
    jsonList ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> a -> b
    $ (ProgressEntry -> [Char]) -> [ProgressEntry] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map ProgressEntry -> [Char]
    g [ProgressEntry]
    ps)

            shw :: Double -> [Char]
    shw = Int -> Double -> [Char]
    forall a. RealFloat a => Int -> a -> [Char]
    showDP Int
    1
            g :: ProgressEntry -> [Char]
    g ProgressEntry{Double
    idealSecs :: ProgressEntry -> Double
    idealPerc :: ProgressEntry -> Double
    actualSecs :: ProgressEntry -> Double
    actualPerc :: ProgressEntry -> Double
    idealSecs :: Double
    idealPerc :: Double
    actualSecs :: Double
    actualPerc :: Double
    ..} = [([Char], [Char])] -> [Char]
    forall {a}. Show a => [(a, [Char])] -> [Char]
    jsonObject
                [([Char]
    "idealSecs",Double -> [Char]
    shw Double
    idealSecs),([Char]
    "idealPerc",Double -> [Char]
    shw Double
    idealPerc)
                ,([Char]
    "actualSecs",Double -> [Char]
    shw Double
    actualSecs),([Char]
    "actualPerc",Double -> [Char]
    shw Double
    actualPerc)]

    indent :: [[Char]] -> [[Char]]
    indent = ([Char] -> [Char]) -> [[Char]] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Char]
    "  "[Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++)
    jsonList :: [[Char]] -> [[Char]]
    jsonList [[Char]]
    xs = (Char -> [Char] -> [Char]) -> [Char] -> [[Char]] -> [[Char]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith (:) (Char
    '['Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :Char -> [Char]
    forall a. a -> [a]
    repeat Char
    ',') [[Char]]
    xs [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]
    "]"]
    jsonObject :: [(a, [Char])] -> [Char]
    jsonObject [(a, [Char])]
    xs = [Char]
    "{" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char] -> [[Char]] -> [Char]
    forall a. [a] -> [[a]] -> [a]
    intercalate [Char]
    ", " [a -> [Char]
    forall a. Show a => a -> [Char]
    show a
    a [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ":" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    b | (a
    a,[Char]
    b) <- [(a, [Char])]
    xs] [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "}"

    -- | Set the title of the current console window to the given text. If the
    --   environment variable @$TERM@ is set to @xterm@ this uses xterm escape sequences.
    --   On Windows, if not detected as an xterm, this function uses the @SetConsoleTitle@ API.
    progressTitlebar :: String -> IO ()
    progressTitlebar :: [Char] -> IO ()
    progressTitlebar [Char]
    x = IO Bool -> IO () -> IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    unlessM IO Bool
    win IO ()
    lin
        where
    #ifdef mingw32_HOST_OS
            win = withCWString x c_setConsoleTitleW
    #else
            win :: IO Bool
    win = Bool -> IO Bool
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    False
    #endif

            lin :: IO ()
    lin = IO Bool -> IO () -> IO ()
    forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
    whenM IO Bool
    checkEscCodes (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ OneShot BS_Store -> IO ()
    BS.putStr (OneShot BS_Store -> IO ()) -> OneShot BS_Store -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> OneShot BS_Store
    BS.pack ([Char] -> OneShot BS_Store) -> [Char] -> OneShot BS_Store
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    escWindowTitle [Char]
    x

    -- | Call the program @shake-progress@ if it is on the @$PATH@. The program is called with
    --   the following arguments:
    --
    -- * @--title=string@ - the string passed to @progressProgram@.
    --
    -- * @--state=Normal@, or one of @NoProgress@, @Normal@, or @Error@ to indicate
    --   what state the progress bar should be in.
    --
    -- * @--value=25@ - the percent of the build that has completed, if not in @NoProgress@ state.
    --
    --   The program will not be called consecutively with the same @--state@ and @--value@ options.
    --
    --   Windows 7 or higher users can get taskbar progress notifications by placing the following
    --   program in their @$PATH@: <https://github.com/ndmitchell/shake/releases>.
    progressProgram :: IO (String -> IO ())
    progressProgram :: IO ([Char] -> IO ())
    progressProgram = do
        exe <- [Char] -> IO (Maybe [Char])
    findExecutable [Char]
    "shake-progress"
        case exe of
            Maybe [Char]
    Nothing -> ([Char] -> IO ()) -> IO ([Char] -> IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (([Char] -> IO ()) -> IO ([Char] -> IO ()))
    -> ([Char] -> IO ()) -> IO ([Char] -> IO ())
    forall a b. (a -> b) -> a -> b
    $ IO () -> [Char] -> IO ()
    forall a b. a -> b -> a
    const (IO () -> [Char] -> IO ()) -> IO () -> [Char] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
            Just [Char]
    exe -> do
                lastArgs <- Maybe [[Char]] -> IO (IORef (Maybe [[Char]]))
    forall a. a -> IO (IORef a)
    newIORef Maybe [[Char]]
    forall a. Maybe a
    Nothing -- the arguments we passed to shake-progress last time
                pure $ \[Char]
    msg -> do
                    let failure :: Bool
    failure = [Char]
    " Failure! " [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf` [Char]
    msg
                    let perc :: [Char]
    perc = let ([Char]
    a,[Char]
    b) = (Char -> Bool) -> [Char] -> ([Char], [Char])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '%') [Char]
    msg
                               in if [Char] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Char]
    b then [Char]
    "" else [Char] -> [Char]
    forall a. [a] -> [a]
    reverse ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ (Char -> Bool) -> [Char] -> [Char]
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile Char -> Bool
    isDigit ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char]
    forall a. [a] -> [a]
    reverse [Char]
    a
                    let state :: [Char]
    state | [Char]
    perc [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Char]
    "" = [Char]
    "NoProgress"
                              | Bool
    failure = [Char]
    "Error"
                              | Bool
    otherwise = [Char]
    "Normal"
                    let args :: [[Char]]
    args = [[Char]
    "--title=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    msg, [Char]
    "--state=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    state] [[Char]] -> [[Char]] -> [[Char]]
    forall a. [a] -> [a] -> [a]
    ++ [[Char]
    "--value=" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    perc | [Char]
    perc [Char] -> [Char] -> Bool
    forall a. Eq a => a -> a -> Bool
    /= [Char]
    ""]
                    same <- IORef (Maybe [[Char]])
    -> (Maybe [[Char]] -> (Maybe [[Char]], Bool)) -> IO Bool
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef (Maybe [[Char]])
    lastArgs ((Maybe [[Char]] -> (Maybe [[Char]], Bool)) -> IO Bool)
    -> (Maybe [[Char]] -> (Maybe [[Char]], Bool)) -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ \Maybe [[Char]]
    old -> ([[Char]] -> Maybe [[Char]]
    forall a. a -> Maybe a
    Just [[Char]]
    args, Maybe [[Char]]
    old Maybe [[Char]] -> Maybe [[Char]] -> Bool
    forall a. Eq a => a -> a -> Bool
    == [[Char]] -> Maybe [[Char]]
    forall a. a -> Maybe a
    Just [[Char]]
    args)
                    unless same $ void $ rawSystem exe args

    -- | A simple method for displaying progress messages, suitable for using as 'Development.Shake.shakeProgress'.
    --   This function writes the current progress to the titlebar every five seconds using 'progressTitlebar',
    --   and calls any @shake-progress@ program on the @$PATH@ using 'progressProgram'.
    progressSimple :: IO Progress -> IO ()
    progressSimple :: IO Progress -> IO ()
    progressSimple IO Progress
    p = do
        program <- IO ([Char] -> IO ())
    progressProgram
        progressDisplay 5 (\[Char]
    s -> [Char] -> IO ()
    progressTitlebar [Char]
    s IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> [Char] -> IO ()
    program [Char]
    s) p