-----------------------------------------------------------------------------
-- |
-- Module    : Data.SBV.Utils.TDiff
-- Copyright : (c) Levent Erkok
-- License   : BSD3
-- Maintainer: erkokl@gmail.com
-- Stability : experimental
--
-- Runs an IO computation printing the time it took to run it
-----------------------------------------------------------------------------

{-# OPTIONS_GHC -Wall -Werror #-}

module Data.SBV.Utils.TDiff
  ( Timing(..)
  , timeIf
  , timeIfRNF
  , showTDiff
  , getTimeStampIf
  , getElapsedTime
  )
  where

import Data.Time (getCurrentTime, diffUTCTime, NominalDiffTime, UTCTime)
import Data.IORef (IORef)

import Data.List (intercalate)

import Data.Ratio
import GHC.Real   (Ratio((:%)))

import Numeric (showFFloat)

import Control.Monad.Trans (liftIO, MonadIO)
import Control.DeepSeq (NFData(rnf))


-- | Specify how to save timing information, if at all.
data Timing = NoTiming | PrintTiming | SaveTiming (IORef NominalDiffTime)

-- | Show 'NominalDiffTime' in human readable form. 'NominalDiffTime' is
-- essentially picoseconds (10^-12 seconds). We show it so that
-- it's represented at the day:hour:minute:second.XXX granularity.
showTDiff :: NominalDiffTime -> String
showTDiff diff
   | denom /= 1    -- Should never happen! But just in case.
   = show diff
   | True
   = intercalate ":" fields
   where total, denom :: Integer
         total :% denom = (picoFactor % 1) * toRational diff

         -- there are 10^12 pico-seconds in a second
         picoFactor :: Integer
         picoFactor = (10 :: Integer) ^ (12 :: Integer)

         (s2p, m2s, h2m, d2h) = case drop 1 $ scanl (*) 1 [picoFactor, 60, 60, 24] of
                                  (s2pv : m2sv : h2mv : d2hv : _) -> (s2pv, m2sv, h2mv, d2hv)
                                  _                               -> (0, 0, 0, 0)  -- won't ever happen

         (days,    days')    = total    `divMod` d2h
         (hours,   hours')   = days'    `divMod` h2m
         (minutes, seconds') = hours'   `divMod` m2s
         (seconds, picos)    = seconds' `divMod` s2p
         secondsPicos        =  show seconds
                             ++ dropWhile (/= '.') (showFFloat (Just 3) (fromIntegral picos * (10**(-12) :: Double)) "s")

         aboveSeconds = map (\(t, v) -> show v ++ [t]) $ dropWhile (\p -> snd p == 0) [('d', days), ('h', hours), ('m', minutes)]
         fields       = aboveSeconds ++ [secondsPicos]

-- | Run an action and measure how long it took. We reduce the result to weak-head-normal-form,
-- so beware of the cases if the result is lazily computed; in which case we'll stop soon as the
-- result is in WHNF, and not necessarily fully calculated.
timeIf :: MonadIO m => Bool -> m a -> m (Maybe NominalDiffTime, a)
timeIf measureTime act = do mbStart <- getTimeStampIf measureTime
                            r     <- act
                            r `seq` do mbElapsed <- getElapsedTime mbStart
                                       pure (mbElapsed, r)

-- | Same as 'timeIf', except we fully evaluate the result, via its NFData instance.
timeIfRNF :: (NFData a, MonadIO m) => Bool -> m a -> m (Maybe NominalDiffTime, a)
timeIfRNF measureTime act = timeIf measureTime (act >>= \r -> rnf r `seq` pure r)

-- | Get a time-stamp if we're asked to do so
getTimeStampIf  :: MonadIO m => Bool -> m (Maybe UTCTime)
getTimeStampIf measureTime
  | not measureTime = pure Nothing
  | True            = liftIO $ Just <$> getCurrentTime

-- | Get elapsed time from the given beginning time, if any.
getElapsedTime :: MonadIO m => Maybe UTCTime -> m (Maybe NominalDiffTime)
getElapsedTime Nothing      = pure Nothing
getElapsedTime (Just start) = liftIO $ do e <- getCurrentTime
                                          pure $ Just (diffUTCTime e start)