{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Data.Hourglass.Diff
( Duration(..)
, Period(..)
, durationNormalize
, durationFlatten
, elapsedTimeAddSeconds
, elapsedTimeAddSecondsP
, dateAddPeriod
) where
import Data.Data
import Data.Monoid
import Data.Hourglass.Types
import Data.Hourglass.Calendar
import Control.DeepSeq
data Period = Period
{ periodYears :: !Int
, periodMonths :: !Int
, periodDays :: !Int
} deriving (Show,Read,Eq,Ord,Data,Typeable)
instance NFData Period where
rnf (Period y m d) = y `seq` m `seq` d `seq` ()
#if (MIN_VERSION_base(4,11,0))
instance Semigroup Period where
(<>) (Period y1 m1 d1) (Period y2 m2 d2) =
Period (y1+y2) (m1+m2) (d1+d2)
#endif
instance Monoid Period where
mempty = Period 0 0 0
mappend (Period y1 m1 d1) (Period y2 m2 d2) =
Period (y1+y2) (m1+m2) (d1+d2)
data Duration = Duration
{ durationHours :: !Hours
, durationMinutes :: !Minutes
, durationSeconds :: !Seconds
, durationNs :: !NanoSeconds
} deriving (Show,Read,Eq,Ord,Data,Typeable)
instance NFData Duration where
rnf (Duration h m s ns) = h `seq` m `seq` s `seq` ns `seq` ()
#if (MIN_VERSION_base(4,11,0))
instance Semigroup Duration where
(<>) (Duration h1 m1 s1 ns1) (Duration h2 m2 s2 ns2) =
Duration (h1+h2) (m1+m2) (s1+s2) (ns1+ns2)
#endif
instance Monoid Duration where
mempty = Duration 0 0 0 0
mappend (Duration h1 m1 s1 ns1) (Duration h2 m2 s2 ns2) =
Duration (h1+h2) (m1+m2) (s1+s2) (ns1+ns2)
instance TimeInterval Duration where
fromSeconds s = (durationNormalize (Duration 0 0 s 0), 0)
toSeconds d = fst $ durationFlatten d
durationFlatten :: Duration -> (Seconds, NanoSeconds)
durationFlatten (Duration h m s (NanoSeconds ns)) =
(toSeconds h + toSeconds m + s + Seconds sacc, NanoSeconds ns')
where (sacc, ns') = ns `divMod` 1000000000
durationNormalize :: Duration -> Duration
durationNormalize (Duration (Hours h) (Minutes mi) (Seconds s) (NanoSeconds ns)) =
Duration (Hours (h+hacc)) (Minutes mi') (Seconds s') (NanoSeconds ns')
where (hacc, mi') = (mi+miacc) `divMod` 60
(miacc, s') = (s+sacc) `divMod` 60
(sacc, ns') = ns `divMod` 1000000000
dateAddPeriod :: Date -> Period -> Date
dateAddPeriod (Date yOrig mOrig dOrig) (Period yDiff mDiff dDiff) =
loop (yOrig + yDiff + yDiffAcc) mStartPos (dOrig+dDiff)
where
(yDiffAcc,mStartPos) = (fromEnum mOrig + mDiff) `divMod` 12
loop y m d
| d <= 0 =
let (m', y') = if m == 0
then (11, y - 1)
else (m - 1, y)
in
loop y' m' (daysInMonth y' (toEnum m') + d)
| d <= dMonth = Date y (toEnum m) d
| otherwise =
let newDiff = d - dMonth
in if m == 11
then loop (y+1) 0 newDiff
else loop y (m+1) newDiff
where dMonth = daysInMonth y (toEnum m)
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