{-# LANGUAGE RecordWildCards, CPP, ViewPatterns, ForeignFunctionInterface, TupleSections #-}-- | Progress trackingmoduleDevelopment.Shake.Internal.Progress(progress ,progressSimple ,progressDisplay ,progressTitlebar ,progressProgram ,ProgressEntry (..),progressReplay ,writeProgressReport -- INTERNAL USE ONLY)whereimportControl.ApplicativeimportData.Tuple.ExtraimportControl.Exception.ExtraimportControl.Monad.ExtraimportSystem.DirectoryimportSystem.ProcessimportSystem.FilePathimportData.CharimportData.IORefimportData.ListimportData.MaybeimportDevelopment.Shake.Internal.Options importDevelopment.Shake.Internal.Core.Types importDevelopment.Shake.Internal.Core.Database importqualifiedData.ByteString.Char8asBSimportqualifiedData.ByteString.Lazy.Char8asLBSimportNumeric.ExtraimportGeneral.Template importGeneral.EscCodes importGeneral.Extra importDevelopment.Shake.Internal.Paths importSystem.Time.Extra
#ifdef mingw32_HOST_OS
importForeign.C.String
#ifdef x86_64_HOST_ARCH
#define CALLCONV ccall
#else
#define CALLCONV stdcall
#endif
foreignimportCALLCONV"Windows.h SetConsoleTitleW"c_setConsoleTitleW::CWString->IOBool
#endif
----------------------------------------------------------------------- PROGRESSprogress ::Database ->Step ->IOProgress 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 whereg :: Float -> Double
g =Float -> Double
floatToDoublef :: 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]
.. })=ifStep
step Step -> Step -> Bool
forall a. Eq a => a -> a -> Bool
==Step
built thenProgress
s {countBuilt =countBuilt s +1,timeBuilt =timeBuilt s +g execution }elseProgress
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 |JustResult {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 =letd2 :: Double
d2 =Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
+Float -> Double
g Float
execution inDouble
d2 Double -> (Double, Int) -> (Double, Int)
forall a b. a -> b -> b
`seq`(Double
d2 ,Int
c )|Bool
otherwise=letc2 :: Int
c2 =Int
c Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1inInt
c2 Int -> (Double, Int) -> (Double, Int)
forall a b. a -> b -> b
`seq`(Double
d ,Int
c2 )inProgress
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 outputsnewtypeMealy i a =Mealy {forall i a. Mealy i a -> i -> (a, Mealy i a)
runMealy ::i ->(a ,Mealy i a )}instanceFunctor(Mealy i )wherefmap :: forall a b. (a -> b) -> Mealy i a -> Mealy i b
fmapa -> 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 ->casei -> (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
fmapa -> b
f Mealy i a
m )instanceApplicative(Mealy i )wherepure :: forall a. a -> Mealy i a
purea
x =letr :: 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 ))inMealy 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 ->casei -> (a -> b, Mealy i (a -> b))
mf i
i of(a -> b
f ,Mealy i (a -> b)
mf )->casei -> (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 ->casei -> (b, Mealy i b)
m i
i of(b
x ,Mealy i b
m )->letz2 :: 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 UTILITIESoldMealy ::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
NothingMealy i (Bool, a)
s wheref :: 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
$ifBool
b thena -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybea
v Maybe a
old elsea
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 ->ifBool
c thena
t elsea
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 increasedecay ::Double->Mealy i Double->Mealy i Double->Mealy i Doubledecay :: 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
0Mealy 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
0Mealy i Double
b wherestep :: Double -> ((Double, Double), (Double, Double)) -> Double
step Double
r ((Double
a ,Double
a' ),(Double
b ,Double
b' ))=ifDouble -> Bool
forall a. RealFloat a => a -> Bool
isNaNDouble
r thenDouble
a' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
b' else((Double
r Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
b )Double -> Double -> Double
forall a. Num a => a -> a -> a
+Double
f Double -> 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
f Double -> Double -> Double
forall a. Num a => a -> a -> a
*(Double
b' Double -> Double -> Double
forall a. Num a => a -> a -> a
-Double
b ))----------------------------------------------------------------------- MESSAGE GENERATORformatMessage ::Double->Double->StringformatMessage :: Double -> Double -> [Char]
formatMessage Double
secs Double
perc =(ifDouble -> Bool
forall a. RealFloat a => a -> Bool
isNaNDouble
secs Bool -> Bool -> Bool
||Double
secs Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<Double
0then[Char]
"??s"elseInt -> [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
ceilingDouble
secs )[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
" ("[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++(ifDouble -> Bool
forall a. RealFloat a => a -> Bool
isNaNDouble
perc Bool -> Bool -> Bool
||Double
perc Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<Double
0Bool -> Bool -> Bool
||Double
perc Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>Double
100then[Char]
"??"elseInteger -> [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
floorDouble
perc )[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"%)"showMinSec ::Int->StringshowMinSec :: Int -> [Char]
showMinSec Int
secs =(ifInt
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0then[Char]
""elseInt -> [Char]
forall a. Show a => a -> [Char]
showInt
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]
showInt
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)
divModInt
secs Int
60liftA2' ::Applicativem =>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
liftA2a -> 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 whereprogress :: 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]
showDPInt
2Double
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]
showInt
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]
showDPInt
2Double
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]
showDPInt
2Double
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 wantdone :: 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 changedonePerSec :: 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
pureDouble
1)Mealy (Double, Progress) Double
perSecStable whereperSecStable :: 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
uncurryDouble -> 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
0Mealy (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.2Mealy (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 muchruleTime :: 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
liftA2Double -> 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)whereweightedAverage :: (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
0Bool -> 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
w1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
w2 )whereInt
i *. :: Int -> Double -> Double
*. Double
d =ifInt
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
0thenDouble
0elseInt -> Double
intToDoubleInt
i Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
d -- since d might be NaNf :: (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 =letxs :: 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 threadstodo :: 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 wheref :: 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 informationtime :: 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
liftA2Double -> 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
pureDouble
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
100Double -> 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())->IOProgress ->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 stageIO 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 ->ifAsyncException
x AsyncException -> AsyncException -> Bool
forall a. Eq a => a -> a -> Bool
==AsyncException
ThreadKilledthen() -> Maybe ()
forall a. a -> Maybe a
Just()elseMaybe ()
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
$doDouble
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]
showDurationDouble
t )whereloop ::IODouble->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 =doDouble -> IO ()
sleepDouble
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 )-- putStrLn _debugletdone :: Int
done =Progress -> Int
countSkipped Progress
p Int -> Int -> Int
forall a. Num a => a -> a -> a
+Progress -> Int
countBuilt Progress
p lettodo :: 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]
showInt
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]
showInt
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 dataProgressEntry =ProgressEntry {ProgressEntry -> Double
idealSecs ::Double,ProgressEntry -> Double
idealPerc ::Double,ProgressEntry -> Double
actualSecs ::Double,ProgressEntry -> Double
actualPerc ::Double}isInvalid ::ProgressEntry ->BoolisInvalid :: 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
isNaNDouble
actualSecs Bool -> Bool -> Bool
||Double -> Bool
forall a. RealFloat a => a -> Bool
isNaNDouble
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)
mapAccumLMealy (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 whereend :: 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
100Double -> 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 didwriteProgressReport ::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
anyProgressEntry -> 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 ]wherelevels :: [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]
showInt
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
0a -> [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 ]wherediff :: [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 ])]->IOLBS.ByteStringgenerateHTML :: [([Char], [ProgressEntry])] -> IO ByteString
generateHTML [([Char], [ProgressEntry])]
xs =doByteString
report <-[Char] -> IO ByteString
readDataFileHTML [Char]
"progress.html"letf :: [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 ])]->StringgenerateJSON :: [([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 )wheref :: ([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]
mapProgressEntry -> [Char]
g [ProgressEntry]
ps )shw :: Double -> [Char]
shw =Int -> Double -> [Char]
forall a. RealFloat a => Int -> a -> [Char]
showDPInt
1g :: 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]
repeatChar
',')[[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]
showa
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 ()
unlessMIO Bool
win IO ()
lin where
#ifdef mingw32_HOST_OS
win=withCWStringxc_setConsoleTitleW
#else
win :: IO Bool
win =Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pureBool
False
#endif
lin :: IO ()
lin =IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenMIO 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 =doMaybe [Char]
exe <-[Char] -> IO (Maybe [Char])
findExecutable[Char]
"shake-progress"caseMaybe [Char]
exe ofMaybe [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 ->doIORef (Maybe [[Char]])
lastArgs <-Maybe [[Char]] -> IO (IORef (Maybe [[Char]]))
forall a. a -> IO (IORef a)
newIORefMaybe [[Char]]
forall a. Maybe a
Nothing-- the arguments we passed to shake-progress last time([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 ->doletfailure :: Bool
failure =[Char]
" Failure! "[Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf`[Char]
msg letperc :: [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 inif[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]
takeWhileChar -> Bool
isDigit([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$[Char] -> [Char]
forall a. [a] -> [a]
reverse[Char]
a letstate :: [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"letargs :: [[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
atomicModifyIORefIORef (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 ()
unlessBool
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 -- | 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 ::IOProgress ->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