-----------------------------------------------------------------------------
-- |
-- 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(..)
  , showTDiff
  )
  where

import Data.Time  (NominalDiffTime)
import Data.IORef (IORef)

import Data.List (intercalate)

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

import Numeric (showFFloat)

-- | 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 :: NominalDiffTime -> String
showTDiff NominalDiffTime
diff
   | Integer
denom forall a. Eq a => a -> a -> Bool
/= Integer
1    -- Should never happen! But just in case.
   = forall a. Show a => a -> String
show NominalDiffTime
diff
   | Bool
True
   = forall a. [a] -> [[a]] -> [a]
intercalate String
":" [String]
fields
   where total, denom :: Integer
         Integer
total :% Integer
denom = (Integer
picoFactor forall a. Integral a => a -> a -> Ratio a
% Integer
1) forall a. Num a => a -> a -> a
* forall a. Real a => a -> Ratio Integer
toRational NominalDiffTime
diff

         -- there are 10^12 pico-seconds in a second
         picoFactor :: Integer
         picoFactor :: Integer
picoFactor = (Integer
10 :: Integer) forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
12 :: Integer)

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

         (Integer
days,    Integer
days')    = Integer
total    forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
d2h
         (Integer
hours,   Integer
hours')   = Integer
days'    forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
h2m
         (Integer
minutes, Integer
seconds') = Integer
hours'   forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
m2s
         (Integer
seconds, Integer
picos)    = Integer
seconds' forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
s2p
         secondsPicos :: String
secondsPicos        =  forall a. Show a => a -> String
show Integer
seconds
                             forall a. [a] -> [a] -> [a]
++ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'.') (forall a. RealFloat a => Maybe Int -> a -> ShowS
showFFloat (forall a. a -> Maybe a
Just Int
3) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
picos forall a. Num a => a -> a -> a
* (Double
10forall a. Floating a => a -> a -> a
**(-Double
12) :: Double)) String
"s")

         aboveSeconds :: [String]
aboveSeconds = forall a b. (a -> b) -> [a] -> [b]
map (\(Char
t, Integer
v) -> forall a. Show a => a -> String
show Integer
v forall a. [a] -> [a] -> [a]
++ [Char
t]) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(Char, Integer)
p -> forall a b. (a, b) -> b
snd (Char, Integer)
p forall a. Eq a => a -> a -> Bool
== Integer
0) [(Char
'd', Integer
days), (Char
'h', Integer
hours), (Char
'm', Integer
minutes)]
         fields :: [String]
fields       = [String]
aboveSeconds forall a. [a] -> [a] -> [a]
++ [String
secondsPicos]