{-# LANGUAGE Safe #-}
{- arch-tag: Time utilities main file
Copyright (c) 2004-2011 John Goerzen <jgoerzen@complete.org>

All rights reserved.

For license and copyright information, see the file LICENSE
-}

{- |
   Module     : System.Time.Utils
   Copyright  : Copyright (C) 2004-2011 John Goerzen
   SPDX-License-Identifier: BSD-3-Clause

   Stability  : stable
   Portability: portable

This module provides various Haskell utilities for dealing with times and
dates.

Written by John Goerzen, jgoerzen\@complete.org
-}

module System.Time.Utils(
                     timelocal,
                     timegm,
                     timeDiffToSecs,
                     epoch,
                     epochToClockTime,
                     clockTimeToEpoch,
                     renderSecs, renderTD
                    )
where
import safe Data.Ratio ( (%) )
import safe System.Time
    ( diffClockTimes,
      normalizeTimeDiff,
      toCalendarTime,
      toClockTime,
      CalendarTime(..),
      ClockTime(..),
      Day(Thursday),
      Month(January),
      TimeDiff(TimeDiff, tdSec, tdMin, tdHour, tdDay, tdMonth, tdYear) )

{- | January 1, 1970, midnight, UTC, represented as a CalendarTime. -}
epoch :: CalendarTime
epoch :: CalendarTime
epoch = CalendarTime :: Int
-> Month
-> Int
-> Int
-> Int
-> Int
-> Integer
-> Day
-> Int
-> String
-> Int
-> Bool
-> CalendarTime
CalendarTime { ctYear :: Int
ctYear = Int
1970, ctMonth :: Month
ctMonth = Month
January,
                       ctDay :: Int
ctDay = Int
1, ctHour :: Int
ctHour = Int
0, ctMin :: Int
ctMin = Int
0, ctSec :: Int
ctSec = Int
0,
                       ctPicosec :: Integer
ctPicosec = Integer
0, ctWDay :: Day
ctWDay = Day
Thursday, ctYDay :: Int
ctYDay = Int
0,
                       ctTZName :: String
ctTZName = String
"UTC", ctTZ :: Int
ctTZ = Int
0, ctIsDST :: Bool
ctIsDST = Bool
False}

{- | Converts the specified CalendarTime (see System.Time) to seconds-since-epoch time.

This conversion does respect the timezone specified on the input object.
If you want a conversion from UTC, specify ctTZ = 0 and ctIsDST = False.

When called like that, the behavior is equivolent to the GNU C function
timegm().  Unlike the C library, Haskell's CalendarTime supports
timezone information, so if such information is specified, it will impact
the result.
-}

timegm :: CalendarTime -> Integer
timegm :: CalendarTime -> Integer
timegm CalendarTime
ct =
    TimeDiff -> Integer
timeDiffToSecs (ClockTime -> ClockTime -> TimeDiff
diffClockTimes (CalendarTime -> ClockTime
toClockTime CalendarTime
ct) (CalendarTime -> ClockTime
toClockTime CalendarTime
epoch))

{- | Converts the specified CalendarTime (see System.Time) to
seconds-since-epoch format.

The input CalendarTime is assumed to be the time as given in your local
timezone.  All timezone and DST fields in the object are ignored.

This behavior is equivolent to the timelocal() and mktime() functions that
C programmers are accustomed to.

Please note that the behavior for this function during the hour immediately
before or after a DST switchover may produce a result with a different hour
than you expect.
-}

timelocal :: CalendarTime -> IO Integer
timelocal :: CalendarTime -> IO Integer
timelocal CalendarTime
ct =
    do CalendarTime
guessct <- ClockTime -> IO CalendarTime
toCalendarTime ClockTime
guesscl
       let newct :: CalendarTime
newct = CalendarTime
ct {ctTZ :: Int
ctTZ = CalendarTime -> Int
ctTZ CalendarTime
guessct}
       Integer -> IO Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> IO Integer) -> Integer -> IO Integer
forall a b. (a -> b) -> a -> b
$ CalendarTime -> Integer
timegm CalendarTime
newct
    where guesscl :: ClockTime
guesscl = CalendarTime -> ClockTime
toClockTime CalendarTime
ct

{- | Converts the given timeDiff to the number of seconds it represents.

Uses the same algorithm as normalizeTimeDiff in GHC. -}
timeDiffToSecs :: TimeDiff -> Integer
timeDiffToSecs :: TimeDiff -> Integer
timeDiffToSecs TimeDiff
td =
    (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ TimeDiff -> Int
tdSec TimeDiff
td) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+
    Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* ((Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ TimeDiff -> Int
tdMin TimeDiff
td) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+
          Integer
60 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* ((Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ TimeDiff -> Int
tdHour TimeDiff
td) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+
                Integer
24 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* ((Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ TimeDiff -> Int
tdDay TimeDiff
td) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+
                      Integer
30 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* ((Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ TimeDiff -> Int
tdMonth TimeDiff
td) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+
                            Integer
365 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ TimeDiff -> Int
tdYear TimeDiff
td)))))

