module Unison.Util.Timing
  ( time,
    unsafeTime,
  )
where

import Data.Time.Clock (picosecondsToDiffTime)
import Data.Time.Clock.System (getSystemTime, systemToTAITime)
import Data.Time.Clock.TAI (diffAbsoluteTime)
import System.CPUTime (getCPUTime)
import System.IO.Unsafe (unsafePerformIO)
import Unison.Debug qualified as Debug
import UnliftIO (MonadIO, liftIO)

time :: (MonadIO m) => String -> m a -> m a
time :: forall (m :: * -> *) a. MonadIO m => String -> m a -> m a
time String
label m a
ma =
  if DebugFlag -> Bool
Debug.shouldDebug DebugFlag
Debug.Timing
    then do
      SystemTime
systemStart <- IO SystemTime -> m SystemTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
      Integer
cpuPicoStart <- IO Integer -> m Integer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Integer
getCPUTime
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Timing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..."
      a
a <- m a
ma
      Integer
cpuPicoEnd <- IO Integer -> m Integer
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Integer
getCPUTime
      SystemTime
systemEnd <- IO SystemTime -> m SystemTime
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO SystemTime
getSystemTime
      let systemDiff :: DiffTime
systemDiff = AbsoluteTime -> AbsoluteTime -> DiffTime
diffAbsoluteTime (SystemTime -> AbsoluteTime
systemToTAITime SystemTime
systemEnd) (SystemTime -> AbsoluteTime
systemToTAITime SystemTime
systemStart)
      let cpuDiff :: DiffTime
cpuDiff = Integer -> DiffTime
picosecondsToDiffTime (Integer
cpuPicoEnd Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
cpuPicoStart)
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Finished " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DiffTime -> String
forall a. Show a => a -> String
show DiffTime
cpuDiff String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (cpu), " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DiffTime -> String
forall a. Show a => a -> String
show DiffTime
systemDiff String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (system)"
      pure a
a
    else m a
ma

-- Mitchell says: this function doesn't look like it would work at all; let's just delete it
unsafeTime :: (Monad m) => String -> m a -> m a
unsafeTime :: forall (m :: * -> *) a. Monad m => String -> m a -> m a
unsafeTime String
label m a
ma =
  if DebugFlag -> Bool
Debug.shouldDebug DebugFlag
Debug.Timing
    then do
      let !systemStart :: SystemTime
systemStart = IO SystemTime -> SystemTime
forall a. IO a -> a
unsafePerformIO IO SystemTime
getSystemTime
          !cpuPicoStart :: Integer
cpuPicoStart = IO Integer -> Integer
forall a. IO a -> a
unsafePerformIO IO Integer
getCPUTime
          !()
_ = IO () -> ()
forall a. IO a -> a
unsafePerformIO (IO () -> ()) -> IO () -> ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Timing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"..."
      a
a <- m a
ma
      let !cpuPicoEnd :: Integer
cpuPicoEnd = IO Integer -> Integer
forall a. IO a -> a
unsafePerformIO IO Integer
getCPUTime
          !systemEnd :: SystemTime
systemEnd = IO SystemTime -> SystemTime
forall a. IO a -> a
unsafePerformIO IO SystemTime
getSystemTime
      let systemDiff :: DiffTime
systemDiff = AbsoluteTime -> AbsoluteTime -> DiffTime
diffAbsoluteTime (SystemTime -> AbsoluteTime
systemToTAITime SystemTime
systemEnd) (SystemTime -> AbsoluteTime
systemToTAITime SystemTime
systemStart)
      let cpuDiff :: DiffTime
cpuDiff = Integer -> DiffTime
picosecondsToDiffTime (Integer
cpuPicoEnd Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
cpuPicoStart)
      let !()
_ = IO () -> ()
forall a. IO a -> a
unsafePerformIO (IO () -> ()) -> IO () -> ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Finished " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
label String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DiffTime -> String
forall a. Show a => a -> String
show DiffTime
cpuDiff String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (cpu), " String -> String -> String
forall a. [a] -> [a] -> [a]
++ DiffTime -> String
forall a. Show a => a -> String
show DiffTime
systemDiff String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (system)"
      pure a
a
    else m a
ma