hourglass-0.2.12/Data/0000755000000000000000000000000013340057345012646 5ustar0000000000000000hourglass-0.2.12/Data/Hourglass/0000755000000000000000000000000013340057345014615 5ustar0000000000000000hourglass-0.2.12/Data/Hourglass/Internal/0000755000000000000000000000000013340057345016371 5ustar0000000000000000hourglass-0.2.12/System/0000755000000000000000000000000013340057345013261 5ustar0000000000000000hourglass-0.2.12/Time/0000755000000000000000000000000013340057405012670 5ustar0000000000000000hourglass-0.2.12/cbits/0000755000000000000000000000000013340057345013101 5ustar0000000000000000hourglass-0.2.12/tests/0000755000000000000000000000000013340057631013135 5ustar0000000000000000hourglass-0.2.12/Time/Types.hs0000644000000000000000000001715513340057405014341 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} -- | -- Module : Time.Types -- License : BSD-style -- Maintainer : Vincent Hanquez -- -- Basic times units and types. -- -- While pratically some units could hold infinite values, for practical -- and efficient purpose they are limited to int64 types for seconds -- and int types for years. -- -- Most units use the unix epoch referential, but by no means reduce portability. -- the unix referential works under the Windows platform or any other platforms. -- module Time.Types ( -- * Time units NanoSeconds(..) , Seconds(..) , Minutes(..) , Hours(..) , TimeInterval(..) -- * Time enumeration , Month(..) , WeekDay(..) -- * Timezone , TimezoneOffset(..) , timezoneOffsetToSeconds , timezone_UTC -- * Computer friendly format -- ** Unix elapsed , Elapsed(..) , ElapsedP(..) -- * Human friendly format -- ** Calendar time , Date(..) , TimeOfDay(..) , DateTime(..) ) where import Data.Int import Data.Data import Data.Ratio import Control.DeepSeq import Data.Hourglass.Utils (pad2) -- | Represent any time interval that has an -- equivalent value to a number of seconds. class TimeInterval i where toSeconds :: i -> Seconds fromSeconds :: Seconds -> (i, Seconds) -- | Nanoseconds newtype NanoSeconds = NanoSeconds Int64 deriving (Read,Eq,Ord,Num,Data,Typeable,NFData) instance Show NanoSeconds where show (NanoSeconds v) = shows v "ns" instance TimeInterval NanoSeconds where toSeconds (NanoSeconds ns) = Seconds (ns `div` 1000000000) fromSeconds (Seconds s) = (NanoSeconds (s * 1000000000), 0) -- | Number of seconds without a referential. -- -- Can hold a number between [-2^63,2^63-1], which should -- be good for some billions of years. -- -- However, because of limitation in the calendar conversion -- currently used, seconds should be in the range [-2^55,2^55-1], -- which is good for only 1 billion of year. newtype Seconds = Seconds Int64 deriving (Read,Eq,Ord,Enum,Num,Real,Integral,Data,Typeable,NFData) instance Show Seconds where show (Seconds s) = shows s "s" instance TimeInterval Seconds where toSeconds = id fromSeconds s = (s,0) -- | Number of minutes without a referential. newtype Minutes = Minutes Int64 deriving (Read,Eq,Ord,Enum,Num,Real,Integral,Data,Typeable,NFData) instance Show Minutes where show (Minutes s) = shows s "m" instance TimeInterval Minutes where toSeconds (Minutes m) = Seconds (m * 60) fromSeconds (Seconds s) = (Minutes m, Seconds s') where (m, s') = s `divMod` 60 -- | Number of hours without a referential. newtype Hours = Hours Int64 deriving (Read,Eq,Ord,Enum,Num,Real,Integral,Data,Typeable,NFData) instance Show Hours where show (Hours s) = shows s "h" instance TimeInterval Hours where toSeconds (Hours h) = Seconds (h * 3600) fromSeconds (Seconds s) = (Hours h, Seconds s') where (h, s') = s `divMod` 3600 -- | A number of seconds elapsed since the unix epoch. newtype Elapsed = Elapsed Seconds deriving (Read,Eq,Ord,Num,Data,Typeable,NFData) instance Show Elapsed where show (Elapsed s) = show s -- | A number of seconds and nanoseconds elapsed since the unix epoch. data ElapsedP = ElapsedP {-# UNPACK #-} !Elapsed {-# UNPACK #-} !NanoSeconds deriving (Read,Eq,Ord,Data,Typeable) instance Show ElapsedP where show (ElapsedP e ns) = shows e ('.' : show ns) instance NFData ElapsedP where rnf e = e `seq` () instance Num ElapsedP where (+) = addElapsedP (-) = subElapsedP (ElapsedP e1 ns1) * (ElapsedP e2 ns2) = ElapsedP (e1*e2) (ns1*ns2) negate (ElapsedP e ns) = ElapsedP (negate e) ns abs (ElapsedP e ns) = ElapsedP (abs e) ns signum (ElapsedP e ns) = ElapsedP (signum e) ns fromInteger i = ElapsedP (Elapsed (fromIntegral i)) 0 addElapsedP :: ElapsedP -> ElapsedP -> ElapsedP addElapsedP (ElapsedP e1 (NanoSeconds ns1)) (ElapsedP e2 (NanoSeconds ns2)) = let notNormalizedNS = ns1 + ns2 (retainedNS, ns) = notNormalizedNS `divMod` 1000000000 in ElapsedP (e1 + e2 + (Elapsed $ Seconds retainedNS)) (NanoSeconds ns) subElapsedP :: ElapsedP -> ElapsedP -> ElapsedP subElapsedP (ElapsedP e1 (NanoSeconds ns1)) (ElapsedP e2 (NanoSeconds ns2)) = let notNormalizedNS = ns1 - ns2 notNormalizedS = e1 - e2 in if notNormalizedNS < 0 then ElapsedP (notNormalizedS - oneSecond) (NanoSeconds (1000000000 + notNormalizedNS)) else ElapsedP notNormalizedS (NanoSeconds notNormalizedNS) where oneSecond :: Elapsed oneSecond = Elapsed $ Seconds 1 instance Real ElapsedP where toRational (ElapsedP (Elapsed (Seconds s)) (NanoSeconds 0)) = fromIntegral s toRational (ElapsedP (Elapsed (Seconds s)) (NanoSeconds ns)) = fromIntegral s + (fromIntegral ns % 1000000000) -- | Month of the year data Month = January | February | March | April | May | June | July | August | September | October | November | December deriving (Show,Read,Eq,Ord,Enum,Data,Typeable,Bounded) -- | Day of the week -- -- the enumeration starts on Sunday. data WeekDay = Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday deriving (Show,Read,Eq,Ord,Enum,Data,Typeable,Bounded) -- | Offset against UTC in minutes to obtain from UTC time, local time. -- -- * a positive number represent a location East of UTC. -- -- * a negative number represent a location West of UTC. -- -- LocalTime t (-300) = t represent a time at UTC-5 -- LocalTime t (+480) = t represent a time at UTC+8 -- -- should be between -11H and +14H -- -- Example: -- in AUSEDT (UTC+1000 with daylight = UTC+1100), local time is 15:47; -- Thus, UTC time is 04:47, and TimezoneOffset is +660 (minutes) -- newtype TimezoneOffset = TimezoneOffset { timezoneOffsetToMinutes :: Int -- ^ return the number of minutes } deriving (Eq,Ord,Data,Typeable,NFData) -- | Return the number of seconds associated with a timezone timezoneOffsetToSeconds :: TimezoneOffset -> Seconds timezoneOffsetToSeconds (TimezoneOffset ofs) = Seconds (fromIntegral ofs * 60) instance Show TimezoneOffset where show (TimezoneOffset tz) = concat [if tz < 0 then "-" else "+", pad2 tzH, pad2 tzM] where (tzH, tzM) = abs tz `divMod` 60 -- | The UTC timezone. offset of 0 timezone_UTC :: TimezoneOffset timezone_UTC = TimezoneOffset 0 -- | human date representation using common calendar data Date = Date { dateYear :: {-# UNPACK #-} !Int -- ^ year (Common Era) , dateMonth :: !Month -- ^ month of the year , dateDay :: {-# UNPACK #-} !Int -- ^ day of the month, between 1 to 31 } deriving (Show,Read,Eq,Ord,Data,Typeable) instance NFData Date where rnf (Date y m d) = y `seq` m `seq` d `seq` () -- | human time representation of hour, minutes, seconds in a day. data TimeOfDay = TimeOfDay { todHour :: {-# UNPACK #-} !Hours -- ^ hours, between 0 and 23 , todMin :: {-# UNPACK #-} !Minutes -- ^ minutes, between 0 and 59 , todSec :: {-# UNPACK #-} !Seconds -- ^ seconds, between 0 and 59. 60 when having leap second */ , todNSec :: {-# UNPACK #-} !NanoSeconds -- ^ nanoseconds, between 0 and 999999999 */ } deriving (Show,Read,Eq,Ord,Data,Typeable) instance NFData TimeOfDay where rnf (TimeOfDay h m s ns) = h `seq` m `seq` s `seq` ns `seq` () -- | Date and Time data DateTime = DateTime { dtDate :: Date , dtTime :: TimeOfDay } deriving (Show,Read,Eq,Ord,Data,Typeable) instance NFData DateTime where rnf (DateTime d t) = rnf d `seq` rnf t `seq` () hourglass-0.2.12/Time/System.hs0000644000000000000000000000341413340057345014515 0ustar0000000000000000-- | -- Module : Time.System -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- Get the system timezone and current time value in multiple formats -- module Time.System ( -- * Current time in computer friendly format timeCurrent , timeCurrentP -- * Current time in human friendly DateTime format , dateCurrent , localDateCurrent , localDateCurrentAt -- * System timezone , timezoneCurrent ) where import Control.Applicative import Time.Types import Data.Hourglass.Time import Data.Hourglass.Local import Data.Hourglass.Internal (systemGetElapsedP, systemGetElapsed, systemGetTimezone) -- | Get the current elapsed seconds since epoch timeCurrent :: IO Elapsed timeCurrent = systemGetElapsed -- | Get the current elapsed seconds (precise to the nanosecond) since epoch timeCurrentP :: IO ElapsedP timeCurrentP = systemGetElapsedP -- | Get the current global date -- -- This is equivalent to: -- -- > timeGetDateTimeOfDay `fmap` timeCurrentP dateCurrent :: IO DateTime dateCurrent = timeGetDateTimeOfDay <$> timeCurrentP -- | Get the localized date by using 'timezoneCurrent' and 'dateCurrent' localDateCurrent :: IO (LocalTime DateTime) localDateCurrent = localTimeSetTimezone <$> timezoneCurrent <*> (localTimeFromGlobal <$> dateCurrent) -- | Get the localized date at a specific timezone offset. localDateCurrentAt :: TimezoneOffset -> IO (LocalTime DateTime) localDateCurrentAt tz = localTimeSetTimezone tz . localTimeFromGlobal <$> dateCurrent -- | Get the current timezone offset -- -- This include daylight saving time when in operation. timezoneCurrent :: IO TimezoneOffset timezoneCurrent = systemGetTimezone hourglass-0.2.12/Time/Compat.hs0000644000000000000000000000644113340057345014457 0ustar0000000000000000-- | -- Module : Time.Compat -- License : BSD-style -- Maintainer : Nicolas DI PRIMA -- -- Basic Time conversion compatibility. -- -- This module aims to help conversion between the types from the package -- time to the package hourglass. -- -- Example of use (extracted from file Example/Time/Compat.hs): -- -- > import Data.Hourglass as H -- > import Data.Hourglass.Compat as C -- > import Data.Time as T -- > -- > transpose :: T.ZonedTime -- > -> H.LocalTime H.DateTime -- > transpose oldTime = -- > H.localTime -- > offsetTime -- > (H.DateTime newDate timeofday) -- > where -- > newDate :: H.Date -- > newDate = C.dateFromTAIEpoch $ T.toModifiedJulianDay $ T.localDay $ T.zonedTimeToLocalTime oldTime -- > -- > timeofday :: H.TimeOfDay -- > timeofday = C.diffTimeToTimeOfDay $ T.timeOfDayToTime $ T.localTimeOfDay $ T.zonedTimeToLocalTime oldTime -- > -- > offsetTime = H.TimezoneOffset $ fromIntegral $ T.timeZoneMinutes $ T.zonedTimeZone oldTime -- module Time.Compat ( dateFromPOSIXEpoch , dateFromTAIEpoch , diffTimeToTimeOfDay ) where import Data.Hourglass -- | Convert an integer which represent the Number of days (To/From) POSIX Epoch -- to a Date (POSIX Epoch is 1970-01-01). dateFromPOSIXEpoch :: Integer -- ^ number of days since POSIX Epoch -> Date dateFromPOSIXEpoch day = do let sec = Elapsed $ fromIntegral $ day * 86400 timeConvert sec -- | Number of days between POSIX Epoch and TAI Epoch -- (between 1858-11-17 and 1970-01-01) daysTAItoPOSIX :: Integer daysTAItoPOSIX = 40587 -- | Convert an integer which represents the Number of days (To/From) TAI Epoch -- This function allows use of the package time to easily convert the Day into -- the Hourglass Date representation (TAI Epoch is 1858-11-17). -- -- This function allows user to easily convert a Data.Time.Calendar.Day into Date -- -- > import qualified Data.Time.Calendar as T -- > -- > timeDay :: T.Day -- > -- > dateFromTAIEpoch $ T.toModifiedJulianDay timeDay dateFromTAIEpoch :: Integer -- ^ number of days since TAI Epoch -> Date dateFromTAIEpoch dtai = dateFromPOSIXEpoch (dtai - daysTAItoPOSIX) -- | Convert of differential of time of a day. -- (it convers a Data.Time.Clock.DiffTime into a TimeOfDay) -- -- Example with DiffTime type from time: -- -- > import qualified Data.Time.Clock as T -- > -- > difftime :: T.DiffTime -- > -- > diffTimeToTimeOfDay difftime -- -- Example with the TimeOfDay type from time: -- -- > import qualified Data.Time.Clock as T -- > -- > timeofday :: T.TimeOfDay -- > -- > diffTimeToTimeOfDay $ T.timeOfDayToTime timeofday diffTimeToTimeOfDay :: Real t => t -- ^ number of seconds of the time of the day -> TimeOfDay diffTimeToTimeOfDay dt = do TimeOfDay { todHour = fromIntegral hours , todMin = fromIntegral minutes , todSec = fromIntegral seconds , todNSec = fromIntegral nsecs } where r :: Rational r = toRational dt (secs, nR) = properFraction r :: (Integer, Rational) nsecs :: Integer nsecs = round (nR * 1000000000) (minsofday, seconds) = secs `divMod` 60 :: (Integer, Integer) (hours, minutes) = minsofday `divMod` 60 :: (Integer, Integer) hourglass-0.2.12/Data/Hourglass.hs0000644000000000000000000000236713340057345015161 0ustar0000000000000000-- | -- Module : Data.Hourglass -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- Types and methods for time manipulation. -- -- The most basic type for time representation is Elapsed, which -- represent a number of elapsed seconds since the unix epoch. -- -- Every other defined types can be convert to and from Elapsed type: -- -- > timeGetElapsed (Date 1 2 3) :: Elapsed -- > timeFromElapsed 123 :: DateTime -- -- Local time is represented by any other time types (Elapsed, Date, DateTime, ..), -- but augmented by a Timezone offset in minutes. -- -- > localTime (Date 2014 May 4) 600 -- local time at UTC+10 of May 4th 2014 -- module Data.Hourglass ( module Data.Hourglass.Time , module Data.Hourglass.Types , module Data.Hourglass.Format , module Data.Hourglass.Local , module Data.Hourglass.Zone -- * Calendar misc functions , isLeapYear , getWeekDay , getDayOfTheYear , daysInMonth ) where import Data.Hourglass.Time import Data.Hourglass.Format import Data.Hourglass.Types import Data.Hourglass.Local import Data.Hourglass.Zone import Data.Hourglass.Calendar (isLeapYear, getWeekDay, getDayOfTheYear, daysInMonth) hourglass-0.2.12/Data/Hourglass/Types.hs0000644000000000000000000000132413340057345016255 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} -- | -- Module : Data.Hourglass.Types -- License : BSD-style -- Maintainer : Vincent Hanquez -- -- Basic times units and types. -- -- While pratically some units could hold infinite values, for practical -- and efficient purpose they are limited to int64 types for seconds -- and int types for years. -- -- Most units use the unix epoch referential, but by no means reduce portability. -- the unix referential works under the Windows platform or any other platforms. -- -- This module will be depreciated in favor of Time.Types -- module Data.Hourglass.Types ( module Time.Types ) where import Time.Types hourglass-0.2.12/Data/Hourglass/Epoch.hs0000644000000000000000000001153313340057345016212 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} -- | -- Module : Data.Hourglass.Epoch -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- Epoch tracking -- module Data.Hourglass.Epoch ( -- * computer time tracking with various epoch ElapsedSince(..) , ElapsedSinceP(..) -- * Epoch , Epoch(..) -- ** standard and usual epochs , UnixEpoch(..) , WindowsEpoch(..) ) where import Data.Data import Control.DeepSeq import Data.Hourglass.Types import Data.Hourglass.Time -- | A number of seconds elapsed since an epoch. newtype ElapsedSince epoch = ElapsedSince Seconds deriving (Show,Read,Eq,Ord,Num,Data,Typeable,NFData) -- | A number of seconds and nanoseconds elapsed since an epoch. data ElapsedSinceP epoch = ElapsedSinceP {-# UNPACK #-} !(ElapsedSince epoch) {-# UNPACK #-} !NanoSeconds deriving (Show,Read,Eq,Ord,Data,Typeable) instance NFData (ElapsedSinceP e) where rnf e = e `seq` () instance Num (ElapsedSinceP e) where (ElapsedSinceP e1 ns1) + (ElapsedSinceP e2 ns2) = ElapsedSinceP (e1+e2) (ns1+ns2) (ElapsedSinceP e1 ns1) - (ElapsedSinceP e2 ns2) = ElapsedSinceP (e1-e2) (ns1-ns2) (ElapsedSinceP e1 ns1) * (ElapsedSinceP e2 ns2) = ElapsedSinceP (e1*e2) (ns1*ns2) negate (ElapsedSinceP e ns) = ElapsedSinceP (negate e) ns abs (ElapsedSinceP e ns) = ElapsedSinceP (abs e) ns signum (ElapsedSinceP e ns) = ElapsedSinceP (signum e) ns fromInteger i = ElapsedSinceP (ElapsedSince (fromIntegral i)) 0 -- FIXME instance Real (ElapsedSinceP e) -- | epoch related. -- -- We use the well known Unix epoch as the -- reference timezone for doing conversion between epochs. -- -- Each methods of this typeclass should not use the actual value, -- but only get the information needed from the type itself. class Epoch epoch where -- | The name of this epoch epochName :: epoch -> String -- | number of seconds of difference with 1st January 1970. -- -- a negative number means that this epoch start before -- the unix epoch. epochDiffToUnix :: epoch -> Seconds -- | Unix Epoch, starting 1st January 1970 data UnixEpoch = UnixEpoch deriving (Show,Eq) instance Epoch UnixEpoch where epochName _ = "unix" epochDiffToUnix _ = 0 -- | Windows Epoch, starting 1st January 1601 data WindowsEpoch = WindowsEpoch deriving (Show,Eq) instance Epoch WindowsEpoch where epochName _ = "windows" epochDiffToUnix _ = -11644473600 instance Epoch epoch => Timeable (ElapsedSince epoch) where timeGetElapsedP es = ElapsedP (Elapsed e) 0 where ElapsedSince e = convertEpoch es :: ElapsedSince UnixEpoch timeGetElapsed es = Elapsed e where ElapsedSince e = convertEpoch es :: ElapsedSince UnixEpoch timeGetNanoSeconds _ = 0 instance Epoch epoch => Time (ElapsedSince epoch) where timeFromElapsedP (ElapsedP (Elapsed e) _) = convertEpoch (ElapsedSince e :: ElapsedSince UnixEpoch) instance Epoch epoch => Timeable (ElapsedSinceP epoch) where timeGetElapsedP es = ElapsedP (Elapsed e) ns where ElapsedSinceP (ElapsedSince e) ns = convertEpochP es :: ElapsedSinceP UnixEpoch timeGetNanoSeconds (ElapsedSinceP _ ns) = ns instance Epoch epoch => Time (ElapsedSinceP epoch) where timeFromElapsedP (ElapsedP (Elapsed e) ns) = convertEpochP (ElapsedSinceP (ElapsedSince e) ns :: ElapsedSinceP UnixEpoch) -- | Convert Elapsed seconds to another epoch with explicit epochs specified convertEpochWith :: (Epoch e1, Epoch e2) => (e1,e2) -> ElapsedSince e1 -> ElapsedSince e2 convertEpochWith (e1,e2) (ElapsedSince s1) = ElapsedSince (s1 + diff) where diff = d1 - d2 d1 = epochDiffToUnix e1 d2 = epochDiffToUnix e2 -- | Convert Elapsed seconds to another epoch. -- -- the actual epochs need to be known somehow by the context, otherwise this function -- will yield a compilation errors as the epoch are not chosen. -- -- If you want to force specific epoch conversion, use convertEpochWith convertEpoch :: (Epoch e1, Epoch e2) => ElapsedSince e1 -> ElapsedSince e2 convertEpoch = convertEpochWith (undefined, undefined) -- | Convert Precise Elapsed seconds to another epoch with explicit epochs specified convertEpochPWith :: (Epoch e1, Epoch e2) => (e1,e2) -> ElapsedSinceP e1 -> ElapsedSinceP e2 convertEpochPWith es (ElapsedSinceP e1 n1) = ElapsedSinceP (convertEpochWith es e1) n1 -- | Convert Elapsed seconds to another epoch. -- -- the actual epochs need to be known somehow by the context, otherwise this function -- will yield a compilation errors as the epoch are not chosen. -- -- If you want to force specific epoch conversion, use convertEpochWith convertEpochP :: (Epoch e1, Epoch e2) => ElapsedSinceP e1 -> ElapsedSinceP e2 convertEpochP = convertEpochPWith (undefined, undefined) hourglass-0.2.12/Data/Hourglass/Compat.hs0000644000000000000000000000230013340057345016367 0ustar0000000000000000-- | -- Module : Data.Hourglass.Compat -- License : BSD-style -- Maintainer : Nicolas DI PRIMA -- -- Basic Time conversion compatibility. -- -- This module aims to help conversion between the types from the package -- time to the package hourglass. -- -- Example of use (extracted from file Example/Time/Compat.hs): -- -- > import Data.Hourglass as H -- > import Data.Hourglass.Compat as C -- > import Data.Time as T -- > -- > transpose :: T.ZonedTime -- > -> H.LocalTime H.DateTime -- > transpose oldTime = -- > H.localTime -- > offsetTime -- > (H.DateTime newDate timeofday) -- > where -- > newDate :: H.Date -- > newDate = C.dateFromTAIEpoch $ T.toModifiedJulianDay $ T.localDay $ T.zonedTimeToLocalTime oldTime -- > -- > timeofday :: H.TimeOfDay -- > timeofday = C.diffTimeToTimeOfDay $ T.timeOfDayToTime $ T.localTimeOfDay $ T.zonedTimeToLocalTime oldTime -- > -- > offsetTime = H.TimezoneOffset $ fromIntegral $ T.timeZoneMinutes $ T.zonedTimeZone oldTime -- -- This module will be depreciated in favor of Time.Compat -- module Data.Hourglass.Compat ( module Time.Compat ) where import Time.Compat hourglass-0.2.12/System/Hourglass.hs0000644000000000000000000000061113340057345015562 0ustar0000000000000000-- | -- Module : System.Hourglass -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- Get the system timezone and current time value in multiple formats -- -- This module will be depreciated in favor of Time.System -- module System.Hourglass ( module Time.System ) where import Time.System hourglass-0.2.12/Data/Hourglass/Time.hs0000644000000000000000000001545313340057345016057 0ustar0000000000000000-- | -- Module : Data.Hourglass.Time -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- generic time representation interface to allow -- arbitrary conversion between different time representation -- {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module Data.Hourglass.Time ( -- * Generic time classes Time(..) , Timeable(..) -- * Elapsed time , Elapsed(..) , ElapsedP(..) -- * Generic conversion , timeConvert -- * Date and Time , timeGetDate , timeGetDateTimeOfDay , timeGetTimeOfDay -- * Arithmetic , Duration(..) , Period(..) , TimeInterval(..) , timeAdd , timeDiff , timeDiffP , dateAddPeriod ) where import Data.Data () import Data.Hourglass.Types import Data.Hourglass.Calendar import Data.Hourglass.Diff import Foreign.C.Types (CTime(..)) -- | Timeable represent every type that can be made to look like time types. -- -- * can be converted to ElapsedP and Elapsed -- -- * optionally have a timezone associated -- -- * have nanoseconds accessor (which can return 0 when the type is not more precise than seconds) -- class Timeable t where -- | convert a time representation to the number of elapsed seconds and nanoseconds to a specific epoch timeGetElapsedP :: t -> ElapsedP -- | convert a time representation to the number of elapsed seconds to a specific epoch. -- -- defaults to timeGetElapsedP unless defined explicitely by an instance timeGetElapsed :: t -> Elapsed timeGetElapsed t = e where ElapsedP e _ = timeGetElapsedP t -- | return the number of optional nanoseconds. -- -- If the underlaying type is not precise enough to record nanoseconds -- (or any variant between seconds and nanoseconds), 0 should be returned -- -- defaults to 'timeGetElapsedP' unless defined explicitely by an instance, -- for efficiency reason, it's a good idea to override this methods if -- you know the type is not more precise than Seconds. timeGetNanoSeconds :: t -> NanoSeconds timeGetNanoSeconds t = ns where ElapsedP _ ns = timeGetElapsedP t -- | Represent time types that can be created from other time types. -- -- Every conversion happens throught ElapsedP or Elapsed types. class Timeable t => Time t where -- | convert from a number of elapsed seconds and nanoseconds to another time representation timeFromElapsedP :: ElapsedP -> t -- | convert from a number of elapsed seconds and nanoseconds to another time representation -- -- defaults to timeFromElapsedP unless defined explicitely by an instance. timeFromElapsed :: Elapsed -> t timeFromElapsed e = timeFromElapsedP (ElapsedP e 0) #if (MIN_VERSION_base(4,5,0)) instance Timeable CTime where timeGetElapsedP c = ElapsedP (timeGetElapsed c) 0 timeGetElapsed (CTime c) = Elapsed (Seconds $ fromIntegral c) timeGetNanoSeconds _ = 0 instance Time CTime where timeFromElapsedP (ElapsedP e _) = timeFromElapsed e timeFromElapsed (Elapsed (Seconds c)) = CTime (fromIntegral c) #endif instance Timeable Elapsed where timeGetElapsedP e = ElapsedP e 0 timeGetElapsed e = e timeGetNanoSeconds _ = 0 instance Time Elapsed where timeFromElapsedP (ElapsedP e _) = e timeFromElapsed e = e instance Timeable ElapsedP where timeGetElapsedP e = e timeGetNanoSeconds (ElapsedP _ ns) = ns instance Time ElapsedP where timeFromElapsedP e = e instance Timeable Date where timeGetElapsedP d = timeGetElapsedP (DateTime d (TimeOfDay 0 0 0 0)) instance Time Date where timeFromElapsedP (ElapsedP elapsed _) = d where (DateTime d _) = dateTimeFromUnixEpoch elapsed instance Timeable DateTime where timeGetElapsedP d = ElapsedP (dateTimeToUnixEpoch d) (timeGetNanoSeconds d) timeGetElapsed d = dateTimeToUnixEpoch d timeGetNanoSeconds (DateTime _ (TimeOfDay _ _ _ ns)) = ns instance Time DateTime where timeFromElapsedP elapsed = dateTimeFromUnixEpochP elapsed -- | Convert one time representation into another one -- -- The return type need to be infer by the context. -- -- If the context cannot be infer through this, some specialized functions -- are available for built-in types: -- -- * 'timeGetDate' -- -- * 'timeGetDateTimeOfDay' -- -- * 'timeGetElapsed', 'timeGetElapsedP' timeConvert :: (Timeable t1, Time t2) => t1 -> t2 timeConvert t1 = timeFromElapsedP (timeGetElapsedP t1) {-# INLINE[2] timeConvert #-} {-# RULES "timeConvert/ID" timeConvert = id #-} {-# RULES "timeConvert/ElapsedP" timeConvert = timeGetElapsedP #-} {-# RULES "timeConvert/Elapsed" timeConvert = timeGetElapsed #-} -- | Get the calendar Date (year-month-day) from a time representation -- -- specialization of 'timeConvert' timeGetDate :: Timeable t => t -> Date timeGetDate t = d where (DateTime d _) = timeGetDateTimeOfDay t {-# INLINE[2] timeGetDate #-} {-# RULES "timeGetDate/ID" timeGetDate = id #-} {-# RULES "timeGetDate/DateTime" timeGetDate = dtDate #-} -- | Get the day time (hours:minutes:seconds) from a time representation -- -- specialization of 'timeConvert' timeGetTimeOfDay :: Timeable t => t -> TimeOfDay timeGetTimeOfDay t = tod where (DateTime _ tod) = timeGetDateTimeOfDay t {-# INLINE[2] timeGetTimeOfDay #-} {-# RULES "timeGetTimeOfDay/Date" timeGetTimeOfDay = const (TimeOfDay 0 0 0 0) #-} {-# RULES "timeGetTimeOfDay/DateTime" timeGetTimeOfDay = dtTime #-} -- | Get the date and time of day from a time representation -- -- specialization of 'timeConvert' timeGetDateTimeOfDay :: Timeable t => t -> DateTime timeGetDateTimeOfDay t = dateTimeFromUnixEpochP $ timeGetElapsedP t {-# INLINE[2] timeGetDateTimeOfDay #-} {-# RULES "timeGetDateTimeOfDay/ID" timeGetDateTimeOfDay = id #-} {-# RULES "timeGetDateTimeOfDay/Date" timeGetDateTimeOfDay = flip DateTime (TimeOfDay 0 0 0 0) #-} -- | add some time interval to a time representation and returns this new time representation -- -- example: -- -- > t1 `timeAdd` mempty { durationHours = 12 } timeAdd :: (Time t, TimeInterval ti) => t -> ti -> t timeAdd t ti = timeFromElapsedP $ elapsedTimeAddSecondsP (timeGetElapsedP t) (toSeconds ti) -- | Get the difference in seconds between two time representation -- -- effectively: -- -- > t2 `timeDiff` t1 = t2 - t1 timeDiff :: (Timeable t1, Timeable t2) => t1 -> t2 -> Seconds timeDiff t1 t2 = sec where (Elapsed sec) = timeGetElapsed t1 - timeGetElapsed t2 -- | Get the difference in seconds and nanoseconds between two time representation -- -- effectively: -- -- > @t2 `timeDiffP` t1 = t2 - t1 timeDiffP :: (Timeable t1, Timeable t2) => t1 -> t2 -> (Seconds, NanoSeconds) timeDiffP t1 t2 = (sec, ns) where (ElapsedP (Elapsed sec) ns) = timeGetElapsedP t1 - timeGetElapsedP t2 hourglass-0.2.12/Data/Hourglass/Format.hs0000644000000000000000000004444113340057345016410 0ustar0000000000000000-- | -- Module : Data.Hourglass.Format -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- Time formatting : printing and parsing -- -- Built-in format strings -- {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeSynonymInstances #-} module Data.Hourglass.Format ( -- * Parsing and Printing -- ** Format strings TimeFormatElem(..) , TimeFormatFct(..) , TimeFormatString(..) , TimeFormat(..) -- ** Common built-in formats , ISO8601_Date(..) , ISO8601_DateAndTime(..) -- ** Format methods , timePrint , timeParse , timeParseE , localTimePrint , localTimeParse , localTimeParseE ) where import Data.Hourglass.Types import Data.Hourglass.Time import Data.Hourglass.Calendar import Data.Hourglass.Local import Data.Hourglass.Utils import Data.Char (isDigit, ord) import Data.Int -- | All the various formatter that can be part -- of a time format string data TimeFormatElem = Format_Year2 -- ^ 2 digit years (70 is 1970, 69 is 2069) | Format_Year4 -- ^ 4 digits years | Format_Year -- ^ any digits years | Format_Month -- ^ months (1 to 12) | Format_Month2 -- ^ months padded to 2 chars (01 to 12) | Format_MonthName_Short -- ^ name of the month short ('Jan', 'Feb' ..) | Format_DayYear -- ^ day of the year (1 to 365, 366 for leap years) | Format_Day -- ^ day of the month (1 to 31) | Format_Day2 -- ^ day of the month (01 to 31) | Format_Hour -- ^ hours (0 to 23) | Format_Minute -- ^ minutes (0 to 59) | Format_Second -- ^ seconds (0 to 59, 60 for leap seconds) | Format_UnixSecond -- ^ number of seconds since 1 jan 1970. unix epoch. | Format_MilliSecond -- ^ Milliseconds (000 to 999) | Format_MicroSecond -- ^ MicroSeconds (000000 to 999999) | Format_NanoSecond -- ^ NanoSeconds (000000000 to 999999999) | Format_Precision Int -- ^ sub seconds display with a precision of N digits. with N between 1 and 9 | Format_TimezoneName -- ^ timezone name (e.g. GMT, PST). not implemented yet -- | Format_TimezoneOffset -- ^ timeoffset offset (+02:00) | Format_TzHM_Colon_Z -- ^ zero UTC offset (Z) or timeoffset with colon (+02:00) | Format_TzHM_Colon -- ^ timeoffset offset with colon (+02:00) | Format_TzHM -- ^ timeoffset offset (+0200) | Format_Tz_Offset -- ^ timeoffset in minutes | Format_Spaces -- ^ one or many space-like chars | Format_Text Char -- ^ a verbatim char | Format_Fct TimeFormatFct deriving (Show,Eq) -- | A generic format function composed of a parser and a printer. data TimeFormatFct = TimeFormatFct { timeFormatFctName :: String , timeFormatParse :: DateTime -> String -> Either String (DateTime, String) , timeFormatPrint :: DateTime -> String } instance Show TimeFormatFct where show = timeFormatFctName instance Eq TimeFormatFct where t1 == t2 = timeFormatFctName t1 == timeFormatFctName t2 -- | A time format string, composed of list of 'TimeFormatElem' newtype TimeFormatString = TimeFormatString [TimeFormatElem] deriving (Show,Eq) -- | A generic class for anything that can be considered a Time Format string. class TimeFormat format where toFormat :: format -> TimeFormatString -- | ISO8601 Date format string. -- -- e.g. 2014-04-05 data ISO8601_Date = ISO8601_Date deriving (Show,Eq) -- | ISO8601 Date and Time format string. -- -- e.g. 2014-04-05T17:25:04+00:00 -- 2014-04-05T17:25:04Z data ISO8601_DateAndTime = ISO8601_DateAndTime deriving (Show,Eq) instance TimeFormat [TimeFormatElem] where toFormat = TimeFormatString instance TimeFormat TimeFormatString where toFormat = id instance TimeFormat String where toFormat = TimeFormatString . toFormatElem where toFormatElem [] = [] toFormatElem ('Y':'Y':'Y':'Y':r) = Format_Year4 : toFormatElem r toFormatElem ('Y':'Y':r) = Format_Year2 : toFormatElem r toFormatElem ('M':'M':r) = Format_Month2 : toFormatElem r toFormatElem ('M':'o':'n':r) = Format_MonthName_Short : toFormatElem r toFormatElem ('M':'I':r) = Format_Minute : toFormatElem r toFormatElem ('M':r) = Format_Month : toFormatElem r toFormatElem ('D':'D':r) = Format_Day2 : toFormatElem r toFormatElem ('H':r) = Format_Hour : toFormatElem r toFormatElem ('S':r) = Format_Second : toFormatElem r toFormatElem ('m':'s':r) = Format_MilliSecond : toFormatElem r toFormatElem ('u':'s':r) = Format_MicroSecond : toFormatElem r toFormatElem ('μ':r) = Format_MicroSecond : toFormatElem r toFormatElem ('n':'s':r) = Format_NanoSecond : toFormatElem r toFormatElem ('p':'1':r) = Format_Precision 1 : toFormatElem r toFormatElem ('p':'2':r) = Format_Precision 2 : toFormatElem r toFormatElem ('p':'3':r) = Format_Precision 3 : toFormatElem r toFormatElem ('p':'4':r) = Format_Precision 4 : toFormatElem r toFormatElem ('p':'5':r) = Format_Precision 5 : toFormatElem r toFormatElem ('p':'6':r) = Format_Precision 6 : toFormatElem r toFormatElem ('p':'7':r) = Format_Precision 7 : toFormatElem r toFormatElem ('p':'8':r) = Format_Precision 8 : toFormatElem r toFormatElem ('p':'9':r) = Format_Precision 9 : toFormatElem r ----------------------------------------------------------- toFormatElem ('E':'P':'O':'C':'H':r) = Format_UnixSecond : toFormatElem r ----------------------------------------------------------- toFormatElem ('T':'Z':'H':'M':r) = Format_TzHM : toFormatElem r toFormatElem ('T':'Z':'H':':':'M':r) = Format_TzHM_Colon : toFormatElem r toFormatElem ('T':'Z':'O':'F':'S':r) = Format_Tz_Offset : toFormatElem r ----------------------------------------------------------- toFormatElem ('\\':c:r) = Format_Text c : toFormatElem r toFormatElem (' ':r) = Format_Spaces : toFormatElem r toFormatElem (c:r) = Format_Text c : toFormatElem r instance TimeFormat ISO8601_Date where toFormat _ = TimeFormatString [Format_Year,dash,Format_Month2,dash,Format_Day2] where dash = Format_Text '-' instance TimeFormat ISO8601_DateAndTime where toFormat _ = TimeFormatString [Format_Year,dash,Format_Month2,dash,Format_Day2 -- date ,Format_Text 'T' ,Format_Hour,colon,Format_Minute,colon,Format_Second -- time ,Format_TzHM_Colon_Z -- zero UTC offset (Z) or timezone offset with colon +HH:MM ] where dash = Format_Text '-' colon = Format_Text ':' monthFromShort :: String -> Either String Month monthFromShort str = case str of "Jan" -> Right January "Feb" -> Right February "Mar" -> Right March "Apr" -> Right April "May" -> Right May "Jun" -> Right June "Jul" -> Right July "Aug" -> Right August "Sep" -> Right September "Oct" -> Right October "Nov" -> Right November "Dec" -> Right December _ -> Left $ "unknown month: " ++ str printWith :: (TimeFormat format, Timeable t) => format -> TimezoneOffset -> t -> String printWith fmt tzOfs@(TimezoneOffset tz) t = concatMap fmtToString fmtElems where fmtToString Format_Year = show (dateYear date) fmtToString Format_Year4 = pad4 (dateYear date) fmtToString Format_Year2 = pad2 (dateYear date-1900) fmtToString Format_Month2 = pad2 (fromEnum (dateMonth date)+1) fmtToString Format_Month = show (fromEnum (dateMonth date)+1) fmtToString Format_MonthName_Short = take 3 $ show (dateMonth date) fmtToString Format_Day2 = pad2 (dateDay date) fmtToString Format_Day = show (dateDay date) fmtToString Format_Hour = pad2 (fromIntegral (todHour tm) :: Int) fmtToString Format_Minute = pad2 (fromIntegral (todMin tm) :: Int) fmtToString Format_Second = pad2 (fromIntegral (todSec tm) :: Int) fmtToString Format_MilliSecond = padN 3 (ns `div` 1000000) fmtToString Format_MicroSecond = padN 3 ((ns `div` 1000) `mod` 1000) fmtToString Format_NanoSecond = padN 3 (ns `mod` 1000) fmtToString (Format_Precision n) | n >= 1 && n <= 9 = padN n (ns `div` (10 ^ (9 - n))) | otherwise = error "invalid precision format" fmtToString Format_UnixSecond = show unixSecs fmtToString Format_TimezoneName = "" -- fmtToString Format_Tz_Offset = show tz fmtToString Format_TzHM = show tzOfs fmtToString Format_TzHM_Colon_Z | tz == 0 = "Z" | otherwise = fmtToString Format_TzHM_Colon fmtToString Format_TzHM_Colon = let (tzH, tzM) = abs tz `divMod` 60 sign = if tz < 0 then "-" else "+" in sign ++ pad2 tzH ++ ":" ++ pad2 tzM fmtToString Format_Spaces = " " fmtToString (Format_Text c) = [c] fmtToString f = error ("implemented printing format: " ++ show f) (TimeFormatString fmtElems) = toFormat fmt (Elapsed (Seconds unixSecs)) = timeGetElapsed t (DateTime date tm) = timeGetDateTimeOfDay t (NanoSeconds ns) = timeGetNanoSeconds t -- | Pretty print local time to a string. -- -- The actual output is determined by the format used. localTimePrint :: (TimeFormat format, Timeable t) => format -- ^ the format to use for printing -> LocalTime t -- ^ the local time to print -> String -- ^ the resulting local time string localTimePrint fmt lt = localTimeUnwrap $ fmap (printWith fmt (localTimeGetTimezone lt)) lt -- | Pretty print time to a string -- -- The actual output is determined by the format used timePrint :: (TimeFormat format, Timeable t) => format -- ^ the format to use for printing -> t -- ^ the global time to print -> String -- ^ the resulting string timePrint fmt t = printWith fmt timezone_UTC t -- | Try parsing a string as time using the format explicitely specified -- -- On failure, the parsing function returns the reason of the failure. -- If parsing is successful, return the date parsed with the remaining unparsed string localTimeParseE :: TimeFormat format => format -- ^ the format to use for parsing -> String -- ^ the string to parse -> Either (TimeFormatElem, String) (LocalTime DateTime, String) localTimeParseE fmt timeString = loop ini fmtElems timeString where (TimeFormatString fmtElems) = toFormat fmt toLocal (dt, tz) = localTime tz dt loop acc [] s = Right (toLocal acc, s) loop _ (x:_) [] = Left (x, "empty") loop acc (x:xs) s = case processOne acc x s of Left err -> Left (x, err) Right (nacc, s') -> loop nacc xs s' processOne _ _ [] = Left "empty" processOne acc (Format_Text c) (x:xs) | c == x = Right (acc, xs) | otherwise = Left ("unexpected char, got: " ++ show c) processOne acc Format_Year s = onSuccess (\y -> modDate (setYear y) acc) $ isNumber s processOne acc Format_Year4 s = onSuccess (\y -> modDate (setYear y) acc) $ getNDigitNum 4 s processOne acc Format_Year2 s = onSuccess (\y -> let year = if y < 70 then y + 2000 else y + 1900 in modDate (setYear year) acc) $ getNDigitNum 2 s processOne acc Format_Month2 s = onSuccess (\m -> modDate (setMonth $ toEnum ((fromIntegral m - 1) `mod` 12)) acc) $ getNDigitNum 2 s processOne acc Format_MonthName_Short s = onSuccess (\m -> modDate (setMonth m) acc) $ getMonth s processOne acc Format_Day2 s = onSuccess (\d -> modDate (setDay d) acc) $ getNDigitNum 2 s processOne acc Format_Hour s = onSuccess (\h -> modTime (setHour h) acc) $ getNDigitNum 2 s processOne acc Format_Minute s = onSuccess (\mi -> modTime (setMin mi) acc) $ getNDigitNum 2 s processOne acc Format_Second s = onSuccess (\sec -> modTime (setSec sec) acc) $ getNDigitNum 2 s processOne acc Format_MilliSecond s = onSuccess (\ms -> modTime (setNsMask (6,3) ms) acc) $ getNDigitNum 3 s processOne acc Format_MicroSecond s = onSuccess (\us -> modTime (setNsMask (3,3) us) acc) $ getNDigitNum 3 s processOne acc Format_NanoSecond s = onSuccess (\ns -> modTime (setNsMask (0,3) ns) acc) $ getNDigitNum 3 s processOne acc (Format_Precision p) s = onSuccess (\num -> modTime (setNS num) acc) $ getNDigitNum p s processOne acc Format_UnixSecond s = onSuccess (\sec -> let newDate = dateTimeFromUnixEpochP $ flip ElapsedP 0 $ Elapsed $ Seconds sec in modDT (const newDate) acc) $ isNumber s processOne acc Format_TzHM_Colon_Z a@(c:s) | c == 'Z' = Right (acc, s) | otherwise = processOne acc Format_TzHM_Colon a processOne acc Format_TzHM_Colon (c:s) = parseHMSign True acc c s processOne acc Format_TzHM (c:s) = parseHMSign False acc c s processOne acc Format_Spaces (' ':s) = Right (acc, s) -- catch all for unimplemented format. processOne _ f _ = error ("unimplemened parsing format: " ++ show f) parseHMSign expectColon acc signChar afterSign = case signChar of '+' -> parseHM False expectColon afterSign acc '-' -> parseHM True expectColon afterSign acc _ -> parseHM False expectColon (signChar:afterSign) acc parseHM isNeg True (h1:h2:':':m1:m2:xs) acc | allDigits [h1,h2,m1,m2] = let tz = toTZ isNeg h1 h2 m1 m2 in Right (modTZ (const tz) acc, xs) | otherwise = Left ("not digits chars: " ++ show [h1,h2,m1,m2]) parseHM isNeg False (h1:h2:m1:m2:xs) acc | allDigits [h1,h2,m1,m2] = let tz = toTZ isNeg h1 h2 m1 m2 in Right (modTZ (const tz) acc, xs) | otherwise = Left ("not digits chars: " ++ show [h1,h2,m1,m2]) parseHM _ _ _ _ = Left "invalid timezone format" toTZ isNeg h1 h2 m1 m2 = TimezoneOffset ((if isNeg then negate else id) minutes) where minutes = (toInt [h1,h2] * 60) + toInt [m1,m2] onSuccess f (Right (v, s')) = Right (f v, s') onSuccess _ (Left s) = Left s isNumber :: Num a => String -> Either String (a, String) isNumber s = case span isDigit s of ("",s2) -> Left ("no digits chars:" ++ s2) (s1,s2) -> Right (toInt s1, s2) getNDigitNum :: Int -> String -> Either String (Int64, String) getNDigitNum n s = case getNChar n s of Left err -> Left err Right (s1, s2) | not (allDigits s1) -> Left ("not a digit chars in " ++ show s1) | otherwise -> Right (toInt s1, s2) getMonth :: String -> Either String (Month, String) getMonth s = getNChar 3 s >>= \(s1, s2) -> monthFromShort s1 >>= \m -> Right (m, s2) getNChar :: Int -> String -> Either String (String, String) getNChar n s | length s1 < n = Left ("not enough chars: expecting " ++ show n ++ " got " ++ show s1) | otherwise = Right (s1, s2) where (s1, s2) = splitAt n s toInt :: Num a => String -> a toInt = foldl (\acc w -> acc * 10 + fromIntegral (ord w - ord '0')) 0 allDigits = and . map isDigit ini = (DateTime (Date 0 (toEnum 0) 0) (TimeOfDay 0 0 0 0), TimezoneOffset 0) modDT f (dt, tz) = (f dt, tz) modDate f (DateTime d tp, tz) = (DateTime (f d) tp, tz) modTime f (DateTime d tp, tz) = (DateTime d (f tp), tz) modTZ f (dt, tz) = (dt, f tz) setYear :: Int64 -> Date -> Date setYear y (Date _ m d) = Date (fromIntegral y) m d setMonth m (Date y _ d) = Date y m d setDay d (Date y m _) = Date y m (fromIntegral d) setHour h (TimeOfDay _ m s ns) = TimeOfDay (Hours h) m s ns setMin m (TimeOfDay h _ s ns) = TimeOfDay h (Minutes m) s ns setSec s (TimeOfDay h m _ ns) = TimeOfDay h m (Seconds s) ns setNS v (TimeOfDay h m s _ ) = TimeOfDay h m s (NanoSeconds v) setNsMask :: (Int, Int) -> Int64 -> TimeOfDay -> TimeOfDay setNsMask (shift, mask) val (TimeOfDay h mins seconds (NanoSeconds ns)) = let (nsD,keepL) = ns `divMod` s (keepH,_) = nsD `divMod` m v = ((keepH * m + fromIntegral val) * s) + keepL in TimeOfDay h mins seconds (NanoSeconds v) where s = 10 ^ shift m = 10 ^ mask -- | Try parsing a string as time using the format explicitely specified -- -- Unparsed characters are ignored and the error handling is simplified -- -- for more elaborate need use 'localTimeParseE'. localTimeParse :: TimeFormat format => format -- ^ the format to use for parsing -> String -- ^ the string to parse -> Maybe (LocalTime DateTime) localTimeParse fmt s = either (const Nothing) (Just . fst) $ localTimeParseE fmt s -- | like 'localTimeParseE' but the time value is automatically converted to global time. timeParseE :: TimeFormat format => format -> String -> Either (TimeFormatElem, String) (DateTime, String) timeParseE fmt timeString = either Left (\(d,s) -> Right (localTimeToGlobal d, s)) $ localTimeParseE fmt timeString -- | Just like 'localTimeParse' but the time is automatically converted to global time. timeParse :: TimeFormat format => format -> String -> Maybe DateTime timeParse fmt s = localTimeToGlobal `fmap` localTimeParse fmt s hourglass-0.2.12/Data/Hourglass/Diff.hs0000644000000000000000000001273013340057345016024 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} -- | -- Module : Data.Hourglass.Diff -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- time arithmetic methods -- 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 -- | An amount of conceptual calendar time in terms of years, months and days. -- -- This allow calendar manipulation, representing things like days and months -- irrespective on how long those are related to timezone and daylight changes. -- -- See 'Duration' for the time-based equivalent to this class. 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) -- | An amount of time in terms of constant value like hours (3600 seconds), -- minutes (60 seconds), seconds and nanoseconds. data Duration = Duration { durationHours :: !Hours -- ^ number of hours , durationMinutes :: !Minutes -- ^ number of minutes , durationSeconds :: !Seconds -- ^ number of seconds , durationNs :: !NanoSeconds -- ^ number of 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 -- | Flatten a duration to a number of seconds, nanoseconds 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 -- | Normalize all fields to represent the same value -- with the biggest units possible. -- -- For example, 62 minutes is normalized as 1h 2minutes 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 -- | add a period of time to a date 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) -- | Add a number of seconds to an Elapsed type elapsedTimeAddSeconds :: Elapsed -> Seconds -> Elapsed elapsedTimeAddSeconds (Elapsed s1) s2 = Elapsed (s1+s2) -- | Add a number of seconds to an ElapsedP type elapsedTimeAddSecondsP :: ElapsedP -> Seconds -> ElapsedP elapsedTimeAddSecondsP (ElapsedP (Elapsed s1) ns1) s2 = ElapsedP (Elapsed (s1+s2)) ns1 {- disabled for warning purpose. to be implemented -- | Duration string to time diff -- -- -- -- * P is the duration designator (historically called "period") placed at the start of the duration representation. -- -- * Y is the year designator that follows the value for the number of years. -- -- * M is the month designator that follows the value for the number of months. -- -- * W is the week designator that follows the value for the number of weeks. -- -- * D is the day designator that follows the value for the number of days. -- -- * T is the time designator that precedes the time components of the representation. -- -- * H is the hour designator that follows the value for the number of hours. -- -- * M is the minute designator that follows the value for the number of minutes. -- -- * S is the second designator that follows the value for the number of seconds. -- timeDiffFromDuration :: String -> TimeDiff timeDiffFromDuration _ = undefined timeDiffFromString :: String -> ( -- | Human description string to time diff -- -- examples: -- -- * "1 day" -- -- * "2 months, 5 days and 1 second" -- timeDiffFromDescription :: String -> TimeDiff timeDiffFromDescription _ = undefined -} hourglass-0.2.12/Data/Hourglass/Local.hs0000644000000000000000000000601713340057345016207 0ustar0000000000000000-- | -- Module : Data.Hourglass.Local -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- Local time = global time + timezone -- {-# LANGUAGE FlexibleInstances #-} module Data.Hourglass.Local ( -- * Local time -- ** Local time type LocalTime -- ** Local time creation and manipulation , localTime , localTimeUnwrap , localTimeToGlobal , localTimeFromGlobal , localTimeGetTimezone , localTimeSetTimezone , localTimeConvert ) where import Data.Hourglass.Types import Data.Hourglass.Time import Data.Hourglass.Diff -- | Local time representation -- -- this is a time representation augmented by a timezone -- to get back to a global time, the timezoneOffset needed to be added to the local time. -- data LocalTime t = LocalTime { localTimeUnwrap :: t -- ^ unwrap the LocalTime value. the time value is local. , localTimeGetTimezone :: TimezoneOffset -- ^ get the timezone associated with LocalTime } -- FIXME add instance Read too. instance Show t => Show (LocalTime t) where show (LocalTime t tz) = show t ++ show tz instance Eq t => Eq (LocalTime t) where LocalTime t1 tz1 == LocalTime t2 tz2 = tz1 == tz2 && t1 == t2 instance (Ord t, Time t) => Ord (LocalTime t) where compare l1@(LocalTime g1 tz1) l2@(LocalTime g2 tz2) = case compare tz1 tz2 of EQ -> compare g1 g2 _ -> let t1 = localTimeToGlobal l1 t2 = localTimeToGlobal l2 in compare t1 t2 instance Functor LocalTime where fmap f (LocalTime t tz) = LocalTime (f t) tz -- | Create a local time type from a timezone and a time type. -- -- The time value is assumed to be local to the timezone offset set, -- so no transformation is done. localTime :: Time t => TimezoneOffset -> t -> LocalTime t localTime tz t = LocalTime t tz -- | Get back a global time value localTimeToGlobal :: Time t => LocalTime t -> t localTimeToGlobal (LocalTime local tz) | tz == TimezoneOffset 0 = local | otherwise = timeConvert $ elapsedTimeAddSecondsP (timeGetElapsedP local) tzSecs where tzSecs = negate $ timezoneOffsetToSeconds tz -- | create a local time value from a global one localTimeFromGlobal :: Time t => t -> LocalTime t localTimeFromGlobal = localTime (TimezoneOffset 0) -- | Change the timezone, and adjust the local value to represent the new local value. localTimeSetTimezone :: Time t => TimezoneOffset -> LocalTime t -> LocalTime t localTimeSetTimezone tz currentLocal@(LocalTime t currentTz) | diffTz == 0 = currentLocal | otherwise = LocalTime (timeConvert t') tz where t' = elapsedTimeAddSecondsP (timeGetElapsedP t) diffTz diffTz = timezoneOffsetToSeconds tz - timezoneOffsetToSeconds currentTz -- | convert the local time representation to another time representation determined by context. localTimeConvert :: (Time t1, Time t2) => LocalTime t1 -> LocalTime t2 localTimeConvert = fmap timeConvert hourglass-0.2.12/Data/Hourglass/Calendar.hs0000644000000000000000000000555613340057345016675 0ustar0000000000000000-- | -- Module : Data.Hourglass.Calendar -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- Misc calendar functions -- module Data.Hourglass.Calendar ( isLeapYear , getWeekDay , getDayOfTheYear , daysInMonth , dateToUnixEpoch , dateFromUnixEpoch , todToSeconds , dateTimeToUnixEpoch , dateTimeFromUnixEpoch , dateTimeFromUnixEpochP ) where import Data.Hourglass.Types import Data.Hourglass.Internal -- | Return if this year is a leap year (366 days) -- or not (365 days in a year) isLeapYear :: Int -> Bool isLeapYear year | year `mod` 4 /= 0 = False | year `mod` 100 /= 0 = True | year `mod` 400 == 0 = True | otherwise = False -- | Return the day of the week a specific date fall in getWeekDay :: Date -> WeekDay getWeekDay date = toEnum (d `mod` 7) where d = daysOfDate date -- | return the number of days until the beggining of the month specified for a specific year. daysUntilMonth :: Int -> Month -> Int daysUntilMonth y m | isLeapYear y = leapYears !! fromEnum m | otherwise = normalYears !! fromEnum m where normalYears = [ 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 ] leapYears = [ 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366 ] -- | Return the number of days in a month. daysInMonth :: Int -> Month -> Int daysInMonth y m | m == February && isLeapYear y = 29 | otherwise = days !! fromEnum m where days = [31,28,31,30,31,30,31,31,30,31,30,31] -- | return the day of the year where Jan 1 is 0 -- -- between 0 and 364. 365 for leap years getDayOfTheYear :: Date -> Int getDayOfTheYear (Date y m d) = daysUntilMonth y m + d -- | return the number of days before Jan 1st of the year daysBeforeYear :: Int -> Int daysBeforeYear year = y * 365 + (y `div` 4) - (y `div` 100) + (y `div` 400) where y = year - 1 -- | Return the number of day since 1 january 1 daysOfDate :: Date -> Int daysOfDate (Date y m d) = daysBeforeYear y + daysUntilMonth y m + d -- | Return the number of seconds to unix epoch of a date considering hour=0,minute=0,second=0 dateToUnixEpoch :: Date -> Elapsed dateToUnixEpoch date = Elapsed $ Seconds (fromIntegral (daysOfDate date - epochDays) * secondsPerDay) where epochDays = 719163 secondsPerDay = 86400 -- julian day is 24h -- | Return the Date associated with the unix epoch dateFromUnixEpoch :: Elapsed -> Date dateFromUnixEpoch e = dtDate $ dateTimeFromUnixEpoch e -- | Return the number of seconds from a time structure todToSeconds :: TimeOfDay -> Seconds todToSeconds (TimeOfDay h m s _) = toSeconds h + toSeconds m + s -- | Return the number of seconds to unix epoch of a date time dateTimeToUnixEpoch :: DateTime -> Elapsed dateTimeToUnixEpoch (DateTime d t) = dateToUnixEpoch d + Elapsed (todToSeconds t) hourglass-0.2.12/Data/Hourglass/Zone.hs0000644000000000000000000000271313340057345016067 0ustar0000000000000000-- | -- Module : Data.Hourglass.Zone -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- Timezone utility -- {-# LANGUAGE ExistentialQuantification #-} module Data.Hourglass.Zone ( Timezone(..) , UTC(..) , TimezoneMinutes(..) ) where -- | standard representation for timezone class Timezone tz where -- | offset in minutes from UTC. valid values should be between -12*60 to +14*60 timezoneOffset :: tz -> Int -- | the name of the timezone. by default will be +-HH:MM encoding. timezoneName :: tz -> String timezoneName = tzMinutesPrint . timezoneOffset -- | Simple timezone containing the number of minutes difference -- with UTC. -- -- Valid values should be between -12*60 to +14*60 newtype TimezoneMinutes = TimezoneMinutes Int deriving (Show,Eq,Ord) -- | Universal Time Coordinated. The generic computer "timezone". data UTC = UTC deriving (Show,Eq,Ord) instance Timezone UTC where timezoneOffset _ = 0 timezoneName _ = "UTC" instance Timezone TimezoneMinutes where timezoneOffset (TimezoneMinutes minutes) = minutes -- | print a minute offset in format: -- (+-)HH:MM tzMinutesPrint :: Int -> String tzMinutesPrint offset = (if offset > 0 then '+' else '-') : (pad0 h ++ ":" ++ pad0 m) where (h,m) = abs offset `divMod` 60 pad0 v | v < 10 = '0':show v | otherwise = show v hourglass-0.2.12/Data/Hourglass/Internal.hs0000644000000000000000000000077413340057345016735 0ustar0000000000000000-- | -- Module : Data.Hourglass.Internal -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- System lowlevel functions -- {-# LANGUAGE CPP #-} module Data.Hourglass.Internal ( dateTimeFromUnixEpochP , dateTimeFromUnixEpoch , systemGetTimezone , systemGetElapsed , systemGetElapsedP ) where #ifdef WINDOWS import Data.Hourglass.Internal.Win #else import Data.Hourglass.Internal.Unix #endif hourglass-0.2.12/Data/Hourglass/Utils.hs0000644000000000000000000000171213340057345016252 0ustar0000000000000000-- | -- Module : Data.Hourglass.Utils -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- some padding / formatting functions -- module Data.Hourglass.Utils where -- | pad a number to 2 digits pad2 :: (Show a, Ord a, Num a, Integral a) => a -> String pad2 v | v >= 100 = pad2 (v `mod` 100) | v >= 10 = show v | otherwise = '0' : show v -- | pad a number to 4 digits pad4 :: (Show a, Ord a, Num a, Integral a) => a -> String pad4 v | v >= 1000 = show v | v >= 100 = '0' : show v | v >= 10 = '0':'0' : show v | otherwise = '0':'0':'0': show v -- | Pad a number to at least N digits. -- -- if the number is greater, no truncation happens. padN :: (Show a, Ord a, Num a, Integral a) => Int -> a -> String padN n v | vlen >= n = vs | otherwise = replicate (n - vlen) '0' ++ vs where vs = show v vlen = length vs hourglass-0.2.12/Data/Hourglass/Internal/Win.hs0000644000000000000000000000540513340057345017466 0ustar0000000000000000-- | -- Module : Data.Hourglass.Internal.Win -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- Time lowlevel helpers binding to Windows -- {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE CPP #-} module Data.Hourglass.Internal.Win ( dateTimeFromUnixEpochP , dateTimeFromUnixEpoch , systemGetTimezone , systemGetElapsed , systemGetElapsedP ) where import System.IO.Unsafe import System.Win32.Time import Data.Hourglass.Types import Data.Int (Int64) unixDiff :: Int64 unixDiff = 11644473600 toFileTime :: Elapsed -> FILETIME toFileTime (Elapsed (Seconds s)) = FILETIME val where val = fromIntegral (s + unixDiff) * 10000000 toElapsedP :: FILETIME -> ElapsedP toElapsedP (FILETIME w) = ElapsedP (Elapsed $ Seconds s) (NanoSeconds ns) where (sWin, hundredNs) = w `divMod` 10000000 ns = fromIntegral (hundredNs * 100) s = fromIntegral sWin - unixDiff toElapsed :: FILETIME -> Elapsed toElapsed (FILETIME w) = Elapsed (Seconds s) where s = fromIntegral (fst (w `divMod` 10000000)) - unixDiff callSystemTime :: Elapsed -> SYSTEMTIME callSystemTime e = unsafePerformIO (fileTimeToSystemTime (toFileTime e)) {-# NOINLINE callSystemTime #-} dateTimeFromUnixEpochP :: ElapsedP -> DateTime dateTimeFromUnixEpochP (ElapsedP e ns) = toDateTime $ callSystemTime e where toDateTime (SYSTEMTIME wY wM _ wD wH wMin wS _) = DateTime (Date (fi wY) (toEnum $ fi $ wM - 1) (fi wD)) (TimeOfDay (fi wH) (fi wMin) (fi wS) ns) fi :: (Integral a, Num b) => a -> b fi = fromIntegral dateTimeFromUnixEpoch :: Elapsed -> DateTime dateTimeFromUnixEpoch e = toDateTime $ callSystemTime e where toDateTime (SYSTEMTIME wY wM _ wD wH wMin wS _) = DateTime (Date (fi wY) (toEnum $ fi $ wM - 1) (fi wD)) (TimeOfDay (fi wH) (fi wMin) (fi wS) 0) fi :: (Integral a, Num b) => a -> b fi = fromIntegral systemGetTimezone :: IO TimezoneOffset systemGetTimezone = do (tzMode,tzInfo) <- getTimeZoneInformation case tzMode of TzIdDaylight -> return $ toTO (tziBias tzInfo + tziDaylightBias tzInfo) TzIdStandard -> return $ toTO (tziBias tzInfo + tziStandardBias tzInfo) TzIdUnknown -> return $ toTO (tziBias tzInfo) where -- a negative value represent value how to go from local to UTC, -- whereas TimezoneOffset represent the offset to go from UTC to local. -- here we negate the bias to get the proper value represented. toTO = TimezoneOffset . fromIntegral . negate systemGetElapsedP :: IO ElapsedP systemGetElapsedP = toElapsedP `fmap` getSystemTimeAsFileTime systemGetElapsed :: IO Elapsed systemGetElapsed = toElapsed `fmap` getSystemTimeAsFileTime hourglass-0.2.12/Data/Hourglass/Internal/Unix.hs0000644000000000000000000001325413340057345017655 0ustar0000000000000000-- | -- Module : Data.Hourglass.Internal.Unix -- License : BSD-style -- Maintainer : Vincent Hanquez -- Stability : experimental -- Portability : unknown -- -- Time lowlevel helpers for the unix operating system -- -- depend on localtime_r and gmtime_r. -- Some obscure unix system might not support them. -- {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE CPP #-} {-# LANGUAGE EmptyDataDecls #-} module Data.Hourglass.Internal.Unix ( dateTimeFromUnixEpochP , dateTimeFromUnixEpoch , systemGetTimezone , systemGetElapsed , systemGetElapsedP ) where import Control.Applicative import Foreign.C.Types import Foreign.Storable import Foreign.Marshal.Alloc import Foreign.Ptr import Data.Hourglass.Types import System.IO.Unsafe -- | convert a unix epoch precise to DateTime dateTimeFromUnixEpochP :: ElapsedP -> DateTime dateTimeFromUnixEpochP (ElapsedP e ns) = fromCP ns $ rawGmTime e -- | convert a unix epoch to DateTime dateTimeFromUnixEpoch :: Elapsed -> DateTime dateTimeFromUnixEpoch e = fromC $ rawGmTime e -- | return the timezone offset in minutes systemGetTimezone :: IO TimezoneOffset systemGetTimezone = TimezoneOffset . fromIntegral . flip div 60 <$> localTime 0 ---------------------------------------------------------------------------------------- -- | return the current elapsedP systemGetElapsedP :: IO ElapsedP systemGetElapsedP = allocaBytesAligned sofTimespec 8 $ \ptr -> do c_clock_get ptr toElapsedP <$> peek (castPtr ptr) <*> peekByteOff (castPtr ptr) sofCTime where sofTimespec = sofCTime + sofCLong sofCTime = sizeOf (0 :: CTime) sofCLong = sizeOf (0 :: CLong) #if (MIN_VERSION_base(4,5,0)) toElapsedP :: CTime -> CLong -> ElapsedP toElapsedP (CTime sec) nsec = ElapsedP (Elapsed $ Seconds (fromIntegral sec)) (fromIntegral nsec) #else toElapsedP :: CLong -> CLong -> ElapsedP toElapsedP sec nsec = ElapsedP (Elapsed $ Seconds (fromIntegral sec)) (fromIntegral nsec) #endif -- | return the current elapsed systemGetElapsed :: IO Elapsed systemGetElapsed = allocaBytesAligned sofTimespec 8 $ \ptr -> do c_clock_get ptr toElapsed <$> peek (castPtr ptr) where sofTimespec = sizeOf (0 :: CTime) + sizeOf (0 :: CLong) #if (MIN_VERSION_base(4,5,0)) toElapsed :: CTime -> Elapsed toElapsed (CTime sec) = Elapsed $ Seconds (fromIntegral sec) #else toElapsed :: CLong -> Elapsed toElapsed sec = Elapsed $ Seconds (fromIntegral sec) #endif foreign import ccall unsafe "hourglass_clock_calendar" c_clock_get :: Ptr CLong -> IO () #if (MIN_VERSION_base(4,5,0)) foreign import ccall unsafe "gmtime_r" c_gmtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) foreign import ccall unsafe "localtime_r" c_localtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm) #else foreign import ccall unsafe "gmtime_r" c_gmtime_r :: Ptr CLong -> Ptr CTm -> IO (Ptr CTm) foreign import ccall unsafe "localtime_r" c_localtime_r :: Ptr CLong -> Ptr CTm -> IO (Ptr CTm) #endif -- | Return a global time's struct tm based on the number of elapsed second since unix epoch. rawGmTime :: Elapsed -> CTm rawGmTime (Elapsed (Seconds s)) = unsafePerformIO callTime where callTime = alloca $ \ctmPtr -> do alloca $ \ctimePtr -> do poke ctimePtr ctime r <- c_gmtime_r ctimePtr ctmPtr if r == nullPtr then error "gmTime failed" else peek ctmPtr ctime = fromIntegral s {-# NOINLINE rawGmTime #-} -- | Return a local time's gmtoff (seconds east of UTC) -- -- use the ill defined gmtoff (at offset 40) that might or might not be -- available for your platform. worst case scenario it's not initialized -- properly. localTime :: Elapsed -> IO CLong localTime (Elapsed (Seconds s)) = callTime where callTime = alloca $ \ctmPtr -> do alloca $ \ctimePtr -> do poke ctimePtr ctime r <- c_localtime_r ctimePtr ctmPtr if r == nullPtr then error "localTime failed" else peekByteOff ctmPtr 40 ctime = fromIntegral s -- | Represent the beginning of struct tm data CTm = CTm { ctmSec :: CInt , ctmMin :: CInt , ctmHour :: CInt , ctmMDay :: CInt , ctmMon :: CInt , ctmYear :: CInt } deriving (Show,Eq) -- | Convert a C structure to a DateTime structure fromC :: CTm -> DateTime fromC ctm = DateTime date time where date = Date { dateYear = fromIntegral $ ctmYear ctm + 1900 , dateMonth = toEnum $ fromIntegral $ ctmMon ctm , dateDay = fromIntegral $ ctmMDay ctm } time = TimeOfDay { todHour = fromIntegral $ ctmHour ctm , todMin = fromIntegral $ ctmMin ctm , todSec = fromIntegral $ ctmSec ctm , todNSec = 0 } -- | Similar to 'fromC' except with nanosecond precision fromCP :: NanoSeconds -> CTm -> DateTime fromCP ns ctm = DateTime d (t { todNSec = ns }) where (DateTime d t) = fromC ctm instance Storable CTm where alignment _ = 8 sizeOf _ = 60 -- account for 9 ints, alignment + 2 unsigned long at end. peek ptr = do CTm <$> peekByteOff intPtr 0 <*> peekByteOff intPtr 4 <*> peekByteOff intPtr 8 <*> peekByteOff intPtr 12 <*> peekByteOff intPtr 16 <*> peekByteOff intPtr 20 where intPtr = castPtr ptr poke ptr (CTm f0 f1 f2 f3 f4 f5) = do mapM_ (uncurry (pokeByteOff intPtr)) [(0,f0), (4,f1), (8,f2), (12,f3), (16,f4), (20,f5)] --pokeByteOff (castPtr ptr) 36 f9 where intPtr = castPtr ptr hourglass-0.2.12/cbits/unix.c0000644000000000000000000000151213340057345014227 0ustar0000000000000000/* * lowlevel binder for macosx and */ #include #if defined __MACH__ && !defined __GNU__ #include #include #endif /* on mac os X, clock_gettime doesn't exists, but * http://stackoverflow.com/questions/5167269/clock-gettime-alternative-in-mac-os-x * * we ignore errors as it's very very unlikely considering the hardcoded ID * and the fact that haskell should call this code. */ void hourglass_clock_calendar(struct timespec *timespec) { #if defined __MACH__ && !defined __GNU__ clock_serv_t cclock; mach_timespec_t mts; host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock); clock_get_time(cclock, &mts); mach_port_deallocate(mach_task_self(), cclock); timespec->tv_sec = mts.tv_sec; timespec->tv_nsec = mts.tv_nsec; #else clock_gettime(CLOCK_REALTIME, timespec); #endif } hourglass-0.2.12/tests/Tests.hs0000644000000000000000000002650013340057631014576 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} module Main where import Control.Applicative import Test.Tasty import Test.Tasty.QuickCheck import Test.Tasty.HUnit import Data.Ratio import Data.Word import Data.Int import Data.Hourglass import Data.Hourglass.Epoch import Foreign.Storable import Foreign.C.Types (CTime) import qualified Data.Time.Calendar as T import qualified Data.Time.Clock as T import qualified Data.Time.Clock.POSIX as T import qualified Data.Time.Format as T #if MIN_VERSION_time(1,5,0) import qualified System.Locale as T hiding (defaultTimeLocale) #else import qualified System.Locale as T #endif import qualified Control.Exception as E import TimeDB tmPosix0 :: Elapsed tmPosix0 = fromIntegral (0 :: Word64) timePosix0 :: T.POSIXTime timePosix0 = fromIntegral (0 :: Word64) elapsedToPosixTime :: Elapsed -> T.POSIXTime elapsedToPosixTime (Elapsed (Seconds s)) = fromIntegral s dateEqual :: LocalTime DateTime -> T.UTCTime -> Bool dateEqual localtime utcTime = and [ fromIntegral y == y', m' == (fromEnum m + 1), d' == d , fromIntegral h' == h, fromIntegral mi' == mi, sec' == sec ] where (y',m',d') = T.toGregorian (T.utctDay utcTime) daytime = floor $ T.utctDayTime utcTime (dt', sec')= daytime `divMod` 60 (h' , mi') = dt' `divMod` 60 (DateTime (Date y m d) (TimeOfDay h mi sec _)) = localTimeToGlobal localtime -- | The @Date@ type is able to represent some values that aren't actually legal, -- specifically dates with a day field outside of the range of dates in the -- month. This function validates a @Date@. isValidDate :: Date -> Bool isValidDate (Date y m d) = d > 0 && d <= (daysInMonth y m) -- windows native functions to convert time cannot handle time before year 1601 #ifdef WINDOWS loElapsed = -11644473600 -- ~ year 1601 hiElapsed = 32503680000 dateRange = (1800, 2202) #else isCTime64 = sizeOf (undefined :: CTime) == 8 loElapsed = if isCTime64 then -62135596800 -- ~ year 0 else -(2^(28 :: Int)) hiElapsed = if isCTime64 then 2^(55 :: Int) -- in a future far far away else 2^(29 :: Int) -- before the 2038 bug. dateRange = if isCTime64 then (1800, 2202) else (1960, 2036) #endif instance Arbitrary Seconds where arbitrary = Seconds . toHiLo <$> arbitrary where toHiLo v | v > loElapsed && v < hiElapsed = v | v > hiElapsed = v `mod` hiElapsed | v < loElapsed = v `mod` loElapsed | otherwise = error "internal error" instance Arbitrary Minutes where arbitrary = Minutes <$> choose (-1125899906842624, 1125899906842624) instance Arbitrary Hours where arbitrary = Hours <$> choose (-1125899906842, 1125899906842) instance Arbitrary NanoSeconds where arbitrary = NanoSeconds <$> choose (0, 100000000) instance Arbitrary Elapsed where arbitrary = Elapsed <$> arbitrary instance Arbitrary TimezoneOffset where arbitrary = TimezoneOffset <$> choose (-11*60,11*60) instance Arbitrary Duration where arbitrary = Duration <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary instance Arbitrary Period where arbitrary = Period <$> choose (-29,29) <*> choose (-27,27) <*> choose (-400,400) instance Arbitrary Month where arbitrary = elements [January ..] instance Arbitrary DateTime where arbitrary = DateTime <$> arbitrary <*> arbitrary instance Arbitrary Date where arbitrary = do year <- choose dateRange month <- arbitrary Date year month <$> choose (1, daysInMonth year month) instance Arbitrary TimeOfDay where arbitrary = TimeOfDay <$> (Hours <$> choose (0,23)) <*> (Minutes <$> choose (0,59)) <*> (Seconds <$> choose (0,59)) <*> arbitrary instance (Time t, Arbitrary t) => Arbitrary (LocalTime t) where arbitrary = localTime <$> arbitrary <*> arbitrary eq expected got | expected == got = True | otherwise = error ("expected: " ++ show expected ++ " got: " ++ show got) testCaseWith :: (Num a, Eq a, Show a) => String -> (a -> a -> a) -> (a, a, a) -> TestTree testCaseWith what fun (x, y, ref) = testCase ((show x) ++ " " ++ what ++ " " ++ (show y) ++ " ?= " ++ (show ref)) checkAdd where checkAdd :: Assertion checkAdd = if fun x y /= ref then assertFailure $ (show $ fun x y) ++ " /= " ++ (show ref) else return () arithmeticTestAddRef :: [(ElapsedP, ElapsedP, ElapsedP)] arithmeticTestAddRef = map testRefToElapsedP [ ((1, 090000000), (2, 090000000), (3, 180000000)) , ((1, 900000000), (1, 200000000), (3, 100000000)) , ((1, 000000001), (0, 999999999), (2, 000000000)) ] arithmeticTestSubRef :: [(ElapsedP, ElapsedP, ElapsedP)] arithmeticTestSubRef = map testRefToElapsedP [ ((1, ms 100), (1, ms 100), (0, ms 000)) , ((1, ms 900), (1, ms 100), (0, ms 800)) , ((1, ms 100), (0, ms 200), (0, ms 900)) , ((1, ms 100), (2, ms 400), (-2, ms 700)) ] where ms v = v * 1000000 testRefToElapsedP :: ((Int64, Int64), (Int64, Int64), (Int64, Int64)) -> (ElapsedP, ElapsedP, ElapsedP) testRefToElapsedP (a, b, c) = (tupleToElapsedP a, tupleToElapsedP b, tupleToElapsedP c) where tupleToElapsedP :: (Int64, Int64) -> ElapsedP tupleToElapsedP (s, n) = ElapsedP (Elapsed $ Seconds s) (NanoSeconds n) tests knowns = testGroup "hourglass" [ testGroup "known" [ testGroup "calendar conv" (map toCalendarTest $ zip eint (map tuple12 knowns)) , testGroup "seconds conv" (map toSecondTest $ zip eint (map tuple12 knowns)) , testGroup "weekday" (map toWeekDayTest $ zip eint (map tuple13 knowns)) ] , testGroup "conversion" [ testProperty "calendar" $ \(e :: Elapsed) -> e `eq` timeGetElapsed (timeGetDateTimeOfDay e) , testProperty "win epoch" $ \(e :: Elapsed) -> let e2 = timeConvert e :: ElapsedSince WindowsEpoch in timePrint ISO8601_DateAndTime e `eq` timePrint ISO8601_DateAndTime e2 ] , testGroup "localtime" [ testProperty "eq" $ \(l :: LocalTime Elapsed) -> let g = localTimeToGlobal l in l `eq` localTimeSetTimezone (localTimeGetTimezone l) (localTimeFromGlobal g) , testProperty "set" $ \(l :: LocalTime Elapsed, newTz) -> let l2 = localTimeSetTimezone newTz l in localTimeToGlobal l `eq` localTimeToGlobal l2 ] , testGroup "arithmetic" [ testGroup "ElapseP add" $ map (testCaseWith "+" (+)) arithmeticTestAddRef , testGroup "ElapseP sub" $ map (testCaseWith "-" (-)) arithmeticTestSubRef {-testProperty "add-diff" $ \(e :: Elapsed, tdiff) -> let d@(TimeDiff _ _ day h mi s _) = tdiff { timeDiffYears = 0 , timeDiffMonths = 0 , timeDiffNs = 0 } i64 = fromIntegral accSecs = (((i64 day * 24) + i64 h) * 60 + i64 mi) * 60 + i64 s :: Int64 e' = timeAdd e d in Seconds accSecs `eq` timeDiff e' e , testProperty "calendar-add-month" $ \date@(DateTime (Date y m d) _) -> let date'@(DateTime (Date y' m' d') _) = timeAdd date (mempty { timeDiffMonths = 1 }) in timeGetTimeOfDay date `eq` timeGetTimeOfDay date' && (d `eq` d') && (toEnum ((fromEnum m+1) `mod` 12) `eq` m') && (if m == December then (y+1) `eq` y' else y `eq` y') -} -- Make sure our Arbitrary instance only generates valid dates: , testProperty "Arbitrary-isValidDate" isValidDate , testProperty "dateAddPeriod" $ (\date period -> isValidDate (date `dateAddPeriod` period)) ] , testGroup "formating" [ testProperty "iso8601 date" $ \(e :: Elapsed) -> (calTimeFormatTimeISO8601 (elapsedToPosixTime e) `eq` timePrint ISO8601_Date e) , testProperty "unix seconds" $ \(e :: Elapsed) -> let sTime = T.formatTime T.defaultTimeLocale "%s" (T.posixSecondsToUTCTime $ elapsedToPosixTime e) sHg = timePrint "EPOCH" e in sTime `eq` sHg ] , testGroup "parsing" [ testProperty "iso8601 date" $ \(e :: Elapsed) -> let fmt = calTimeFormatTimeISO8601 (elapsedToPosixTime e) ed1 = localTimeParseE ISO8601_Date fmt md2 = T.parseTime T.defaultTimeLocale fmt "%F" in case (ed1,md2) of (Left err, Nothing) -> error ("both cannot parse: " ++ show fmt ++ " hourglass-err=" ++ show err) (Left err, Just _) -> error ("error parsing string: " ++ show err) (Right (d1, ""), Just d2) -> dateEqual d1 d2 (Right (_,_), Nothing) -> True -- let (LocalTime tparsed _) = r in error ("time cannot parse: " ++ show tparsed ++ " " ++ fmt) (Right (_, rm), _) -> error ("remaining string after parse: " ++ rm) , testProperty "timezone" $ \tz -> let r = localTimeParseE "TZHM" (show tz) in case r of Right (localtime, "") -> tz `eq` localTimeGetTimezone localtime _ -> error "Cannot parse timezone" , testProperty "custom-1" $ test_property_format ("YYYY-MM-DDTH:MI:S.msusns" :: String) , testProperty "custom-2" $ test_property_format ("Mon DD\\t\\h YYYY at HH\\hMI\\mS\\s.p9\\n\\s" :: String) ] , testGroup "Regression Tests" [ testCase "Real instance of ElapsedP (#33)" $ let res = toRational (ElapsedP (Elapsed $ Seconds 0) (NanoSeconds 0)) ref = toRational 0 :: Rational in assertEqual "failed equality" ref res , testCase "Real instance of ElapsedP (#33) (2)" $ let res = toRational (ElapsedP (Elapsed $ Seconds 100) (NanoSeconds 1000000)) ref = toRational 100 + (1 % 1000) :: Rational in assertEqual "failed equality" ref res ] ] where toCalendarTest (i, (us, dt)) = testCase (show i) (dt @=? timeGetDateTimeOfDay us) toSecondTest (i, (us@(Elapsed (Seconds s)), dt)) = testCase (show i ++ "-" ++ show s ++ "s") (us @=? timeGetElapsed dt) toWeekDayTest (i, (us, wd)) = testCase (show i ++ "-" ++ show wd) (wd @=? getWeekDay (dtDate $ timeGetDateTimeOfDay us)) eint :: [Int] eint = [1..] tuple12 (a,b,_,_) = (a,b) tuple13 (a,_,b,_) = (a,b) calTimeFormatTimeISO8601 timePosix = T.formatTime T.defaultTimeLocale "%F" (T.posixSecondsToUTCTime timePosix) test_property_format :: (TimeFormat format, Show format) => format -> DateTime -> Bool test_property_format fmt dt = let p1 = timePrint fmt dt in case timeParseE fmt p1 of Left (fmtEl, err) -> error ("cannot decode printed DateTime: " ++ show p1 ++ " with format " ++ show fmt ++ " error with(" ++ show fmtEl ++ "): " ++ err) Right (dt2, _) -> dt `eq` dt2 main = do knowns <- E.catch (map parseTimeConv . lines <$> readFile "test-time-db") (\(_ :: E.SomeException) -> return []) defaultMain (tests knowns) hourglass-0.2.12/tests/Bench.hs0000644000000000000000000000756713340057345014531 0ustar0000000000000000{-# LANGUAGE ViewPatterns #-} {-# LANGUAGE BangPatterns #-} module Main (main) where import Gauge.Main import Data.Hourglass import System.Hourglass import TimeDB import Data.List (intercalate) import qualified Data.Time.Calendar as T import qualified Data.Time.Clock as T import qualified Data.Time.Clock.POSIX as T import qualified System.Locale as T timeToTuple :: T.UTCTime -> (Int, Int, Int, Int, Int, Int) timeToTuple utcTime = (fromIntegral y, m, d, h, mi, sec) where (!y,!m,!d) = T.toGregorian (T.utctDay utcTime) !daytime = floor $ T.utctDayTime utcTime (!dt, !sec) = daytime `divMod` 60 (!h , !mi) = dt `divMod` 60 timeToTupleDate :: T.UTCTime -> (Int, Int, Int) timeToTupleDate utcTime = (fromIntegral y, m, d) where (!y,!m,!d) = T.toGregorian (T.utctDay utcTime) elapsedToPosixTime :: Elapsed -> T.POSIXTime elapsedToPosixTime (Elapsed (Seconds s)) = fromIntegral s timePosixDict :: [ (Elapsed, T.POSIXTime) ] timePosixDict = [-- (Elapsed 0, 0) --, (Elapsed 1000000, 1000000) --, (Elapsed 9000099, 9000099) {-,-} (Elapsed 1398232846, 1398232846) -- currentish time (at the time of writing) --, (Elapsed 5134000099, 5134000099) --, (Elapsed 10000000000000, 10000000000000) -- year 318857 .. ] dateDict :: [ (Int, Int, Int, Int, Int, Int) ] dateDict = [{- (1970, 1, 1, 1, 1, 1) , -}(2014, 5, 5, 5, 5, 5) --, (2114, 11, 5, 5, 5, 5) ] main :: IO () main = defaultMain [ bgroup "highlevel" $ concatMap toHighLevel timePosixDict , bgroup "to-dateTime" $ concatMap toCalendar timePosixDict , bgroup "to-date" $ concatMap toCalendarDate timePosixDict , bgroup "utc-to-date" $ concatMap toCalendarUTC timePosixDict , bgroup "to-posix" $ concatMap toPosix dateDict , bgroup "system" fromSystem ] where toHighLevel (posixHourglass, posixTime) = [ bench (showH posixHourglass) $ nf timeGetDateTimeOfDay posixHourglass , bench (showT posixTime) $ nf T.posixSecondsToUTCTime posixTime ] toCalendar (posixHourglass, posixTime) = [ bench (showH posixHourglass) $ nf timeGetDateTimeOfDay posixHourglass , bench (showT posixTime) $ nf (timeToTuple . T.posixSecondsToUTCTime) posixTime ] toCalendarDate (posixHourglass, posixTime) = [ bench (showH posixHourglass) $ nf timeGetDate posixHourglass , bench (showT posixTime) $ nf (timeToTupleDate . T.posixSecondsToUTCTime) posixTime ] toCalendarUTC (posixHourglass, posixTime) = [ bench (showH posixHourglass) $ nf timeGetDateTimeOfDay posixHourglass , bench (showT utcTime) $ nf timeToTuple utcTime ] where !utcTime = T.posixSecondsToUTCTime posixTime toPosix v = [ bench ("hourglass/" ++ n v) $ nf hourglass v , bench ("time/" ++ n v) $ nf time v ] where n (y,m,d,h,mi,s) = (intercalate "-" $ map show [y,m,d]) ++ " " ++ (intercalate ":" $ map show [h,mi,s]) hourglass (y,m,d,h,mi,s) = timeGetElapsed $ DateTime (Date y (toEnum (m-1)) d) (TimeOfDay (fromIntegral h) (fromIntegral mi) (fromIntegral s) 0) time (y,m,d,h,mi,s) = let day = T.fromGregorian (fromIntegral y) m d diffTime = T.secondsToDiffTime $ fromIntegral (h * 3600 + mi * 60 + s) in T.utcTimeToPOSIXSeconds (T.UTCTime day diffTime) fromSystem = [ bench ("hourglass/p") $ nfIO timeCurrent , bench ("hourglass/ns") $ nfIO timeCurrentP , bench ("time/posixTime") $ nfIO T.getPOSIXTime , bench ("time/utcTime") $ nfIO T.getCurrentTime ] showH :: Show a => a -> String showH a = "hourglass/" ++ show a showT :: Show a => a -> String showT a = "time/" ++ show a hourglass-0.2.12/LICENSE0000644000000000000000000000272213340057345013005 0ustar0000000000000000Copyright (c) 2014 Vincent Hanquez All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hourglass-0.2.12/Setup.hs0000644000000000000000000000005613340057345013432 0ustar0000000000000000import Distribution.Simple main = defaultMain hourglass-0.2.12/hourglass.cabal0000644000000000000000000000601513340060122014755 0ustar0000000000000000Name: hourglass Version: 0.2.12 Synopsis: simple performant time related library Description: Simple time library focusing on simple but powerful and performant API . The backbone of the library are the Timeable and Time type classes. . Each Timeable instances can be converted to type that has a Time instances, and thus are different representations of current time. License: BSD3 License-file: LICENSE Copyright: Vincent Hanquez Author: Vincent Hanquez Maintainer: vincent@snarc.org Category: Time Stability: experimental Build-Type: Simple Homepage: https://github.com/vincenthz/hs-hourglass Cabal-Version: >=1.10 extra-source-files: README.md , CHANGELOG.md , tests/TimeDB.hs Library Exposed-modules: Time.Types , Time.System , Time.Compat , Data.Hourglass , Data.Hourglass.Types , Data.Hourglass.Epoch , Data.Hourglass.Compat , System.Hourglass Other-modules: Data.Hourglass.Time , Data.Hourglass.Format , Data.Hourglass.Diff , Data.Hourglass.Local , Data.Hourglass.Calendar , Data.Hourglass.Zone , Data.Hourglass.Internal , Data.Hourglass.Utils Build-depends: base >= 4 && < 5 , deepseq ghc-options: -Wall -fwarn-tabs Default-Language: Haskell2010 if os(windows) cpp-options: -DWINDOWS Build-depends: Win32 Other-modules: Data.Hourglass.Internal.Win else Other-modules: Data.Hourglass.Internal.Unix c-sources: cbits/unix.c Test-Suite test-hourglass type: exitcode-stdio-1.0 hs-source-dirs: tests Main-is: Tests.hs Build-Depends: base >= 3 && < 5 , mtl , tasty , tasty-quickcheck , tasty-hunit , hourglass , deepseq -- to test against some other reference , time , old-locale ghc-options: -Wall -fno-warn-orphans -fno-warn-missing-signatures Default-Language: Haskell2010 if os(windows) cpp-options: -DWINDOWS Benchmark bench-hourglass hs-source-dirs: tests Main-Is: Bench.hs type: exitcode-stdio-1.0 Default-Language: Haskell2010 Build-depends: base >= 4 && < 5 , bytestring , gauge , mtl , deepseq , hourglass -- to benchmark against other reference , time , old-locale source-repository head type: git location: https://github.com/vincenthz/hs-hourglass hourglass-0.2.12/README.md0000644000000000000000000000421713340057345013260 0ustar0000000000000000hourglass ========= [![Build Status](https://travis-ci.org/vincenthz/hs-hourglass.png?branch=master)](https://travis-ci.org/vincenthz/hs-hourglass) [![BSD](http://b.repl.ca/v1/license-BSD-blue.png)](http://en.wikipedia.org/wiki/BSD_licenses) [![Haskell](http://b.repl.ca/v1/language-haskell-lightgrey.png)](http://haskell.org) Hourglass is a simple time library. Documentation: [hourglass on hackage](http://hackage.haskell.org/package/hourglass) Design ------ Key parts of the design are the Timeable and Time typeclasses. Time representations of the same time values are interchangeable and easy to convert between each other. This also allows the user to define new time types that interact with the same functions as the built-in types. For example: ```haskell let dateTime0 = DateTime { dtDate = Date { dateYear = 1970, dateMonth = January, dateDay = 1 } , dtTime = TimeOfDay {todHour = 0, todMin = 0, todSec = 0, todNSec = 0 }} elapsed0 = Elasped 0 > timeGetElapsed elapsed0 == timeGetElapsed dateTime0 True > timeGetDate elapsed0 == timeGetDate dateTime0 True > timePrint "YYYY-MM" elapsed0 "1970-01" > timePrint "YYYY-MM" dateTime0 "1970-01" ``` Hourglass has the same limitations as your system: * On 32 bit linux, you can't get a date after the year 2038. * In Windows 7, you can't get the date before the year 1601. Comparaison with time --------------------- * Getting posix time: ```haskell -- With time import Data.Time.Clock.POSIX ptime <- getPOSIXTime -- With hourglass import System.Hourglass ptime <- timeCurrent ``` * Getting the current year: ```haskell -- With time import Data.Time.Clock import Data.Time.Calendar currentYear <- (\(y,_,_) -> y) . toGregorian . utcDay <$> getCurrentTime -- With hourglass import System.Hourglass import Data.Time currentYear <- dateYear . timeGetDate <$> timeCurrent ``` * Representating "4th May 1970 15:12:24" ```haskell -- With time import Data.Time.Clock import Date.Time.Calendar let day = fromGregorian 1970 5 4 diffTime = secondsToDiffTime (15 * 3600 + 12 * 60 + 24) in UTCTime day diffTime -- With hourglass import Date.Time DateTime (Date 1970 May 4) (TimeOfDay 15 12 24 0) ``` hourglass-0.2.12/CHANGELOG.md0000644000000000000000000000346313340057345013614 0ustar0000000000000000## Version 0.2.8 (2015-01-07) - Fix test with time 1.5 ## Version 0.2.7 (2015-01-07) - Add compatibility module for easy convertion with time and other standards. - Format parsing improvements ## Version 0.2.6 (2014-10-19) - fix compilation of benchs. - add utc time. - print the error in the test - remove all the read instances in favor of explicit parsing in time parsing. ## Version 0.2.5 (2014-10-04) - Fixed Windows build - Added type signature to fromIntegral ## Version 0.2.4 (2014-09-30) - Fix ElapsedP Num instance (addition and substraction) - add travis machinery ## Version 0.2.3 (2014-09-25) - Fix build on GNU/Hurd. - Add milliseconds, microseconds and nanoseconds format time ## Version 0.2.2 (2014-06-11) - wrap system time in local time correctly ## Version 0.2.1 (2014-06-10) - unwrap local time structure when doing a localTimePrint - properly show hours, minutes and seconds in format print. - add some description of new calls. ## Version 0.2.0 (2014-06-03) - use tasty to replace test-framework - add some inlining pragma to tentatively deal with rules properly. - Remove the Time method to get timezone offset, all local time must be handled through LocalTime - Remove the Time instance for Localtime. - add localTimeParse since timeParse is not suitable anymore for LocalTime (no more time instance). - add Hours and Minutes types. - add a time interval class to convert between time unit types. - add some new derived classes (Enum,Real,Integral) for time unit types. - split TimeDiff into a Period and Duration structure. ## Version 0.1.2 (2014-05-05) - fix compilation on OSX - add some system benchmarks - comment and markup reformating ## Version 0.1.1 (2014-05-04) - add all the cabal tests file to the source dist - https-ize some urls ## Version 0.1.0 (2014-05-04) - Initial version hourglass-0.2.12/tests/TimeDB.hs0000644000000000000000000000216413340057345014602 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} module TimeDB (parseTimeConv) where import Data.Char (isDigit) import Data.Int import Data.Hourglass r :: (Read a, Num a) => String -> a r !s | isNumber s = case reads s of [(n,"")] -> fromIntegral (n :: Int64) [] -> error ("cannot parse anything: " ++ show s) _ -> error ("cannot parse anything: " ++ show s) | otherwise = error ("not a num: " ++ s) where isNumber [] = False isNumber ('-':xs) = allNum xs isNumber n@(_:_) = allNum n allNum = and . map isDigit wordsWhen :: (Char -> Bool) -> String -> [String] wordsWhen p s = case dropWhile p s of "" -> [] s' -> w : wordsWhen p s'' where (w, s'') = break p s' parseTimeConv :: String -> (Elapsed, DateTime, WeekDay, Int) parseTimeConv v = case wordsWhen (== ':') v of ts:y:m:d:h:n:s:wd:doy:[] -> ( r ts , DateTime (Date (r y) (toEnum $ r m - 1) (r d)) (TimeOfDay (r h) (r n) (r s) 0) , read wd , r doy) l -> error ("invalid line: " ++ show l)