module General.Timing(resetTimings, addTiming, getTimings) where

import Data.IORef.Extra
import System.IO.Unsafe
import Data.Tuple.Extra
import Data.List.Extra
import Numeric.Extra
import General.Extra
import System.Time.Extra


{-# NOINLINE timer #-}
timer :: IO Seconds
timer :: IO Seconds
timer = forall a. IO a -> a
unsafePerformIO IO (IO Seconds)
offsetTime


{-# NOINLINE timings #-}
timings :: IORef [(Seconds, String)] -- number of times called, newest first
timings :: IORef [(Seconds, String)]
timings = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef []


resetTimings :: IO ()
resetTimings :: IO ()
resetTimings = do
    Seconds
now <- IO Seconds
timer
    forall a. IORef a -> a -> IO ()
writeIORef IORef [(Seconds, String)]
timings [(Seconds
now, String
"Start")]


-- | Print all withTiming information and clear it.
getTimings :: IO [String]
getTimings :: IO [String]
getTimings = do
    Seconds
now <- IO Seconds
timer
    [(Seconds, String)]
old <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef [(Seconds, String)]
timings forall a. a -> (a, a)
dupe
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Seconds -> [(Seconds, String)] -> [String]
showTimings Seconds
now forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [(Seconds, String)]
old


addTiming :: String -> IO ()
addTiming :: String -> IO ()
addTiming String
msg = do
    Seconds
now <- IO Seconds
timer
    forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef_ IORef [(Seconds, String)]
timings ((Seconds
now,String
msg)forall a. a -> [a] -> [a]
:)


showTimings :: Seconds -> [(Seconds, String)] -> [String]
showTimings :: Seconds -> [(Seconds, String)] -> [String]
showTimings Seconds
_ [] = []
showTimings Seconds
stop [(Seconds, String)]
times = [(String, String)] -> [String]
showGap forall a b. (a -> b) -> a -> b
$
    [(String
a forall a. [a] -> [a] -> [a]
++ String
"  ", forall a. RealFloat a => Int -> a -> String
showDP Int
3 Seconds
b forall a. [a] -> [a] -> [a]
++ String
"s  " forall a. [a] -> [a] -> [a]
++ Seconds -> String
showPerc Seconds
b forall a. [a] -> [a] -> [a]
++ String
"  " forall a. [a] -> [a] -> [a]
++ Seconds -> String
progress Seconds
b) | (String
a,Seconds
b) <- [(String, Seconds)]
xs] forall a. [a] -> [a] -> [a]
++
    [(String
"Total", forall a. RealFloat a => Int -> a -> String
showDP Int
3 Seconds
sm forall a. [a] -> [a] -> [a]
++ String
"s  " forall a. [a] -> [a] -> [a]
++ Seconds -> String
showPerc Seconds
sm forall a. [a] -> [a] -> [a]
++ String
"  " forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
25 Char
' ')]
    where
        a
a // :: a -> a -> a
// a
b = if a
b forall a. Eq a => a -> a -> Bool
== a
0 then a
0 else a
a forall a. Fractional a => a -> a -> a
/ a
b
        showPerc :: Seconds -> String
showPerc Seconds
x = let s :: String
s = forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ Seconds
x forall a. Num a => a -> a -> a
* Seconds
100 forall {a}. (Eq a, Fractional a) => a -> a -> a
// Seconds
sm in forall a. Int -> a -> [a]
replicate (Int
3 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
' ' forall a. [a] -> [a] -> [a]
++ String
s forall a. [a] -> [a] -> [a]
++ String
"%"
        progress :: Seconds -> String
progress Seconds
x = let i :: Int
i = forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ Seconds
x forall a. Num a => a -> a -> a
* Seconds
25 forall {a}. (Eq a, Fractional a) => a -> a -> a
// Seconds
mx in forall a. Int -> a -> [a]
replicate Int
i Char
'=' forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
25forall a. Num a => a -> a -> a
-Int
i) Char
' '
        mx :: Seconds
mx = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(String, Seconds)]
xs
        sm :: Seconds
sm = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd [(String, Seconds)]
xs
        xs :: [(String, Seconds)]
xs = [ (String
name, Seconds
stop forall a. Num a => a -> a -> a
- Seconds
start)
             | ((Seconds
start, String
name), Seconds
stop) <- forall a b. Partial => [a] -> [b] -> [(a, b)]
zipExact [(Seconds, String)]
times forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall a. [a] -> [a]
drop1 [(Seconds, String)]
times) forall a. [a] -> [a] -> [a]
++ [Seconds
stop]]


showGap :: [(String,String)] -> [String]
showGap :: [(String, String)] -> [String]
showGap [(String, String)]
xs = [String
a forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate (Int
n forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
b) Char
' ' forall a. [a] -> [a] -> [a]
++ String
b | (String
a,String
b) <- [(String, String)]
xs]
    where n :: Int
n = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length String
b | (String
a,String
b) <- [(String, String)]
xs]