module General.Timing(resetTimings, addTiming, printTimings) where
import Data.IORef
import System.IO.Unsafe
import Numeric.Extra
import System.Time.Extra
{-# NOINLINE timer #-}
timer :: IO Seconds
timer :: IO Seconds
timer = IO (IO Seconds) -> IO Seconds
forall a. IO a -> a
unsafePerformIO IO (IO Seconds)
offsetTime
{-# NOINLINE timings #-}
timings :: IORef [(Seconds, String)]
timings :: IORef [(Seconds, String)]
timings = IO (IORef [(Seconds, String)]) -> IORef [(Seconds, String)]
forall a. IO a -> a
unsafePerformIO (IO (IORef [(Seconds, String)]) -> IORef [(Seconds, String)])
-> IO (IORef [(Seconds, String)]) -> IORef [(Seconds, String)]
forall a b. (a -> b) -> a -> b
$ [(Seconds, String)] -> IO (IORef [(Seconds, String)])
forall a. a -> IO (IORef a)
newIORef []
resetTimings :: IO ()
resetTimings :: IO ()
resetTimings = do
Seconds
now <- IO Seconds
timer
IORef [(Seconds, String)] -> [(Seconds, String)] -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef [(Seconds, String)]
timings [(Seconds
now, "Start")]
printTimings :: IO ()
printTimings :: IO ()
printTimings = do
Seconds
now <- IO Seconds
timer
[(Seconds, String)]
old <- IORef [(Seconds, String)]
-> ([(Seconds, String)]
-> ([(Seconds, String)], [(Seconds, String)]))
-> IO [(Seconds, String)]
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [(Seconds, String)]
timings (([(Seconds, String)]
-> ([(Seconds, String)], [(Seconds, String)]))
-> IO [(Seconds, String)])
-> ([(Seconds, String)]
-> ([(Seconds, String)], [(Seconds, String)]))
-> IO [(Seconds, String)]
forall a b. (a -> b) -> a -> b
$ \ts :: [(Seconds, String)]
ts -> ([(Seconds
now, "Start")], [(Seconds, String)]
ts)
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ Seconds -> [(Seconds, String)] -> [String]
showTimings Seconds
now ([(Seconds, String)] -> [String])
-> [(Seconds, String)] -> [String]
forall a b. (a -> b) -> a -> b
$ [(Seconds, String)] -> [(Seconds, String)]
forall a. [a] -> [a]
reverse [(Seconds, String)]
old
addTiming :: String -> IO ()
addTiming :: String -> IO ()
addTiming msg :: String
msg = do
Seconds
now <- IO Seconds
timer
IORef [(Seconds, String)]
-> ([(Seconds, String)] -> ([(Seconds, String)], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [(Seconds, String)]
timings (([(Seconds, String)] -> ([(Seconds, String)], ())) -> IO ())
-> ([(Seconds, String)] -> ([(Seconds, String)], ())) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ts :: [(Seconds, String)]
ts -> ((Seconds
now,String
msg)(Seconds, String) -> [(Seconds, String)] -> [(Seconds, String)]
forall a. a -> [a] -> [a]
:[(Seconds, String)]
ts, ())
showTimings :: Seconds -> [(Seconds, String)] -> [String]
showTimings :: Seconds -> [(Seconds, String)] -> [String]
showTimings _ [] = []
showTimings stop :: Seconds
stop times :: [(Seconds, String)]
times = [(String, String)] -> [String]
showGap ([(String, String)] -> [String]) -> [(String, String)] -> [String]
forall a b. (a -> b) -> a -> b
$
[(String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ " ", Int -> Seconds -> String
forall a. RealFloat a => Int -> a -> String
showDP 3 Seconds
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ "s " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Seconds -> String
showPerc Seconds
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Seconds -> String
progress Seconds
b) | (a :: String
a,b :: Seconds
b) <- [(String, Seconds)]
xs] [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++
[("Total", Int -> Seconds -> String
forall a. RealFloat a => Int -> a -> String
showDP 3 Seconds
sm String -> String -> String
forall a. [a] -> [a] -> [a]
++ "s " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Seconds -> String
showPerc Seconds
sm String -> String -> String
forall a. [a] -> [a] -> [a]
++ " " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate 25 ' ')]
where
a :: p
a // :: p -> p -> p
// b :: p
b = if p
b p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then 0 else p
a p -> p -> p
forall a. Fractional a => a -> a -> a
/ p
b
showPerc :: Seconds -> String
showPerc x :: Seconds
x = let s :: String
s = Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ Seconds -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Seconds -> Integer) -> Seconds -> Integer
forall a b. (a -> b) -> a -> b
$ Seconds
x Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
* 100 Seconds -> Seconds -> Seconds
forall p. (Eq p, Fractional p) => p -> p -> p
// Seconds
sm in Int -> Char -> String
forall a. Int -> a -> [a]
replicate (3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) ' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ "%"
progress :: Seconds -> String
progress x :: Seconds
x = let i :: Int
i = Seconds -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Seconds -> Int) -> Seconds -> Int
forall a b. (a -> b) -> a -> b
$ Seconds
x Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
* 25 Seconds -> Seconds -> Seconds
forall p. (Eq p, Fractional p) => p -> p -> p
// Seconds
mx in Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
i '=' String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (25Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) ' '
mx :: Seconds
mx = [Seconds] -> Seconds
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Seconds] -> Seconds) -> [Seconds] -> Seconds
forall a b. (a -> b) -> a -> b
$ ((String, Seconds) -> Seconds) -> [(String, Seconds)] -> [Seconds]
forall a b. (a -> b) -> [a] -> [b]
map (String, Seconds) -> Seconds
forall a b. (a, b) -> b
snd [(String, Seconds)]
xs
sm :: Seconds
sm = [Seconds] -> Seconds
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Seconds] -> Seconds) -> [Seconds] -> Seconds
forall a b. (a -> b) -> a -> b
$ ((String, Seconds) -> Seconds) -> [(String, Seconds)] -> [Seconds]
forall a b. (a -> b) -> [a] -> [b]
map (String, Seconds) -> Seconds
forall a b. (a, b) -> b
snd [(String, Seconds)]
xs
xs :: [(String, Seconds)]
xs = [ (String
name, Seconds
stop Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
- Seconds
start)
| ((start :: Seconds
start, name :: String
name), stop :: Seconds
stop) <- [(Seconds, String)] -> [Seconds] -> [((Seconds, String), Seconds)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Seconds, String)]
times ([Seconds] -> [((Seconds, String), Seconds)])
-> [Seconds] -> [((Seconds, String), Seconds)]
forall a b. (a -> b) -> a -> b
$ ((Seconds, String) -> Seconds) -> [(Seconds, String)] -> [Seconds]
forall a b. (a -> b) -> [a] -> [b]
map (Seconds, String) -> Seconds
forall a b. (a, b) -> a
fst (Int -> [(Seconds, String)] -> [(Seconds, String)]
forall a. Int -> [a] -> [a]
drop 1 [(Seconds, String)]
times) [Seconds] -> [Seconds] -> [Seconds]
forall a. [a] -> [a] -> [a]
++ [Seconds
stop]]
showGap :: [(String,String)] -> [String]
showGap :: [(String, String)] -> [String]
showGap xs :: [(String, String)]
xs = [String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
b) ' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b | (a :: String
a,b :: String
b) <- [(String, String)]
xs]
where n :: Int
n = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
b | (a :: String
a,b :: String
b) <- [(String, String)]
xs]