Internal.hs

module Data.HodaTime.Instant.Internal
(
   Instant(..)
  ,Duration(..)
  ,fromUnixGetTimeOfDay
  ,fromSecondsSinceUnixEpoch
  ,add
  ,minus
  ,difference
  ,bigBang
)
where

import Data.Word (Word32)
import Data.Int (Int32)
import Control.DeepSeq (NFData(..))
import Data.Hashable (Hashable(..))
import Data.HodaTime.Constants (secondsPerDay, nsecsPerSecond, nsecsPerMicrosecond, unixDaysOffset)
import Control.Arrow ((>>>), first)

-- types

-- | Represents a point on a global time line.  An Instant has no concept of time zone or
--   calendar.  It is nothing more than the number of nanoseconds since epoch (1.March.2000)
data Instant = Instant { iDays :: {-# UNPACK #-} !Int32, iSecs :: {-# UNPACK #-} !Word32, iNsecs :: {-# UNPACK #-} !Word32 }
  deriving (Eq, Ord)

instance NFData Instant where
  rnf (Instant days secs nsecs) = rnf days `seq` rnf secs `seq` rnf nsecs

instance Hashable Instant where
  hashWithSalt s (Instant days secs nsecs) = s `hashWithSalt` days `hashWithSalt` secs `hashWithSalt` nsecs

-- | Represents a duration of time between instants.  It can be from days to nanoseconds,
--   but anything longer is not representable by a duration because e.g. Months are calendar
--   specific concepts.
newtype Duration = Duration { getInstant :: Instant } {- NOTE: Defined here to avoid circular dependancy with Duration.Internal -}
  deriving (Eq, Ord)

instance NFData Duration where
  rnf (Duration i) = rnf i

instance Hashable Duration where
  hashWithSalt s (Duration i) = hashWithSalt s i

-- | A debug rendering exposing the internal epoch-relative fields (epoch is 1.March.2000).  There is no clean
--   total constructor to reproduce an arbitrary 'Instant', so this is deliberately a labelled view, not a call.
instance Show Instant where
  showsPrec p (Instant days secs nsecs) = showParen (p > 10) $
      showString "Instant " . shows days . showString "d "
    . shows secs . showString "s " . shows nsecs . showString "ns"

instance Show Duration where
  showsPrec p (Duration (Instant days secs nsecs)) = showParen (p > 10) $
      showString "Duration " . shows days . showString "d "
    . shows secs . showString "s " . shows nsecs . showString "ns"

-- interface

-- Smallest possible instant
bigBang :: Instant
bigBang = Instant minBound minBound minBound

-- | Create an 'Instant' from an 'Int' that represents a Unix Epoch
fromSecondsSinceUnixEpoch :: Int -> Instant
fromSecondsSinceUnixEpoch s = fromUnixGetTimeOfDay s 0

-- | Add a 'Duration' to an 'Instant' to get a future 'Instant'.
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)

-- | Get the difference between two instances
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                   -- TODO: We should specify exactly what sizes we need here.  Keep in mind we can depend that secs and nsecs are never negative so
        nsecs = (fromIntegral lnsecs - fromIntegral rnsecs) :: Int                -- TODO: there is no worry that we get e.g. (-nsecsPerSecond - -nsecsPerSecond) causing us to have more than nsecsPerSecond.
        (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)

-- | Subtract a 'Duration' from an 'Instant' to get an 'Instant' in the past.
minus :: Instant -> Duration -> Instant
minus linstant (Duration rinstant) = getInstant $ difference linstant rinstant

-- helper functions

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