module Data.Hourglass.Diff
( TimeDiff(..)
, normalizeTimeDiff
, dateTimeAdd
, elapsedTimeAddSeconds
, elapsedTimeAddSecondsP
, elapsedTimeAdd
, elapsedTimeAddP
) where
import Data.Int
import Data.Monoid
import Data.Hourglass.Types
import Data.Hourglass.Calendar
data TimeDiff = TimeDiff
{ timeDiffYears :: Int
, timeDiffMonths :: Int
, timeDiffDays :: Int
, timeDiffHours :: Int
, timeDiffMinutes :: Int
, timeDiffSeconds :: Int
, timeDiffNs :: Int
} deriving (Show,Eq)
toSimplerTimeDiff :: TimeDiff -> (Int, Int, Seconds, NanoSeconds)
toSimplerTimeDiff (TimeDiff y m d h mi s ns) =
(y, m, Seconds accSecs, NanoSeconds ns')
where accSecs = (((i64 d * 24) + i64 h) * 60 + i64 mi) * 60 + i64 s + i64 sacc
(sacc, ns') = ns `divMod` 1000000000
i64 :: Int -> Int64
i64 = fromIntegral
instance Monoid TimeDiff where
mempty = TimeDiff 0 0 0 0 0 0 0
mappend (TimeDiff f1 f2 f3 f4 f5 f6 f7) (TimeDiff g1 g2 g3 g4 g5 g6 g7) =
TimeDiff (f1+g1) (f2+g2) (f3+g3) (f4+g4) (f5+g5) (f6+g6) (f7+g7)
normalizeTimeDiff :: TimeDiff -> TimeDiff
normalizeTimeDiff (TimeDiff y m d h mi s ns) =
TimeDiff y' m' (d+dacc) h' mi' s' ns'
where
y' = y + macc
(macc, m') = m `divMod` 12
(dacc, h') = (h+hacc) `divMod` 24
(hacc, mi') = (mi+miacc) `divMod` 60
(miacc, s') = (s+sacc) `divMod` 60
(sacc, ns') = ns `divMod` 1000000000
dateTimeAddYM :: DateTime -> (Int, Int) -> DateTime
dateTimeAddYM (DateTime (Date y m d) tod) (yDiff, mDiff) =
DateTime (Date (y+yDiff+yDiffAcc) (toEnum mNew) d) tod
where
(yDiffAcc,mNew) = (fromEnum m + mDiff) `divMod` 12
dateTimeAdd :: DateTime -> TimeDiff -> DateTime
dateTimeAdd dt td =
dateTimeFromUnixEpoch $ elapsedTimeAdd (dateTimeToUnixEpoch dt) td
elapsedTimeAddSimple :: Elapsed -> (Int, Int, Seconds) -> Elapsed
elapsedTimeAddSimple e (y,m,secs)
| y == 0 && m == 0 = e'
| otherwise =
let dt = dateTimeFromUnixEpoch e'
in dateTimeToUnixEpoch $ dateTimeAddYM dt (y, m)
where e' = e + Elapsed secs
elapsedTimeAddSeconds :: Elapsed -> Seconds -> Elapsed
elapsedTimeAddSeconds (Elapsed s1) s2 = Elapsed (s1+s2)
elapsedTimeAddSecondsP :: ElapsedP -> Seconds -> ElapsedP
elapsedTimeAddSecondsP (ElapsedP (Elapsed s1) ns1) s2 = ElapsedP (Elapsed (s1+s2)) ns1
elapsedTimeAdd :: Elapsed -> TimeDiff -> Elapsed
elapsedTimeAdd e td = elapsedTimeAddSimple e (y,m,secs)
where (y,m,secs,_) = toSimplerTimeDiff td
elapsedTimeAddP :: ElapsedP -> TimeDiff -> ElapsedP
elapsedTimeAddP (ElapsedP e (NanoSeconds ns)) td = ElapsedP e' ns'
where (y,m,secs,ns') = toSimplerTimeDiff td'
e' = elapsedTimeAddSimple e (y,m,secs)
td' = td { timeDiffNs = timeDiffNs td + ns }