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

    import Data.IORef
    import Data.Time
    import System.IO.Unsafe
    import Numeric.Extra
    import System.Time.Extra

    {-# NOINLINE timings #-}
    timings :: IORef [(UTCTime, String)] -- number of times called, newest first
    timings = unsafePerformIO $ newIORef []

    resetTimings :: IO ()
    resetTimings = do
        now <- getCurrentTime
        writeIORef timings [(now, "Start")]

    -- | Print all withTiming information and clear the information.
    printTimings :: IO ()
    printTimings = do
        now <- getCurrentTime
        old <- atomicModifyIORef timings $ \ts -> ([(now, "Start")], ts)
        putStr $ unlines $ showTimings now $ reverse old

    addTiming :: String -> IO ()
    addTiming msg = do
        now <- getCurrentTime
        atomicModifyIORef timings $ \ts -> ((now,msg):ts, ())

    showTimings :: UTCTime -> [(UTCTime, String)] -> [String]
    showTimings _ [] = []
    showTimings stop times = showGap $
        [(a ++ "  ", showDP 3 b ++ "s  " ++ showPerc b ++ "  " ++ progress b) | (a,b) <- xs] ++
        [("Total", showDP 3 sm ++ "s  " ++ showPerc sm ++ "  " ++ replicate 25 ' ')]
        where
            a // b = if b == 0 then 0 else a / b
            showPerc x = let s = show $ floor $ x * 100 // sm in replicate (3 - length s) ' ' ++ s ++ "%"
            progress x = let i = floor $ x * 25 // mx in replicate i '=' ++ replicate (25-i) ' '
            mx = maximum $ map snd xs
            sm = sum $ map snd xs
            xs = [ (name, stop `subtractTime` start)
                 | ((start, name), stop) <- zip times $ map fst (drop 1 times) ++ [stop]]

    showGap :: [(String,String)] -> [String]
    showGap xs = [a ++ replicate (n - length a - length b) ' ' ++ b | (a,b) <- xs]
        where n = maximum [length a + length b | (a,b) <- xs]