{-# LANGUAGE RecordWildCards, CPP, ViewPatterns, ForeignFunctionInterface, TupleSections #-}
module Development.Shake.Internal.Progress(
progress,
progressSimple, progressDisplay, progressTitlebar, progressProgram,
ProgressEntry(..), progressReplay, writeProgressReport
) 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 :: Database -> Step -> IO Progress
progress :: Database -> Step -> IO Progress
progress Database
db Step
step = do
[(Key, Status)]
xs <- Database -> IO [(Key, Status)]
forall k v. DatabasePoly k v -> IO [(k, v)]
getKeyValues Database
db
Progress -> IO Progress
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Progress -> IO Progress) -> Progress -> IO Progress
forall a b. (a -> b) -> a -> b
$! (Progress -> Status -> Progress)
-> Progress -> [Status] -> Progress
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Progress -> Status -> Progress
f Progress
forall a. Monoid a => a
mempty ([Status] -> Progress) -> [Status] -> Progress
forall a b. (a -> b) -> a -> b
$ ((Key, Status) -> Status) -> [(Key, Status)] -> [Status]
forall a b. (a -> b) -> [a] -> [b]
map (Key, Status) -> Status
forall a b. (a, b) -> b
snd [(Key, Status)]
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]
result :: forall a. Result a -> a
built :: forall a. Result a -> Step
changed :: forall a. Result a -> Step
depends :: forall a. Result a -> [Depends]
execution :: forall a. Result a -> Float
traces :: forall a. Result a -> [Trace]
..}) = 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
result :: forall a. Result a -> a
built :: forall a. Result a -> Step
changed :: forall a. Result a -> Step
depends :: forall a. Result a -> [Depends]
execution :: forall a. Result a -> Float
traces :: forall a. Result a -> [Trace]
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
result :: forall a. Result a -> a
built :: forall a. Result a -> Step
changed :: forall a. Result a -> Step
depends :: forall a. Result a -> [Depends]
execution :: forall a. Result a -> Float
traces :: forall a. Result a -> [Trace]
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
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)
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 :: 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))
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
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)
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
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
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))
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
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)
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)
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)
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..."
IO Double
time <- IO (IO Double)
offsetTime
(AsyncException -> Maybe ()) -> IO () -> (() -> IO ()) -> IO ()
forall e b a.
Exception e =>
(e -> Maybe b) -> IO a -> (b -> IO a) -> IO a
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)
(IO Double
-> Mealy (Double, Progress) (Double, Double, [Char]) -> IO ()
loop IO Double
time (Mealy (Double, Progress) (Double, Double, [Char]) -> IO ())
-> Mealy (Double, Progress) (Double, Double, [Char]) -> IO ()
forall a b. (a -> b) -> a -> b
$ Mealy (Double, Progress) (Double, Progress)
-> Mealy (Double, Progress) (Double, Double, [Char])
message Mealy (Double, Progress) (Double, Progress)
forall i. Mealy i i
echoMealy)
(IO () -> () -> IO ()
forall a b. a -> b -> a
const (IO () -> () -> IO ()) -> IO () -> () -> IO ()
forall a b. (a -> b) -> a -> b
$ do Double
t <- IO Double
time; [Char] -> IO ()
disp ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Finished in " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Double -> [Char]
showDuration Double
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
Progress
p <- IO Progress
prog
Double
t <- IO Double
time
((Double
secs,Double
perc,[Char]
_debug), Mealy (Double, Progress) (Double, Double, [Char])
mealy)<- ((Double, Double, [Char]),
Mealy (Double, Progress) (Double, Double, [Char]))
-> IO
((Double, Double, [Char]),
Mealy (Double, Progress) (Double, Double, [Char]))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (((Double, Double, [Char]),
Mealy (Double, Progress) (Double, Double, [Char]))
-> IO
((Double, Double, [Char]),
Mealy (Double, Progress) (Double, Double, [Char])))
-> ((Double, Double, [Char]),
Mealy (Double, Progress) (Double, Double, [Char]))
-> IO
((Double, Double, [Char]),
Mealy (Double, Progress) (Double, Double, [Char]))
forall a b. (a -> b) -> a -> b
$ Mealy (Double, Progress) (Double, Double, [Char])
-> (Double, Progress)
-> ((Double, Double, [Char]),
Mealy (Double, Progress) (Double, Double, [Char]))
forall i a. Mealy i a -> i -> (a, Mealy i a)
runMealy Mealy (Double, Progress) (Double, Double, [Char])
mealy (Double
t, Progress
p)
let done :: Int
done = Progress -> Int
countSkipped Progress
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Progress -> Int
countBuilt Progress
p
let todo :: Int
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
[Char] -> IO ()
disp ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$
[Char]
"Running for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Double -> [Char]
showDurationSecs Double
t [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" [" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
done [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
todo [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"]" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char]
", predicted " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Double -> Double -> [Char]
formatMessage Double
secs Double
perc [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++
[Char] -> ([Char] -> [Char]) -> Maybe [Char] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"" ([Char]
", Failure! " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) (Progress -> Maybe [Char]
isFailure Progress
p)
IO Double
-> Mealy (Double, Progress) (Double, Double, [Char]) -> IO ()
loop IO Double
time Mealy (Double, Progress) (Double, Double, [Char])
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
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)
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
ByteString
report <- [Char] -> IO ByteString
readDataFileHTML [Char]
"progress.html"
let f :: [Char] -> f ByteString
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
([Char] -> IO ByteString) -> ByteString -> IO ByteString
runTemplate [Char] -> IO ByteString
forall {f :: * -> *}. Applicative f => [Char] -> f ByteString
f ByteString
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]
"}"
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
progressProgram :: IO (String -> IO ())
progressProgram :: IO ([Char] -> IO ())
progressProgram = do
Maybe [Char]
exe <- [Char] -> IO (Maybe [Char])
findExecutable [Char]
"shake-progress"
case Maybe [Char]
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
IORef (Maybe [[Char]])
lastArgs <- Maybe [[Char]] -> IO (IORef (Maybe [[Char]]))
forall a. a -> IO (IORef a)
newIORef Maybe [[Char]]
forall a. Maybe a
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
$ \[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]
""]
Bool
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)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
same (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ExitCode -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]] -> IO ExitCode
rawSystem [Char]
exe [[Char]]
args
progressSimple :: IO Progress -> IO ()
progressSimple :: IO Progress -> IO ()
progressSimple IO Progress
p = do
[Char] -> IO ()
program <- IO ([Char] -> IO ())
progressProgram
Double -> ([Char] -> IO ()) -> IO Progress -> IO ()
progressDisplay Double
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) IO Progress
p