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 = IO (IO Seconds) -> IO Seconds
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 = 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, 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 <- 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)])
forall a. a -> (a, a)
dupe
    [String] -> IO [String]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String] -> IO [String]) -> [String] -> IO [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 String
msg = do
    Seconds
now <- IO Seconds
timer
    IORef [(Seconds, String)]
-> ([(Seconds, String)] -> [(Seconds, String)]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
atomicModifyIORef_ IORef [(Seconds, String)]
timings ((Seconds
now,String
msg)(Seconds, String) -> [(Seconds, String)] -> [(Seconds, String)]
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 ([(String, String)] -> [String]) -> [(String, String)] -> [String]
forall a b. (a -> b) -> a -> b
$
    [(String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"  ", Int -> Seconds -> String
forall a. RealFloat a => Int -> a -> String
showDP Int
3 Seconds
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"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 -> String
forall a. [a] -> [a] -> [a]
++ Seconds -> String
progress Seconds
b) | (String
a,Seconds
b) <- [(String, Seconds)]
xs] [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++
    [(String
"Total", Int -> Seconds -> String
forall a. RealFloat a => Int -> a -> String
showDP Int
3 Seconds
sm String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"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 -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
25 Char
' ')]
    where
        p
a // :: p -> p -> p
// p
b = if p
b p -> p -> Bool
forall a. Eq a => a -> a -> Bool
== p
0 then p
0 else p
a p -> p -> p
forall a. Fractional a => a -> a -> a
/ p
b
        showPerc :: Seconds -> String
showPerc 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
* Seconds
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 (Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"%"
        progress :: Seconds -> String
progress 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
* Seconds
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 Char
'=' String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
25Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
i) Char
' '
        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)
             | ((Seconds
start, String
name), Seconds
stop) <- [(Seconds, String)] -> [Seconds] -> [((Seconds, String), Seconds)]
forall a b. Partial => [a] -> [b] -> [(a, b)]
zipExact [(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 ([(Seconds, String)] -> [(Seconds, String)]
forall a. [a] -> [a]
drop1 [(Seconds, String)]
times) [Seconds] -> [Seconds] -> [Seconds]
forall a. [a] -> [a] -> [a]
++ [Seconds
stop]]


showGap :: [(String,String)] -> [String]
showGap :: [(String, String)] -> [String]
showGap [(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) Char
' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
b | (String
a,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 | (String
a,String
b) <- [(String, String)]
xs]