{- | Converts an Epoch time represented with an arbitrary Real to a ClockTime.
This input could be a CTime from Foreign.C.Types or an EpochTime from
System.Posix.Types. -}
epochToClockTime :: Real a => a -> ClockTime
epochToClockTime :: a -> ClockTime
epochToClockTime a
x =
    Integer -> Integer -> ClockTime
TOD Integer
seconds Integer
secfrac
    where ratval :: Rational
ratval = a -> Rational
forall a. Real a => a -> Rational
toRational a
x
          seconds :: Integer
seconds = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor Rational
ratval
          secfrac :: Integer
secfrac = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Rational -> Integer) -> Rational -> Integer
forall a b. (a -> b) -> a -> b
$ (Rational
ratval Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- (Integer
seconds Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1) ) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
picosecondfactor
          picosecondfactor :: Rational
picosecondfactor = Rational
10 Rational -> Integer -> Rational
forall a b. (Num a, Integral b) => a -> b -> a
^ (Integer
12 :: Integer)

{- | Converts a ClockTime to something represented with an arbitrary Real.
The result could be treated as a CTime from Foreign.C.Types or EpochTime from
System.Posix.Types.  The inverse of 'epochToClockTime'.

Fractions of a second are not preserved by this function. -}
clockTimeToEpoch :: Num a => ClockTime -> a
clockTimeToEpoch :: ClockTime -> a
clockTimeToEpoch (TOD Integer
sec Integer
_) = Integer -> a
forall a. Num a => Integer -> a
fromInteger Integer
sec

{- | Render a number of seconds as a human-readable amount.  Shows the two
most significant places.  For instance:

>renderSecs 121 = "2m1s"

See also 'renderTD' for a function that works on a TimeDiff.
-}
renderSecs :: Integer -> String
renderSecs :: Integer -> String
renderSecs Integer
i = TimeDiff -> String
renderTD (TimeDiff -> String) -> TimeDiff -> String
forall a b. (a -> b) -> a -> b
$ ClockTime -> ClockTime -> TimeDiff
diffClockTimes (Integer -> Integer -> ClockTime
TOD Integer
i Integer
0) (Integer -> Integer -> ClockTime
TOD Integer
0 Integer
0)

{- | Like 'renderSecs', but takes a TimeDiff instead of an integer second
count. -}
renderTD :: TimeDiff -> String
renderTD :: TimeDiff -> String
renderTD TimeDiff
itd =
    case [(Int, Char)]
workinglist of
      [] -> String
"0s"
      [(Int, Char)]
_  -> [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ([(Int, Char)] -> [String]) -> [(Int, Char)] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Char) -> String) -> [(Int, Char)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
q, Char
s) -> Int -> String
forall a. Show a => a -> String
show Int
q String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
s]) ([(Int, Char)] -> String) -> [(Int, Char)] -> String
forall a b. (a -> b) -> a -> b
$ [(Int, Char)]
workinglist
    where td :: TimeDiff
td = TimeDiff -> TimeDiff
normalizeTimeDiff TimeDiff
itd
          suffixlist :: String
suffixlist = String
"yMdhms"
          quantlist :: [Int]
quantlist = (\(TimeDiff Int
y Int
mo Int
d Int
h Int
m Int
s Integer
_) -> [Int
y, Int
mo, Int
d, Int
h, Int
m, Int
s]) TimeDiff
td
          zippedlist :: [(Int, Char)]
zippedlist = [Int] -> String -> [(Int, Char)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
quantlist String
suffixlist
          -- Drop all leading elements that are 0, then take at most 2
          workinglist :: [(Int, Char)]
workinglist = Int -> [(Int, Char)] -> [(Int, Char)]
forall a. Int -> [a] -> [a]
take Int
2 ([(Int, Char)] -> [(Int, Char)])
-> ([(Int, Char)] -> [(Int, Char)])
-> [(Int, Char)]
-> [(Int, Char)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Char) -> Bool) -> [(Int, Char)] -> [(Int, Char)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (\(Int
q, Char
_) -> Int
q Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) ([(Int, Char)] -> [(Int, Char)]) -> [(Int, Char)] -> [(Int, Char)]
forall a b. (a -> b) -> a -> b
$ [(Int, Char)]
zippedlist