{-# OPTIONS_HADDOCK hide #-}
-- https://msdn.microsoft.com/en-us/library/ee780895.aspx

module Database.Tds.Primitives.DateTime ( bytesToUtc4
                                        , bytesToUtc8
                                        , utcToBytes4
                                        , utcToBytes8
                                        ) where


import Data.Word (Word16(..),Word32(..))
import Data.Int (Int32(..))

import Data.Time (UTCTime(..))
import Data.Time.Calendar (addDays,diffDays,fromGregorian)

bytesToUtc4 :: Word16 -> Word16 -> UTCTime
bytesToUtc4 :: Word16 -> Word16 -> UTCTime
bytesToUtc4 Word16
wday Word16
wmin =
  -- date: the number of days since January 1, 1900.
  -- time: the number of minutes elapsed since 12 AM that day.
  let
    date :: Day
date = Integer -> Day -> Day
addDays (Word16 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
wday) (Integer -> MonthOfYear -> MonthOfYear -> Day
fromGregorian Integer
1900 MonthOfYear
1 MonthOfYear
1)
    time :: DiffTime
time = (Word16 -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
wmin) DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60
  in Day -> DiffTime -> UTCTime
UTCTime Day
date DiffTime
time

bytesToUtc8 :: Int32 -> Word32 -> UTCTime
bytesToUtc8 :: Int32 -> Word32 -> UTCTime
bytesToUtc8 Int32
iday Word32
w3hsec =
  -- date: the number of days since January 1, 1900.
  -- time: the number of one three-hundredths of a second (300 counts per second) elapsed since 12 AM that day.
  let
    date :: Day
date = Integer -> Day -> Day
addDays (Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
iday) (Integer -> MonthOfYear -> MonthOfYear -> Day
fromGregorian Integer
1900 MonthOfYear
1 MonthOfYear
1)
    time :: DiffTime
time = (Word32 -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w3hsec) DiffTime -> DiffTime -> DiffTime
forall a. Fractional a => a -> a -> a
/ DiffTime
300
  in Day -> DiffTime -> UTCTime
UTCTime Day
date DiffTime
time


utcToBytes4 :: UTCTime -> (Word16,Word16)
utcToBytes4 :: UTCTime -> (Word16, Word16)
utcToBytes4 (UTCTime Day
date DiffTime
time) =
  let
    wday :: Word16
wday = Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word16) -> Integer -> Word16
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Integer
diffDays Day
date (Integer -> MonthOfYear -> MonthOfYear -> Day
fromGregorian Integer
1900 MonthOfYear
1 MonthOfYear
1)
    wmin :: Word16
wmin = DiffTime -> Word16
forall b. Integral b => DiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (DiffTime -> Word16) -> DiffTime -> Word16
forall a b. (a -> b) -> a -> b
$ DiffTime
time DiffTime -> DiffTime -> DiffTime
forall a. Fractional a => a -> a -> a
/ DiffTime
60
  in (Word16
wday,Word16
wmin)

utcToBytes8 :: UTCTime -> (Int32,Word32)
utcToBytes8 :: UTCTime -> (Int32, Word32)
utcToBytes8 (UTCTime Day
date DiffTime
time) =
  let
    iday :: Int32
iday = Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int32) -> Integer -> Int32
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Integer
diffDays Day
date (Integer -> MonthOfYear -> MonthOfYear -> Day
fromGregorian Integer
1900 MonthOfYear
1 MonthOfYear
1)
    w3hsec :: Word32
w3hsec = DiffTime -> Word32
forall b. Integral b => DiffTime -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (DiffTime -> Word32) -> DiffTime -> Word32
forall a b. (a -> b) -> a -> b
$ DiffTime
time DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
300
  in (Int32
iday,Word32
w3hsec)