    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 a. a -> IO a
    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
            a
    a // :: a -> a -> a
    // a
    b = if a
    b a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    0 then a
    0 else a
    a a -> a -> a
    forall a. Fractional a => a -> a -> a
    / a
    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 b. Integral b => Seconds -> b
    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 {a}. (Eq a, Fractional a) => a -> a -> a
    // 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 a. [a] -> 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 b. Integral b => Seconds -> b
    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 {a}. (Eq a, Fractional a) => a -> a -> a
    // 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 a. Ord a => [a] -> a
    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 a. Num a => [a] -> a
    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 a. [a] -> 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 a. [a] -> 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 a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum [String -> Int
    forall a. [a] -> 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 a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    b | (String
    a,String
    b) <- [(String, String)]
    xs]