time-hourglass-0.2.13: benchmarks/Bench.hs

{-# LANGUAGE BangPatterns #-}

module Main
  ( main
  ) where

import           Data.Hourglass
                   ( Date (..), DateTime (..), Elapsed (..), TimeOfDay (..)
                   , timeGetDate, timeGetDateTimeOfDay, timeGetElapsed
                   )
import           Data.List ( intercalate )
import qualified Data.Time.Calendar as T
import qualified Data.Time.Clock as T
import qualified Data.Time.Clock.POSIX as T
import           System.Hourglass ( timeCurrent, timeCurrentP )
import           Test.Tasty.Bench ( bench, bgroup, defaultMain, nf, nfIO )

timeToTuple :: T.UTCTime -> (Int, Int, Int, Int, Int, Int)
timeToTuple utcTime = (fromIntegral y, m, d, h, mi, sec)
 where
  (!y, !m, !d) = T.toGregorian (T.utctDay utcTime)
  !daytime     = floor $ T.utctDayTime utcTime
  (!dt, !sec)  = daytime `divMod` 60
  (!h , !mi)   = dt `divMod` 60

timeToTupleDate :: T.UTCTime -> (Int, Int, Int)
timeToTupleDate utcTime = (fromIntegral y, m, d)
 where
  (!y, !m, !d) = T.toGregorian (T.utctDay utcTime)

timePosixDict :: [ (Elapsed, T.POSIXTime) ]
timePosixDict =
  [-- (Elapsed 0, 0)
  --, (Elapsed 1000000, 1000000)
  --, (Elapsed 9000099, 9000099)
  {-,-} (Elapsed 1398232846, 1398232846) -- currentish time (at the time of writing)
  --, (Elapsed 5134000099, 5134000099)
  --, (Elapsed 10000000000000, 10000000000000) -- year 318857 ..
  ]

dateDict :: [ (Int, Int, Int, Int, Int, Int) ]
dateDict =
  [{- (1970, 1, 1, 1, 1, 1)
  , -}(2014, 5, 5, 5, 5, 5)
  --, (2114, 11, 5, 5, 5, 5)
  ]

main :: IO ()
main = defaultMain
  [ bgroup "highlevel"   $ concatMap toHighLevel timePosixDict
  , bgroup "to-dateTime" $ concatMap toCalendar timePosixDict
  , bgroup "to-date"     $ concatMap toCalendarDate timePosixDict
  , bgroup "utc-to-date" $ concatMap toCalendarUTC timePosixDict
  , bgroup "to-posix"    $ concatMap toPosix dateDict
  , bgroup "system"      fromSystem
  ]
 where
  toHighLevel (posixHourglass, posixTime) =
    [ bench (showH posixHourglass) $ nf timeGetDateTimeOfDay posixHourglass
    , bench (showT posixTime) $ nf T.posixSecondsToUTCTime posixTime
    ]
  toCalendar (posixHourglass, posixTime) =
    [ bench (showH posixHourglass) $ nf timeGetDateTimeOfDay posixHourglass
    , bench (showT posixTime) $ nf (timeToTuple . T.posixSecondsToUTCTime) posixTime
    ]
  toCalendarDate (posixHourglass, posixTime) =
    [ bench (showH posixHourglass) $ nf timeGetDate posixHourglass
    , bench (showT posixTime) $ nf (timeToTupleDate . T.posixSecondsToUTCTime) posixTime
    ]
  toCalendarUTC (posixHourglass, posixTime) =
    [ bench (showH posixHourglass) $ nf timeGetDateTimeOfDay posixHourglass
    , bench (showT utcTime) $ nf timeToTuple utcTime
    ]
   where
    !utcTime = T.posixSecondsToUTCTime posixTime

  toPosix v =
    [ bench ("hourglass/" ++ n v) $ nf hourglass v
    , bench ("time/" ++ n v) $ nf time v
    ]
   where
    n (y, m, d, h, mi, s) =
         intercalate "-" (map show [y, m, d])
      ++ " "
      ++ intercalate ":" (map show [h, mi, s])
    hourglass (y, m, d, h, mi, s) =
      timeGetElapsed $
        DateTime
          (Date y (toEnum (m - 1)) d)
          (TimeOfDay (fromIntegral h) (fromIntegral mi) (fromIntegral s) 0)
    time (y, m, d, h, mi, s) =
      let day = T.fromGregorian (fromIntegral y) m d
          diffTime = T.secondsToDiffTime $ fromIntegral (h * 3600 + mi * 60 + s)
      in  T.utcTimeToPOSIXSeconds (T.UTCTime day diffTime)

  fromSystem =
    [ bench "hourglass/p"    $ nfIO timeCurrent
    , bench "hourglass/ns"   $ nfIO timeCurrentP
    , bench "time/posixTime" $ nfIO T.getPOSIXTime
    , bench "time/utcTime"   $ nfIO T.getCurrentTime
    ]

  showH :: Show a => a -> String
  showH a = "hourglass/" ++ show a

  showT :: Show a => a -> String
  showT a = "time/" ++ show a