--  Copyright (C) 2011 Eric Sessoms
--
--  BSD3

module Darcs.Util.DateTime
    ( getCurrentTime, toSeconds
    , formatDateTime, fromClockTime, parseDateTime, startOfTime
    ) where

import Darcs.Prelude

import qualified Data.Time.Calendar as Calendar ( fromGregorian )
import Data.Time.Clock
    ( UTCTime(UTCTime), UniversalTime(ModJulianDate)
    , getModJulianDate, secondsToDiffTime, getCurrentTime
    )
import Data.Time.Format ( formatTime, parseTimeM )
import Data.Time.LocalTime
    ( utc
    , localTimeToUT1, ut1ToLocalTime
    , localTimeToUTC, utcToLocalTime
    )
import Data.Time ( defaultTimeLocale )
import System.Time ( ClockTime(TOD) )

toSeconds    :: UTCTime -> Integer
toSeconds :: UTCTime -> Integer
toSeconds UTCTime
dt = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double -> Integer) -> Double -> Integer
forall a b. (a -> b) -> a -> b
$
    (Double
86400.0 :: Double) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Rational -> Double
forall a. Fractional a => Rational -> a
fromRational (UTCTime -> Rational
toMJD UTCTime
dt Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
startOfTimeMJD)

toMJD :: UTCTime -> Rational
toMJD :: UTCTime -> Rational
toMJD = UniversalTime -> Rational
getModJulianDate (UniversalTime -> Rational)
-> (UTCTime -> UniversalTime) -> UTCTime -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> UniversalTime
toUniversalTime

startOfTimeMJD :: Rational
startOfTimeMJD :: Rational
startOfTimeMJD = UTCTime -> Rational
toMJD UTCTime
startOfTime

startOfTime :: UTCTime
startOfTime :: UTCTime
startOfTime = Integer -> Int -> Int -> UTCTime
fromGregorian' Integer
1970 Int
1 Int
1

fromGregorian'       :: Integer -> Int -> Int -> UTCTime
fromGregorian' :: Integer -> Int -> Int -> UTCTime
fromGregorian' Integer
y Int
m Int
d = Integer -> Int -> Int -> Int -> Int -> Int -> UTCTime
fromGregorian Integer
y Int
m Int
d Int
0 Int
0 Int
0

fromGregorian :: Integer -> Int -> Int -> Int -> Int -> Int -> UTCTime
fromGregorian :: Integer -> Int -> Int -> Int -> Int -> Int -> UTCTime
fromGregorian Integer
year Int
month Int
day Int
hours Int
minutes Int
seconds =
    Day -> DiffTime -> UTCTime
UTCTime Day
day' (Integer -> DiffTime
secondsToDiffTime (Integer -> DiffTime) -> (Int -> Integer) -> Int -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> DiffTime) -> Int -> DiffTime
forall a b. (a -> b) -> a -> b
$ Int
seconds')
  where
    day' :: Day
day'     = Integer -> Int -> Int -> Day
Calendar.fromGregorian Integer
year Int
month Int
day
    seconds' :: Int
seconds' = Int
3600 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
hours Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
minutes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
seconds

toUniversalTime :: UTCTime -> UniversalTime
toUniversalTime :: UTCTime -> UniversalTime
toUniversalTime = Rational -> LocalTime -> UniversalTime
localTimeToUT1 Rational
0 (LocalTime -> UniversalTime)
-> (UTCTime -> LocalTime) -> UTCTime -> UniversalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
utc

formatDateTime :: String -> UTCTime -> String
formatDateTime :: String -> UTCTime -> String
formatDateTime = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale

parseDateTime :: String -> String -> Maybe UTCTime
parseDateTime :: String -> String -> Maybe UTCTime
parseDateTime = Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale

fromClockTime           :: ClockTime -> UTCTime
fromClockTime :: ClockTime -> UTCTime
fromClockTime (TOD Integer
s Integer
_) = Integer -> UTCTime
fromSeconds Integer
s

fromSeconds   :: Integer -> UTCTime
fromSeconds :: Integer -> UTCTime
fromSeconds Integer
s = Rational -> UTCTime
fromMJD (Rational -> UTCTime) -> Rational -> UTCTime
forall a b. (a -> b) -> a -> b
$
    Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
s Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
86400 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
startOfTimeMJD

fromMJD :: Rational -> UTCTime
fromMJD :: Rational -> UTCTime
fromMJD = UniversalTime -> UTCTime
fromUniversalTime (UniversalTime -> UTCTime)
-> (Rational -> UniversalTime) -> Rational -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> UniversalTime
ModJulianDate

fromUniversalTime :: UniversalTime -> UTCTime
fromUniversalTime :: UniversalTime -> UTCTime
fromUniversalTime = TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
utc (LocalTime -> UTCTime)
-> (UniversalTime -> LocalTime) -> UniversalTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
0