module Shake.Progress (report) where
import qualified Control.Concurrent as Concurrent
import qualified Development.Shake as Shake
import qualified System.Console.Regions as Regions
import qualified Text.Printf as Printf
import Control.Monad
report :: IO Shake.Progress -> IO ()
report :: IO Progress -> IO ()
report IO Progress
getProgress =
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
Concurrent.forkIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
RegionLayout -> (ConsoleRegion -> m a) -> m a
Regions.withConsoleRegion RegionLayout
Regions.Linear forall {b}. ConsoleRegion -> IO b
loop
where
loop :: ConsoleRegion -> IO b
loop ConsoleRegion
region = do
Progress
progress <- IO Progress
getProgress
forall v (m :: * -> *).
(ToRegionContent v, LiftRegion m) =>
ConsoleRegion -> v -> m ()
Regions.setConsoleRegion ConsoleRegion
region forall a b. (a -> b) -> a -> b
$ Progress -> [Char]
format Progress
progress
Int -> IO ()
Concurrent.threadDelay forall a b. (a -> b) -> a -> b
$ Int
1 forall a. Num a => a -> a -> a
* Int
10forall a b. (Num a, Integral b) => a -> b -> a
^Integer
6
ConsoleRegion -> IO b
loop ConsoleRegion
region
format :: Progress -> [Char]
format Progress
progress = forall r. PrintfType r => [Char] -> r
Printf.printf
([Char] -> [Char]
banner [Char]
"skip % 3d / built % 3d / todo % 3d -- %.1fs")
(Progress -> Int
Shake.countSkipped Progress
progress) (Progress -> Int
Shake.countBuilt Progress
progress)
(Progress -> Int
Shake.countTodo Progress
progress) (forall a b. (a, b) -> a
fst (Progress -> (Double, Int)
Shake.timeTodo Progress
progress))
forall a. [a] -> [a] -> [a]
++ if forall a b. (a, b) -> b
snd (Progress -> (Double, Int)
Shake.timeTodo Progress
progress) forall a. Eq a => a -> a -> Bool
== Int
0 then [Char]
""
else forall r. PrintfType r => [Char] -> r
Printf.printf [Char]
" (%d unknown)" (forall a b. (a, b) -> b
snd (Progress -> (Double, Int)
Shake.timeTodo Progress
progress))
banner :: [Char] -> [Char]
banner [Char]
msg = [[Char]] -> [Char]
unwords [forall a. Int -> a -> [a]
replicate Int
6 Char
'=', [Char]
msg, forall a. Int -> a -> [a]
replicate Int
6 Char
'=']