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]