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)

-- 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 { Instant -> Int32
iDays :: Int32, Instant -> Word32
iSecs :: Word32, Instant -> Word32
iNsecs :: Word32 }
  deriving (Instant -> Instant -> Bool
(Instant -> Instant -> Bool)
-> (Instant -> Instant -> Bool) -> Eq Instant
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Instant -> Instant -> Bool
== :: Instant -> Instant -> Bool
$c/= :: Instant -> Instant -> Bool
/= :: Instant -> Instant -> Bool
Eq, Eq Instant
Eq Instant =>
(Instant -> Instant -> Ordering)
-> (Instant -> Instant -> Bool)
-> (Instant -> Instant -> Bool)
-> (Instant -> Instant -> Bool)
-> (Instant -> Instant -> Bool)
-> (Instant -> Instant -> Instant)
-> (Instant -> Instant -> Instant)
-> Ord Instant
Instant -> Instant -> Bool
Instant -> Instant -> Ordering
Instant -> Instant -> Instant
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Instant -> Instant -> Ordering
compare :: Instant -> Instant -> Ordering
$c< :: Instant -> Instant -> Bool
< :: Instant -> Instant -> Bool
$c<= :: Instant -> Instant -> Bool
<= :: Instant -> Instant -> Bool
$c> :: Instant -> Instant -> Bool
> :: Instant -> Instant -> Bool
$c>= :: Instant -> Instant -> Bool
>= :: Instant -> Instant -> Bool
$cmax :: Instant -> Instant -> Instant
max :: Instant -> Instant -> Instant
$cmin :: Instant -> Instant -> Instant
min :: Instant -> Instant -> Instant
Ord)

-- | 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 { Duration -> Instant
getInstant :: Instant } {- NOTE: Defined here to avoid circular dependancy with Duration.Internal -}
  deriving (Duration -> Duration -> Bool
(Duration -> Duration -> Bool)
-> (Duration -> Duration -> Bool) -> Eq Duration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Duration -> Duration -> Bool
== :: Duration -> Duration -> Bool
$c/= :: Duration -> Duration -> Bool
/= :: Duration -> Duration -> Bool
Eq, Int -> Duration -> ShowS
[Duration] -> ShowS
Duration -> String
(Int -> Duration -> ShowS)
-> (Duration -> String) -> ([Duration] -> ShowS) -> Show Duration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Duration -> ShowS
showsPrec :: Int -> Duration -> ShowS
$cshow :: Duration -> String
show :: Duration -> String
$cshowList :: [Duration] -> ShowS
showList :: [Duration] -> ShowS
Show)             -- TODO: Remove Show

instance Show Instant where
  show :: Instant -> String
show (Instant Int32
days Word32
secs Word32
nsecs) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." [Int32 -> String
forall a. Show a => a -> String
show (Int32 -> Int32
forall a. Num a => a -> a
abs Int32
days), Word32 -> String
forall a. Show a => a -> String
show Word32
secs, Word32 -> String
forall a. Show a => a -> String
show Word32
nsecs, String
sign]
    where
      sign :: String
sign = if Int32 -> Int32
forall a. Num a => a -> a
signum Int32
days Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== -Int32
1 then String
"BE" else String
"E"

-- interface

-- Smallest possible instant
bigBang :: Instant
bigBang :: Instant
bigBang = Int32 -> Word32 -> Word32 -> Instant
Instant Int32
forall a. Bounded a => a
minBound Word32
forall a. Bounded a => a
minBound Word32
forall a. Bounded a => a
minBound

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

-- | Add a 'Duration' to an 'Instant' to get a future 'Instant'. /NOTE: does not handle all negative durations, use 'minus'/
add :: Instant -> Duration -> Instant
add :: Instant -> Duration -> Instant
add (Instant Int32
ldays Word32
lsecs Word32
lnsecs) (Duration (Instant Int32
rdays Word32
rsecs Word32
rnsecs)) = Int32 -> Word32 -> Word32 -> Instant
Instant Int32
days' Word32
secs'' Word32
nsecs'
    where
        days :: Int32
days = Int32
ldays Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
rdays
        secs :: Word32
secs = Word32
lsecs Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
rsecs
        nsecs :: Word32
