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