{-# LANGUAGE CPP #-}
{- |
Module      :  ./Common/Timing.hs
Description :  utility module for measuring execution time
Copyright   :  (c) C. Maeder DFKI GmbH
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Christian.Maeder@dfki.de
Stability   :  provisional
Portability :  portable

Utility functions that can't be found in the libraries
               but should be shared across Hets.
-}

module Common.Timing where

#ifdef UNIX
import System.Posix.Time
import System.Posix.Types
#else
import Data.Time.Clock
#endif

import Data.Fixed
import Data.Time
import Control.Monad
import Numeric

newtype HetsTime = HetsTime
#ifdef UNIX
  EpochTime
#else
  UTCTime
#endif

getHetsTime :: IO HetsTime
getHetsTime :: IO HetsTime
getHetsTime = (EpochTime -> HetsTime) -> IO EpochTime -> IO HetsTime
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM EpochTime -> HetsTime
HetsTime
#ifdef UNIX
  IO EpochTime
epochTime
#else
  getCurrentTime
#endif

measureWallTime :: IO a -> IO (a, TimeOfDay)
measureWallTime :: IO a -> IO (a, TimeOfDay)
measureWallTime f :: IO a
f = do
  HetsTime
startTime <- IO HetsTime
getHetsTime
  a
result <- IO a
f
  HetsTime
endTime <- IO HetsTime
getHetsTime
  let wallTimeUsed :: TimeOfDay
wallTimeUsed = HetsTime -> HetsTime -> TimeOfDay
diffHetsTime HetsTime
endTime HetsTime
startTime
  (a, TimeOfDay) -> IO (a, TimeOfDay)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
result, TimeOfDay
wallTimeUsed)

diffHetsTime :: HetsTime -> HetsTime -> TimeOfDay
diffHetsTime :: HetsTime -> HetsTime -> TimeOfDay
diffHetsTime (HetsTime t1 :: EpochTime
t1) (HetsTime t2 :: EpochTime
t2) =
   DiffTime -> TimeOfDay
timeToTimeOfDay (DiffTime -> TimeOfDay) -> DiffTime -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ Integer -> DiffTime
secondsToDiffTime (Integer -> DiffTime) -> Integer -> DiffTime
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round
   (EpochTime -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (
#ifdef UNIX
   (-)
#else
   diffUTCTime
#endif
               EpochTime
t1 EpochTime
t2) :: Double)

timeOfDayToSeconds :: TimeOfDay -> Int
timeOfDayToSeconds :: TimeOfDay -> Int
timeOfDayToSeconds TimeOfDay { todHour :: TimeOfDay -> Int
todHour = Int
hours
                             , todMin :: TimeOfDay -> Int
todMin = Int
minutes
                             , todSec :: TimeOfDay -> Pico
todSec = Pico
seconds
                             } =
  (Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Int) -> (Pico -> Double) -> Pico -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pico -> Double
toDouble) Pico
seconds Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
minutes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
hours)
  where
    toDouble :: Pico -> Double
    toDouble :: Pico -> Double
toDouble s :: Pico
s = case ReadS Double -> ReadS Double
forall a. Real a => ReadS a -> ReadS a
readSigned ReadS Double
forall a. RealFrac a => ReadS a
readFloat ReadS Double -> ReadS Double
forall a b. (a -> b) -> a -> b
$ Pico -> String
forall a. Show a => a -> String
show Pico
s of
      [(x :: Double
x, "")] -> Double
x
      _ -> String -> Double
forall a. HasCallStack => String -> a
error (String -> Double) -> String -> Double
forall a b. (a -> b) -> a -> b
$ "timeOfDayToSeconds: Failed reading the number " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Pico -> String
forall a. Show a => a -> String
show Pico
s