nsecs = Word32
lnsecs Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
rnsecs
        (Word32
secs', Word32
nsecs') = Word32 -> Word32 -> Word32 -> (Word32, Word32)
forall {b} {a}. (Ord b, Enum a, Num b) => a -> b -> b -> (a, b)
adjust Word32
secs Word32
nsecs Word32
forall a. Num a => a
nsecsPerSecond
        (Int32
days', Word32
secs'') = Int32 -> Word32 -> Word32 -> (Int32, Word32)
forall {b} {a}. (Ord b, Enum a, Num b) => a -> b -> b -> (a, b)
adjust Int32
days Word32
secs' Word32
forall a. Num a => a
secondsPerDay
        adjust :: a -> b -> b -> (a, b)
adjust a
big b
small b
size
            | b
small b -> b -> Bool
forall a. Ord a => a -> a -> Bool
>= b
size = (a -> a
forall a. Enum a => a -> a
succ a
big, b
small b -> b -> b
forall a. Num a => a -> a -> a
- b
size)
            | Bool
otherwise = (a
big, b
small)

-- | Get the difference between two instances
difference :: Instant -> Instant -> Duration
difference :: Instant -> Instant -> Duration
difference (Instant Int32
ldays Word32
lsecs Word32
lnsecs) (Instant Int32
rdays Word32
rsecs Word32
rnsecs) = Instant -> Duration
Duration (Instant -> Duration) -> Instant -> Duration
forall a b. (a -> b) -> a -> b
$ Int32 -> Word32 -> Word32 -> Instant
Instant Int32
days' (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
secs'') (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nsecs')
    where
        days :: Int32
days = Int32
ldays Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
rdays
        secs :: Int
secs = (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
lsecs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
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 :: Int
nsecs = (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
lnsecs Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
rnsecs) :: Int                -- TODO: there is no worry that we get e.g. (-nsecsPerSecond - -nsecsPerSecond) causing us to have more than nsecsPerSecond.
        (Int
secs', Int
nsecs') = Int -> Int -> Int -> (Int, Int)
forall {b} {a}. (Ord b, Num b, Enum a) => b -> a -> b -> (a, b)
normalize Int
nsecs Int
secs Int
forall a. Num a => a
nsecsPerSecond
        (Int32
days', Int
secs'') = Int -> Int32 -> Int -> (Int32, Int)
forall {b} {a}. (Ord b, Num b, Enum a) => b -> a -> b -> (a, b)
normalize Int
secs' Int32
days Int
forall a. Num a => a
secondsPerDay
        normalize :: b -> a -> b -> (a, b)
normalize b
x a
bigger b
size
            | b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
0 = (a -> a
forall a. Enum a => a -> a
pred a
bigger, b
x b -> b -> b
forall a. Num a => a -> a -> a
+ b
size)
            | Bool
otherwise = (a
bigger, b
x)

-- | Subtract a 'Duration' from an 'Instant' to get an 'Instant' in the past.  /NOTE: does not handle negative durations, use 'add'/
minus :: Instant -> Duration -> Instant
minus :: Instant -> Duration -> Instant
minus Instant
linstant (Duration Instant
rinstant) = Duration -> Instant
getInstant (Duration -> Instant) -> Duration -> Instant
forall a b. (a -> b) -> a -> b
$ Instant -> Instant -> Duration
difference Instant
linstant Instant
rinstant

-- helper functions

fromUnixGetTimeOfDay :: Int -> Word32 -> Instant
fromUnixGetTimeOfDay :: Int -> Word32 -> Instant
fromUnixGetTimeOfDay Int
s Word32
ms = Int32 -> Word32 -> Word32 -> Instant
Instant Int32
days (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
secs) Word32
nsecs
  where
    (Int32
days, Int
secs) = (Int -> Int -> (Int, Int)) -> Int -> Int -> (Int, Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
forall a. Num a => a
secondsPerDay (Int -> (Int, Int))
-> ((Int, Int) -> (Int32, Int)) -> Int -> (Int32, Int)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Int -> Int32) -> (Int, Int) -> (Int32, Int)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> (Int -> Int) -> Int -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
forall a. Num a => a
unixDaysOffset) (Int -> (Int32, Int)) -> Int -> (Int32, Int)
forall a b. (a -> b) -> a -> b
$ Int
s
    nsecs :: Word32
nsecs = Word32
ms Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
forall a. Num a => a
nsecsPerMicrosecond