module Data.HodaTime.Instant.Internal
(
Instant(..)
,Duration(..)
,fromUnixGetTimeOfDay
,fromSecondsSinceUnixEpoch
,add
,minus
,difference
,bigBang
)
where
import Data.Word (Word32)
import Data.Int (Int32)
import Data.List (intercalate)
import Data.HodaTime.Constants (secondsPerDay, nsecsPerSecond, nsecsPerMicrosecond, unixDaysOffset)
import Control.Arrow ((>>>), first)
data Instant = Instant { iDays :: Int32, iSecs :: Word32, iNsecs :: Word32 }
deriving (Eq, Ord)
newtype Duration = Duration { getInstant :: Instant }
deriving (Eq, Show)
instance Show Instant where
show (Instant days secs nsecs) = intercalate "." [show (abs days), show secs, show nsecs, sign]
where
sign = if signum days == -1 then "BE" else "E"
bigBang :: Instant
bigBang = Instant minBound minBound minBound
fromSecondsSinceUnixEpoch :: Int -> Instant
fromSecondsSinceUnixEpoch s = fromUnixGetTimeOfDay s 0
add :: Instant -> Duration -> Instant
add (Instant ldays lsecs lnsecs) (Duration (Instant rdays rsecs rnsecs)) = Instant days' secs'' nsecs'
where
days = ldays + rdays
secs = lsecs + rsecs
nsecs = lnsecs + rnsecs
(secs', nsecs') = adjust secs nsecs nsecsPerSecond
(days', secs'') = adjust days secs' secondsPerDay
adjust big small size
| small >= size = (succ big, small - size)
| otherwise = (big, small)
difference :: Instant -> Instant -> Duration
difference (Instant ldays lsecs lnsecs) (Instant rdays rsecs rnsecs) = Duration $ Instant days' (fromIntegral secs'') (fromIntegral nsecs')
where
days = ldays - rdays
secs = (fromIntegral lsecs - fromIntegral rsecs) :: Int
nsecs = (fromIntegral lnsecs - fromIntegral rnsecs) :: Int
(secs', nsecs') = normalize nsecs secs nsecsPerSecond
(days', secs'') = normalize secs' days secondsPerDay
normalize x bigger size
| x < 0 = (pred bigger, x + size)
| otherwise = (bigger, x)
minus :: Instant -> Duration -> Instant
minus linstant (Duration rinstant) = getInstant $ difference linstant rinstant
fromUnixGetTimeOfDay :: Int -> Word32 -> Instant
fromUnixGetTimeOfDay s ms = Instant days (fromIntegral secs) nsecs
where
(days, secs) = flip divMod secondsPerDay >>> first (fromIntegral . subtract unixDaysOffset) $ s
nsecs = ms * nsecsPerMicrosecond