1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3-- |
4-- Module      : Data.Hourglass.Diff
5-- License     : BSD-style
6-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
7-- Stability   : experimental
8-- Portability : unknown
9--
10-- time arithmetic methods
11--
12module Data.Hourglass.Diff
13    ( Duration(..)
14    , Period(..)
15    , durationNormalize
16    , durationFlatten
17    , elapsedTimeAddSeconds
18    , elapsedTimeAddSecondsP
19    , dateAddPeriod
20    ) where
21
22import Data.Data
23import Data.Monoid
24import Data.Hourglass.Types
25import Data.Hourglass.Calendar
26import Control.DeepSeq
27
28-- | An amount of conceptual calendar time in terms of years, months and days.
29--
30-- This allow calendar manipulation, representing things like days and months
31-- irrespective on how long those are related to timezone and daylight changes.
32--
33-- See 'Duration' for the time-based equivalent to this class.
34data Period = Period
35    { periodYears  :: !Int
36    , periodMonths :: !Int
37    , periodDays   :: !Int
38    } deriving (Show,Read,Eq,Ord,Data,Typeable)
39
40instance NFData Period where
41    rnf (Period y m d) = y `seq` m `seq` d `seq` ()
42#if (MIN_VERSION_base(4,11,0))
43instance Semigroup Period where
44    (<>) (Period y1 m1 d1) (Period y2 m2 d2) =
45        Period (y1+y2) (m1+m2) (d1+d2)
46#endif
47instance Monoid Period where
48    mempty = Period 0 0 0
49    mappend (Period y1 m1 d1) (Period y2 m2 d2) =
50        Period (y1+y2) (m1+m2) (d1+d2)
51
52-- | An amount of time in terms of constant value like hours (3600 seconds),
53-- minutes (60 seconds), seconds and nanoseconds.
54data Duration = Duration
55    { durationHours   :: !Hours       -- ^ number of hours
56    , durationMinutes :: !Minutes     -- ^ number of minutes
57    , durationSeconds :: !Seconds     -- ^ number of seconds
58    , durationNs      :: !NanoSeconds -- ^ number of nanoseconds
59    } deriving (Show,Read,Eq,Ord,Data,Typeable)
60
61instance NFData Duration where
62    rnf (Duration h m s ns) = h `seq` m `seq` s `seq` ns `seq` ()
63#if (MIN_VERSION_base(4,11,0))
64instance Semigroup Duration where
65    (<>) (Duration h1 m1 s1 ns1) (Duration h2 m2 s2 ns2) =
66        Duration (h1+h2) (m1+m2) (s1+s2) (ns1+ns2)
67#endif
68instance Monoid Duration where
69    mempty = Duration 0 0 0 0
70    mappend (Duration h1 m1 s1 ns1) (Duration h2 m2 s2 ns2) =
71        Duration (h1+h2) (m1+m2) (s1+s2) (ns1+ns2)
72instance TimeInterval Duration where
73    fromSeconds s = (durationNormalize (Duration 0 0 s 0), 0)
74    toSeconds d   = fst $ durationFlatten d
75
76-- | Flatten a duration to a number of seconds, nanoseconds
77durationFlatten :: Duration -> (Seconds, NanoSeconds)
78durationFlatten (Duration h m s (NanoSeconds ns)) =
79    (toSeconds h + toSeconds m + s + Seconds sacc, NanoSeconds ns')
80  where (sacc, ns') = ns `divMod` 1000000000
81
82-- | Normalize all fields to represent the same value
83-- with the biggest units possible.
84--
85-- For example, 62 minutes is normalized as 1h 2minutes
86durationNormalize :: Duration -> Duration
87durationNormalize (Duration (Hours h) (Minutes mi) (Seconds s) (NanoSeconds ns)) =
88    Duration (Hours (h+hacc)) (Minutes mi') (Seconds s') (NanoSeconds ns')
89  where (hacc, mi') = (mi+miacc) `divMod` 60
90        (miacc, s') = (s+sacc) `divMod` 60
91        (sacc, ns') = ns `divMod` 1000000000
92
93-- | add a period of time to a date
94dateAddPeriod :: Date -> Period -> Date
95dateAddPeriod (Date yOrig mOrig dOrig) (Period yDiff mDiff dDiff) =
96    loop (yOrig + yDiff + yDiffAcc) mStartPos (dOrig+dDiff)
97  where
98    (yDiffAcc,mStartPos) = (fromEnum mOrig + mDiff) `divMod` 12
99    loop y m d
100        | d <= 0 =
101            let (m', y') = if m == 0
102                then (11, y - 1)
103                else (m - 1, y)
104            in
105            loop y' m' (daysInMonth y' (toEnum m') + d)
106        | d <= dMonth = Date y (toEnum m) d
107        | otherwise  =
108            let newDiff = d - dMonth
109             in if m == 11
110                    then loop (y+1) 0 newDiff
111                    else loop y (m+1) newDiff
112      where dMonth = daysInMonth y (toEnum m)
113
114-- | Add a number of seconds to an Elapsed type
115elapsedTimeAddSeconds :: Elapsed -> Seconds -> Elapsed
116elapsedTimeAddSeconds (Elapsed s1) s2 = Elapsed (s1+s2)
117
118-- | Add a number of seconds to an ElapsedP type
119elapsedTimeAddSecondsP :: ElapsedP -> Seconds -> ElapsedP
120elapsedTimeAddSecondsP (ElapsedP (Elapsed s1) ns1) s2 =
121    ElapsedP (Elapsed (s1+s2)) ns1
122
123{- disabled for warning purpose. to be implemented
124
125-- | Duration string to time diff
126--
127-- <http://en.wikipedia.org/wiki/ISO_8601#Durations>
128--
129-- * P is the duration designator (historically called "period") placed at the start of the duration representation.
130--
131-- * Y is the year designator that follows the value for the number of years.
132--
133-- * M is the month designator that follows the value for the number of months.
134--
135-- * W is the week designator that follows the value for the number of weeks.
136--
137-- * D is the day designator that follows the value for the number of days.
138--
139-- * T is the time designator that precedes the time components of the representation.
140--
141-- * H is the hour designator that follows the value for the number of hours.
142--
143-- * M is the minute designator that follows the value for the number of minutes.
144--
145-- * S is the second designator that follows the value for the number of seconds.
146--
147timeDiffFromDuration :: String -> TimeDiff
148timeDiffFromDuration _ = undefined
149
150timeDiffFromString :: String -> (
151
152-- | Human description string to time diff
153--
154-- examples:
155--
156-- * "1 day"
157--
158-- * "2 months, 5 days and 1 second"
159--
160timeDiffFromDescription :: String -> TimeDiff
161timeDiffFromDescription _ = undefined
162-}
163