diff --git a/src/Data/Time/Exts.hs b/src/Data/Time/Exts.hs --- a/src/Data/Time/Exts.hs +++ b/src/Data/Time/Exts.hs @@ -24,7 +24,7 @@ ) where -import Data.Time.Exts.Base +import Data.Time.Exts.Base hiding (TimeZone) import Data.Time.Exts.C import Data.Time.Exts.Local import Data.Time.Exts.Unix diff --git a/src/Data/Time/Exts/Base.hs b/src/Data/Time/Exts/Base.hs --- a/src/Data/Time/Exts/Base.hs +++ b/src/Data/Time/Exts/Base.hs @@ -14,15 +14,18 @@ -- ** Classes Date(..) + , Time(..) + , Zone(..) , DateTime(..) , DateZone(..) + , TimeZone(..) , DateTimeZone(..) , DateTimeMath(..) , Duration(..) - , Zone(..) -- ** Structs , DateStruct(..) + , TimeStruct(..) , DateTimeStruct(..) , DateZoneStruct(..) , DateTimeZoneStruct(..) @@ -49,6 +52,7 @@ -- ** Durations , epochToDate , epochToTime + , midnightToTime -- ** Utilities , isLeapYear @@ -57,14 +61,14 @@ ) where -import Control.Arrow (first) -import Data.Aeson (FromJSON, ToJSON) -import Data.Int (Int32, Int64) -import Data.Time.Exts.Zone (TimeZone) -import Data.Typeable (Typeable) -import GHC.Generics (Generic) -import Text.Printf (PrintfArg) -import System.Random (Random(..)) +import Control.Arrow (first) +import Data.Aeson (FromJSON, ToJSON) +import Data.Int (Int32, Int64) +import qualified Data.Time.Exts.Zone as TZ (TimeZone) +import Data.Typeable (Typeable) +import GHC.Generics (Generic) +import Text.Printf (PrintfArg) +import System.Random (Random(..)) class Date d where @@ -74,15 +78,28 @@ -- | Decompose a timestamp into date components. toDateStruct :: d -> DateStruct -class Date dt => DateTime dt where +class Time t where + -- | Compose a timestamp from time components. + fromTimeStruct :: TimeStruct -> t + + -- | Decompose a timestamp into time components. + toTimeStruct :: t -> TimeStruct + +class Zone x where + + -- | Change the time zone of a timestamp. + toTimeZone :: x -> TZ.TimeZone -> x + +class (Date dt, Time dt) => DateTime dt where + -- | Compose a timestamp from date and time components. fromDateTimeStruct :: DateTimeStruct -> dt -- | Decompose a timestamp into date and time components. toDateTimeStruct :: dt -> DateTimeStruct -class DateZone dz where +class Zone dz => DateZone dz where -- | Compose a timestamp from date and time zone components. fromDateZoneStruct :: DateZoneStruct -> dz @@ -90,6 +107,14 @@ -- | Decompose a timestamp into date and time zone components. toDateZoneStruct :: dz -> DateZoneStruct +class Zone tz => TimeZone tz where + + -- | Compose a timestamp from time and time zone components. + fromTimeZoneStruct :: TimeZoneStruct -> tz + + -- | Decompose a timestamp into time and time zone components. + toTimeZoneStruct :: tz -> TimeZoneStruct + class DateZone dtz => DateTimeZone dtz where -- | Compose a timestamp from date, time and time zone components. @@ -108,39 +133,49 @@ -- | Add a timestamp with a date or time component. plus :: x -> c -> x -class Zone x where - - -- | Change the time zone of a timestamp. - rezone :: x -> TimeZone -> x - -- | A struct with date components. data DateStruct = DateStruct { - _d_year :: {-# UNPACK #-} !Year - , _d_mon :: !Month - , _d_mday :: {-# UNPACK #-} !Day - , _d_wday :: !DayOfWeek - } deriving (Eq,Generic,Ord,Show,Typeable) + _d_year :: {-# UNPACK #-} !Year + , _d_mon :: !Month + , _d_mday :: {-# UNPACK #-} !Day + , _d_wday :: !DayOfWeek + } deriving (Eq,Generic,Ord,Show,Typeable) +-- | A struct with time components. +data TimeStruct = TimeStruct { + _t_hour :: {-# UNPACK #-} !Hour + , _t_min :: {-# UNPACK #-} !Minute + , _t_sec :: {-# UNPACK #-} !Double + } deriving (Eq,Generic,Ord,Show,Typeable) + -- | A struct with date and time components. data DateTimeStruct = DateTimeStruct { - _dt_year :: {-# UNPACK #-} !Year - , _dt_mon :: !Month - , _dt_mday :: {-# UNPACK #-} !Day - , _dt_wday :: !DayOfWeek - , _dt_hour :: {-# UNPACK #-} !Hour - , _dt_min :: {-# UNPACK #-} !Minute - , _dt_sec :: {-# UNPACK #-} !Double - } deriving (Eq,Generic,Ord,Show,Typeable) + _dt_year :: {-# UNPACK #-} !Year + , _dt_mon :: !Month + , _dt_mday :: {-# UNPACK #-} !Day + , _dt_wday :: !DayOfWeek + , _dt_hour :: {-# UNPACK #-} !Hour + , _dt_min :: {-# UNPACK #-} !Minute + , _dt_sec :: {-# UNPACK #-} !Double + } deriving (Eq,Generic,Ord,Show,Typeable) -- | A struct with date and time zone components. data DateZoneStruct = DateZoneStruct { - _dz_year :: {-# UNPACK #-} !Year - , _dz_mon :: !Month - , _dz_mday :: {-# UNPACK #-} !Day - , _dz_wday :: !DayOfWeek - , _dz_zone :: !TimeZone - } deriving (Eq,Generic,Ord,Show,Typeable) + _dz_year :: {-# UNPACK #-} !Year + , _dz_mon :: !Month + , _dz_mday :: {-# UNPACK #-} !Day + , _dz_wday :: !DayOfWeek + , _dz_zone :: !TZ.TimeZone + } deriving (Eq,Generic,Ord,Show,Typeable) +-- | A struct with time and time zone components. +data TimeZoneStruct = TimeZoneStruct { + _tz_hour :: {-# UNPACK #-} !Hour + , _tz_min :: {-# UNPACK #-} !Minute + , _tz_sec :: {-# UNPACK #-} !Double + , _tz_zone :: !TZ.TimeZone + } deriving (Eq,Generic,Ord,Show,Typeable) + -- | A struct with date, time and time zone components. data DateTimeZoneStruct = DateTimeZoneStruct { _dtz_year :: {-# UNPACK #-} !Year @@ -150,7 +185,7 @@ , _dtz_hour :: {-# UNPACK #-} !Hour , _dtz_min :: {-# UNPACK #-} !Minute , _dtz_sec :: {-# UNPACK #-} !Double - , _dtz_zone :: !TimeZone + , _dtz_zone :: !TZ.TimeZone } deriving (Eq,Generic,Ord,Show,Typeable) -- | Year. @@ -301,9 +336,15 @@ -- | Calculate the number of seconds (excluding leap seconds) -- that have elapsed between Unix epoch and the given time. epochToTime :: Year -> Month -> Day -> Hour -> Minute -> Second -> Second -epochToTime year month day (Hour hour) (Minute minute) (Second second) = - Second $ (days * 86400) + (hour * 3600) + (minute * 60) + second +epochToTime year month day hour minute second = + Second (days * 86400) + midnightToTime hour minute second where days = fromIntegral $ epochToDate year month day + +-- | Calculate the number of seconds (excluding leap seconds) +-- that have elapsed between midnight and the given time. +midnightToTime :: Hour -> Minute -> Second -> Second +midnightToTime (Hour hour) (Minute minute) (Second second) = + Second $ (hour * 3600) + (minute * 60) + second -- | Check if the given year is a leap year. isLeapYear :: Year -> Bool diff --git a/src/Data/Time/Exts/C.hsc b/src/Data/Time/Exts/C.hsc --- a/src/Data/Time/Exts/C.hsc +++ b/src/Data/Time/Exts/C.hsc @@ -8,14 +8,14 @@ -- | Haskell bindings to the C time library. module Data.Time.Exts.C where -import Data.Convertible (Convertible(..)) -import Foreign.C.String (CString) -import Foreign.C.Types (CInt(..), CLong, CTime(..)) -import Foreign.Marshal.Alloc (alloca) +import Data.Convertible (Convertible(..)) +import Foreign.C.String (CString) +import Foreign.C.Types (CInt(..), CLong, CTime(..)) +import Foreign.Marshal.Alloc (alloca) import Foreign.Marshal.Unsafe (unsafeLocalState) -import Foreign.Marshal.Utils (with) -import Foreign.Ptr (FunPtr, Ptr, nullPtr, plusPtr) -import Foreign.Storable (Storable(..)) +import Foreign.Marshal.Utils (with) +import Foreign.Ptr (FunPtr, Ptr, nullPtr, plusPtr) +import Foreign.Storable (Storable(..)) #include #include @@ -33,11 +33,6 @@ #field tm_isdst , CInt #field tm_gmtoff , CLong #field tm_zone , CString -#stoptype - -#starttype struct timespec -#field tv_sec , CLong -#field tv_nsec , CLong #stoptype #starttype struct timeval diff --git a/src/Data/Time/Exts/Local.hs b/src/Data/Time/Exts/Local.hs --- a/src/Data/Time/Exts/Local.hs +++ b/src/Data/Time/Exts/Local.hs @@ -60,34 +60,39 @@ , prettyLocalDate , prettyLocalDateTime + -- ** Base Conversions + , baseUnixToUTC + , baseUTCToUnix + ) where -import Control.Arrow ((***), first) -import Control.DeepSeq (NFData) -import Data.Aeson (FromJSON, ToJSON) +import Control.Arrow ((***), first) +import Control.DeepSeq (NFData) +import Data.Aeson (FromJSON, ToJSON) import Data.Convertible (Convertible(..), convert) -import Data.Function (on) -import Data.Int (Int16, Int32, Int64) -import Data.Label (get, mkLabels, modify, set) -import Data.List (groupBy, sortBy) -import Data.Maybe (listToMaybe) -import Data.Monoid ((<>)) -import Data.Ord (comparing) -import Data.Time (DiffTime, UTCTime(..)) -import qualified Data.Time.Calendar as Cal (Day(..)) +import Data.Function (on) +import Data.Int (Int16, Int32, Int64) +import Data.Label (get, mkLabels, modify, set) +import Data.List (groupBy, sortBy) +import Data.Maybe (listToMaybe) +import Data.Monoid ((<>)) +import Data.Ord (comparing) +import Data.Time (DiffTime, UTCTime(..)) import Data.Time.Exts.Base import Data.Time.Exts.Unix -import Data.Time.Exts.Zone -import qualified Data.Time.LocalTime.TimeZone.Olson as Olson -import Data.Tuple (swap) -import Data.Typeable (Typeable) -import Data.Word (Word8) -import Foreign.Ptr (plusPtr) +import Data.Tuple (swap) +import Data.Typeable (Typeable) +import Data.Word (Word8) +import Foreign.Ptr (plusPtr) import Foreign.Storable (Storable(..)) -import GHC.Generics (Generic) -import System.Random (Random(..)) -import Text.Printf (printf) +import GHC.Generics (Generic) +import System.Random (Random(..)) +import Text.Printf (printf) +import qualified Data.Time.Calendar as Cal +import qualified Data.Time.Exts.Zone as TZ +import qualified Data.Time.LocalTime.TimeZone.Olson as Olson + -- | The local timestamp type class. class Local u where @@ -99,46 +104,46 @@ -- | Days since Unix epoch. data LocalDate = LocalDate { - _loc_day_base :: {-# UNPACK #-} !Int32 - , _loc_day_zone :: {-# UNPACK #-} !Word8 + _ld_day_base :: {-# UNPACK #-} !Int32 + , _ld_day_zone :: {-# UNPACK #-} !Word8 } deriving (Eq,Generic,Typeable) -- | Seconds since Unix epoch (including leap seconds). data LocalDateTime = LocalDateTime { - _loc_sec_base :: {-# UNPACK #-} !Int64 - , _loc_sec_zone :: {-# UNPACK #-} !Word8 + _ldt_sec_base :: {-# UNPACK #-} !Int64 + , _ldt_sec_zone :: {-# UNPACK #-} !Word8 } deriving (Eq,Generic,Typeable) -- | Milliseconds since Unix epoch (including leap seconds). data LocalDateTimeMillis = LocalDateTimeMillis { - _loc_mil_base :: {-# UNPACK #-} !Int64 - , _loc_mil_zone :: {-# UNPACK #-} !Word8 + _ldt_mil_base :: {-# UNPACK #-} !Int64 + , _ldt_mil_zone :: {-# UNPACK #-} !Word8 } deriving (Eq,Generic,Typeable) -- | Microseconds since Unix epoch (including leap seconds). data LocalDateTimeMicros = LocalDateTimeMicros { - _loc_mic_base :: {-# UNPACK #-} !Int64 - , _loc_mic_zone :: {-# UNPACK #-} !Word8 + _ldt_mic_base :: {-# UNPACK #-} !Int64 + , _ldt_mic_zone :: {-# UNPACK #-} !Word8 } deriving (Eq,Generic,Typeable) -- | Nanoseconds since Unix epoch (including leap seconds). data LocalDateTimeNanos = LocalDateTimeNanos { - _loc_nan_base :: {-# UNPACK #-} !Int64 - , _loc_nan_nano :: {-# UNPACK #-} !Int16 - , _loc_nan_zone :: {-# UNPACK #-} !Word8 + _ldt_nan_base :: {-# UNPACK #-} !Int64 + , _ldt_nan_nano :: {-# UNPACK #-} !Int16 + , _ldt_nan_zone :: {-# UNPACK #-} !Word8 } deriving (Eq,Generic,Typeable) -- | Picoseconds since Unix epoch (including leap seconds). data LocalDateTimePicos = LocalDateTimePicos { - _loc_pic_base :: {-# UNPACK #-} !Int64 - , _loc_pic_pico :: {-# UNPACK #-} !Int32 - , _loc_pic_zone :: {-# UNPACK #-} !Word8 + _ldt_pic_base :: {-# UNPACK #-} !Int64 + , _ldt_pic_pico :: {-# UNPACK #-} !Int32 + , _ldt_pic_zone :: {-# UNPACK #-} !Word8 } deriving (Eq,Generic,Typeable) -- | Time zone transition time. newtype Transition = Transition { unboxTrans :: LocalDateTime - } deriving (Eq,Typeable,Generic,ToJSON,FromJSON,NFData,Storable) + } deriving (Eq,Generic,Typeable) instance FromJSON LocalDate instance FromJSON LocalDateTime @@ -164,8 +169,8 @@ return $! LocalDate base zone pokeElemOff ptr n LocalDate{..} = do let off = 5 * n - poke (plusPtr ptr $ off ) _loc_day_base - poke (plusPtr ptr $ off + 4) _loc_day_zone + poke (plusPtr ptr $ off ) _ld_day_base + poke (plusPtr ptr $ off + 4) _ld_day_zone instance Storable LocalDateTime where sizeOf _ = 9 @@ -177,8 +182,8 @@ return $! LocalDateTime base zone pokeElemOff ptr n LocalDateTime{..} = do let off = 9 * n - poke (plusPtr ptr $ off ) _loc_sec_base - poke (plusPtr ptr $ off + 8) _loc_sec_zone + poke (plusPtr ptr $ off ) _ldt_sec_base + poke (plusPtr ptr $ off + 8) _ldt_sec_zone instance Storable LocalDateTimeMillis where sizeOf _ = 9 @@ -190,8 +195,8 @@ return $! LocalDateTimeMillis base zone pokeElemOff ptr n LocalDateTimeMillis{..} = do let off = 9 * n - poke (plusPtr ptr $ off ) _loc_mil_base - poke (plusPtr ptr $ off + 8) _loc_mil_zone + poke (plusPtr ptr $ off ) _ldt_mil_base + poke (plusPtr ptr $ off + 8) _ldt_mil_zone instance Storable LocalDateTimeMicros where sizeOf _ = 9 @@ -203,8 +208,8 @@ return $! LocalDateTimeMicros base zone pokeElemOff ptr n LocalDateTimeMicros{..} = do let off = 9 * n - poke (plusPtr ptr $ off ) _loc_mic_base - poke (plusPtr ptr $ off + 8) _loc_mic_zone + poke (plusPtr ptr $ off ) _ldt_mic_base + poke (plusPtr ptr $ off + 8) _ldt_mic_zone instance Storable LocalDateTimeNanos where sizeOf _ = 11 @@ -217,9 +222,9 @@ return $! LocalDateTimeNanos base nano zone pokeElemOff ptr n LocalDateTimeNanos{..} = do let off = 11 * n - poke (plusPtr ptr $ off ) _loc_nan_base - poke (plusPtr ptr $ off + 08) _loc_nan_nano - poke (plusPtr ptr $ off + 10) _loc_nan_zone + poke (plusPtr ptr $ off ) _ldt_nan_base + poke (plusPtr ptr $ off + 08) _ldt_nan_nano + poke (plusPtr ptr $ off + 10) _ldt_nan_zone instance Storable LocalDateTimePicos where sizeOf _ = 13 @@ -232,9 +237,9 @@ return $! LocalDateTimePicos base pico zone pokeElemOff ptr n LocalDateTimePicos{..} = do let off = 13 * n - poke (plusPtr ptr $ off ) _loc_pic_base - poke (plusPtr ptr $ off + 08) _loc_pic_pico - poke (plusPtr ptr $ off + 12) _loc_pic_zone + poke (plusPtr ptr $ off ) _ldt_pic_base + poke (plusPtr ptr $ off + 08) _ldt_pic_pico + poke (plusPtr ptr $ off + 12) _ldt_pic_zone instance ToJSON LocalDate instance ToJSON LocalDateTime @@ -253,53 +258,51 @@ instance Bounded LocalDate where minBound = LocalDate 0 0 - maxBound = LocalDate 2932896 maxZone + maxBound = LocalDate 2932896 maxzone instance Bounded LocalDateTime where minBound = LocalDateTime 43200 0 - maxBound = LocalDateTime 253402257624 maxZone + maxBound = LocalDateTime 253402257624 maxzone instance Bounded LocalDateTimeMillis where minBound = LocalDateTimeMillis 43200000 0 - maxBound = LocalDateTimeMillis 253402257624999 maxZone + maxBound = LocalDateTimeMillis 253402257624999 maxzone instance Bounded LocalDateTimeMicros where minBound = LocalDateTimeMicros 43200000000 0 - maxBound = LocalDateTimeMicros 253402257624999999 maxZone + maxBound = LocalDateTimeMicros 253402257624999999 maxzone instance Bounded LocalDateTimeNanos where minBound = LocalDateTimeNanos 43200000000 0 0 - maxBound = LocalDateTimeNanos 253402257624999999 999 maxZone + maxBound = LocalDateTimeNanos 253402257624999999 999 maxzone instance Bounded LocalDateTimePicos where minBound = LocalDateTimePicos 43200000000 0 0 - maxBound = LocalDateTimePicos 253402257624999999 999999 maxZone - -deriving instance Bounded Transition + maxBound = LocalDateTimePicos 253402257624999999 999999 maxzone instance Local LocalDate where - localBase = fromIntegral . get loc_day_base - localZone = get loc_day_zone + localBase = fromIntegral . get ld_day_base + localZone = get ld_day_zone instance Local LocalDateTime where - localBase = get loc_sec_base - localZone = get loc_sec_zone + localBase = get ldt_sec_base + localZone = get ldt_sec_zone instance Local LocalDateTimeMillis where - localBase = get loc_mil_base - localZone = get loc_mil_zone + localBase = get ldt_mil_base + localZone = get ldt_mil_zone instance Local LocalDateTimeMicros where - localBase = get loc_mic_base - localZone = get loc_mic_zone + localBase = get ldt_mic_base + localZone = get ldt_mic_zone instance Local LocalDateTimeNanos where - localBase = get loc_nan_base - localZone = get loc_nan_zone + localBase = get ldt_nan_base + localZone = get ldt_nan_zone instance Local LocalDateTimePicos where - localBase = get loc_pic_base - localZone = get loc_pic_zone + localBase = get ldt_pic_base + localZone = get ldt_pic_zone deriving instance Local Transition @@ -316,107 +319,105 @@ compare = comparing localBase instance Ord LocalDateTimeNanos where - compare = comparing localBase <> comparing (get loc_nan_nano) + compare = comparing localBase <> comparing (get ldt_nan_nano) instance Ord LocalDateTimePicos where - compare = comparing localBase <> comparing (get loc_pic_pico) - -deriving instance Ord Transition + compare = comparing localBase <> comparing (get ldt_pic_pico) instance DateTimeMath LocalDate Day where date `plus` Day day = check "plus{LocalDate,Day}" $ - modify loc_day_base (+ day) date + modify ld_day_base (+ day) date instance DateTimeMath LocalDateTime Second where time `plus` Second second = check "plus{LocalDateTime,Second}" $ - modify loc_sec_base (+ second) time + modify ldt_sec_base (+ second) time instance DateTimeMath LocalDateTimeMillis Second where time `plus` Second second = check "plus{LocalDateTimeMillis,Second}" $ - modify loc_mil_base (+ second * 1000) time + modify ldt_mil_base (+ second * 1000) time instance DateTimeMath LocalDateTimeMicros Second where time `plus` Second second = check "plus{LocalDateTimeMicros,Second}" $ - modify loc_mic_base (+ second * 1000000) time + modify ldt_mic_base (+ second * 1000000) time instance DateTimeMath LocalDateTimeNanos Second where time `plus` Second second = check "plus{LocalDateTimeNanos,Second}" $ - modify loc_nan_base (+ second * 1000000) time + modify ldt_nan_base (+ second * 1000000) time instance DateTimeMath LocalDateTimePicos Second where time `plus` Second second = check "plus{LocalDateTimePicos,Second}" $ - modify loc_pic_base (+ second * 1000000) time + modify ldt_pic_base (+ second * 1000000) time instance DateTimeMath LocalDateTimeMillis Millis where time `plus` Millis millis = check "plus{LocalDateTimeMillis,Millis}" $ - modify loc_mil_base (+ millis) time + modify ldt_mil_base (+ millis) time instance DateTimeMath LocalDateTimeMicros Millis where time `plus` Millis millis = check "plus{LocalDateTimeMicros,Millis}" $ - modify loc_mic_base (+ millis * 1000) time + modify ldt_mic_base (+ millis * 1000) time instance DateTimeMath LocalDateTimeNanos Millis where time `plus` Millis millis = check "plus{LocalDateTimeNanos,Millis}" $ - modify loc_nan_base (+ millis * 1000) time + modify ldt_nan_base (+ millis * 1000) time instance DateTimeMath LocalDateTimePicos Millis where time `plus` Millis millis = check "plus{LocalDateTimePicos,Millis}" $ - modify loc_pic_base (+ millis * 1000) time + modify ldt_pic_base (+ millis * 1000) time instance DateTimeMath LocalDateTimeMicros Micros where time `plus` Micros micros = check "plus{LocalDateTimeMicros,Micros}" $ - modify loc_mic_base (+ micros) time + modify ldt_mic_base (+ micros) time instance DateTimeMath LocalDateTimeNanos Micros where time `plus` Micros micros = check "plus{LocalDateTimeNanos,Micros}" $ - modify loc_nan_base (+ micros) time + modify ldt_nan_base (+ micros) time instance DateTimeMath LocalDateTimePicos Micros where time `plus` Micros micros = check "plus{LocalDateTimePicos,Micros}" $ - modify loc_pic_base (+ micros) time + modify ldt_pic_base (+ micros) time instance DateTimeMath LocalDateTimeNanos Nanos where time `plus` Nanos nanos = check "plus{UnixDateTimeNanos,Nanos}" . - modify loc_nan_base (+ micros) $ - set loc_nan_nano nano time - where nsum = fromIntegral (get loc_nan_nano time) + nanos + modify ldt_nan_base (+ micros) $ + set ldt_nan_nano nano time + where nsum = fromIntegral (get ldt_nan_nano time) + nanos (micros, nano) = fmap fromIntegral $ divMod nsum 1000 instance DateTimeMath LocalDateTimePicos Nanos where time `plus` Nanos nanos = check "plus{LocalDateTimePicos,Nanos}" . - modify loc_pic_base (+ micros) $ - set loc_pic_pico pico time - where psum = fromIntegral (get loc_pic_pico time) + nanos * 1000 + modify ldt_pic_base (+ micros) $ + set ldt_pic_pico pico time + where psum = fromIntegral (get ldt_pic_pico time) + nanos * 1000 (micros, pico) = fmap fromIntegral $ divMod psum 1000000 instance DateTimeMath LocalDateTimePicos Picos where time `plus` Picos picos = check "plus{LocalDateTimePicos,Picos}" . - modify loc_pic_base (+ micros) $ - set loc_pic_pico pico time - where psum = fromIntegral (get loc_pic_pico time) + picos + modify ldt_pic_base (+ micros) $ + set ldt_pic_pico pico time + where psum = fromIntegral (get ldt_pic_pico time) + picos (micros, pico) = fmap fromIntegral $ divMod psum 1000000 instance Enum LocalDate where succ = flip plus $ Day 1 pred = flip plus . Day $ - 1 - toEnum = check "toEnum{LocalDate}" . uncurry LocalDate . doubleIntegral . flip divMod 1000 - fromEnum LocalDate{..} = fromIntegral _loc_day_base * 1000 + fromIntegral _loc_day_zone + toEnum = check "toEnum{LocalDate}" . uncurry LocalDate . doubleInt . flip divMod 1000 + fromEnum LocalDate{..} = fromIntegral _ld_day_base * 1000 + fromIntegral _ld_day_zone enumFrom v = [t | t <- v : enumFrom (succ v)] enumFromTo v1 v2 | v1 == v2 = [v1] @@ -426,8 +427,8 @@ instance Enum LocalDateTime where succ = flip plus $ Second 1 pred = flip plus . Second $ - 1 - toEnum = check "toEnum{LocalDateTime}" . uncurry LocalDateTime . doubleIntegral . flip divMod 1000 - fromEnum LocalDateTime{..} = fromIntegral _loc_sec_base * 1000 + fromIntegral _loc_sec_zone + toEnum = check "toEnum{LocalDateTime}" . uncurry LocalDateTime . doubleInt . flip divMod 1000 + fromEnum LocalDateTime{..} = fromIntegral _ldt_sec_base * 1000 + fromIntegral _ldt_sec_zone enumFrom v = [t | t <- v : enumFrom (succ v)] enumFromTo v1 v2 | v1 == v2 = [v1] @@ -437,16 +438,14 @@ instance Enum LocalDateTimeMillis where succ = flip plus $ Millis 1 pred = flip plus . Millis $ - 1 - toEnum = check "toEnum{LocalDateTimeMillis}" . uncurry LocalDateTimeMillis . doubleIntegral . flip divMod 1000 - fromEnum LocalDateTimeMillis{..} = fromIntegral _loc_mil_base * 1000 + fromIntegral _loc_mil_zone + toEnum = check "toEnum{LocalDateTimeMillis}" . uncurry LocalDateTimeMillis . doubleInt . flip divMod 1000 + fromEnum LocalDateTimeMillis{..} = fromIntegral _ldt_mil_base * 1000 + fromIntegral _ldt_mil_zone enumFrom v = [t | t <- v : enumFrom (succ v)] enumFromTo v1 v2 | v1 == v2 = [v1] | v1 < v2 = [t | t <- v1 : enumFromTo (succ v1) v2] | otherwise = [t | t <- v1 : enumFromTo (pred v1) v2] -deriving instance Enum Transition - -- | Convert Unix seconds into a UTC seconds. baseUnixToUTC :: Int64 -> Int64 baseUnixToUTC base @@ -482,9 +481,9 @@ -- > >>> createLocalDate 2013 November 03 Pacific_Standard_Time -- > 2013-11-03 PST -- -createLocalDate :: Year -> Month -> Day -> TimeZone -> LocalDate +createLocalDate :: Year -> Month -> Day -> TZ.TimeZone -> LocalDate createLocalDate year month day zone = - check "createLocalDate" . LocalDate base $ fromZone zone + check "createLocalDate" . LocalDate base $ tz2w8 zone where Day base = epochToDate year month day -- | Create a local date and time. @@ -492,62 +491,62 @@ -- > >>> createLocalDateTime 2013 November 03 22 55 52 South_Africa_Standard_Time -- > 2013-11-03 22:55:52 SAST -- -createLocalDateTime :: Year -> Month -> Day -> Hour -> Minute -> Second -> TimeZone -> LocalDateTime +createLocalDateTime :: Year -> Month -> Day -> Hour -> Minute -> Second -> TZ.TimeZone -> LocalDateTime createLocalDateTime year month day hour minute (Second second) zone = - check "createLocalDateTime" . LocalDateTime base $ fromZone zone + check "createLocalDateTime" . LocalDateTime base $ tz2w8 zone where base = baseUnixToUTC (unix - offset) + second Second unix = epochToTime year month day hour minute 0 - offset = getUTCOffset zone * 60 + offset = TZ.getUTCOffset zone * 60 -- | Create a local date and time with millisecond granularity. -- -- > >>> createLocalDateTimeMillis 2013 November 03 13 57 43 830 Mountain_Standard_Time -- > 2013-11-03 13:57:43.830 MST -- -createLocalDateTimeMillis :: Year -> Month -> Day -> Hour -> Minute -> Second -> Millis -> TimeZone -> LocalDateTimeMillis +createLocalDateTimeMillis :: Year -> Month -> Day -> Hour -> Minute -> Second -> Millis -> TZ.TimeZone -> LocalDateTimeMillis createLocalDateTimeMillis year month day hour minute (Second second) (Millis millis) zone = - check "createLocalDateTimeMillis" . LocalDateTimeMillis base $ fromZone zone + check "createLocalDateTimeMillis" . LocalDateTimeMillis base $ tz2w8 zone where base = 1000 * (baseUnixToUTC (unix - offset) + second) + millis Second unix = epochToTime year month day hour minute 0 - offset = getUTCOffset zone * 60 + offset = TZ.getUTCOffset zone * 60 -- | Create a local date and time with microsecond granularity. -- -- > >>> createLocalDateTimeMicros 2013 November 03 21 01 42 903539 Coordinated_Universal_Time -- > 2013-11-03 21:01:42.903539 UTC -- -createLocalDateTimeMicros :: Year -> Month -> Day -> Hour -> Minute -> Second -> Micros -> TimeZone -> LocalDateTimeMicros +createLocalDateTimeMicros :: Year -> Month -> Day -> Hour -> Minute -> Second -> Micros -> TZ.TimeZone -> LocalDateTimeMicros createLocalDateTimeMicros year month day hour minute (Second second) (Micros micros) zone = - check "createLocalDateTimeMicros" . LocalDateTimeMicros base $ fromZone zone + check "createLocalDateTimeMicros" . LocalDateTimeMicros base $ tz2w8 zone where base = 1000000 * (baseUnixToUTC (unix - offset) + second) + micros Second unix = epochToTime year month day hour minute 0 - offset = getUTCOffset zone * 60 + offset = TZ.getUTCOffset zone * 60 -- | Create a local date and time with nanosecond granularity. -- -- > >>> createLocalDateTimeNanos 2013 November 04 06 05 07 016715087 Japan_Standard_Time -- > 2013-11-04 06:05:07.016715087 JST -- -createLocalDateTimeNanos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Nanos -> TimeZone -> LocalDateTimeNanos +createLocalDateTimeNanos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Nanos -> TZ.TimeZone -> LocalDateTimeNanos createLocalDateTimeNanos year month day hour minute (Second second) (Nanos nanos) zone = - check "createLocalDateTimeNanos" . LocalDateTimeNanos base nano $ fromZone zone + check "createLocalDateTimeNanos" . LocalDateTimeNanos base nano $ tz2w8 zone where base = 1000000 * (baseUnixToUTC (unix - offset) + second) + micros (micros, nano) = fmap fromIntegral $ divMod nanos 0001000 Second unix = epochToTime year month day hour minute 0 - offset = getUTCOffset zone * 60 + offset = TZ.getUTCOffset zone * 60 -- | Create a local date and time with picosecond granularity. -- -- > >>> createLocalDateTimePicos 2013 November 03 23 13 56 838238648311 Eastern_European_Time -- > 2013-11-03 23:13:56.838238648311 EET -- -createLocalDateTimePicos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Picos -> TimeZone -> LocalDateTimePicos +createLocalDateTimePicos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Picos -> TZ.TimeZone -> LocalDateTimePicos createLocalDateTimePicos year month day hour minute (Second second) (Picos picos) zone = - check "createLocalDateTimePicos" . LocalDateTimePicos base pico $ fromZone zone + check "createLocalDateTimePicos" . LocalDateTimePicos base pico $ tz2w8 zone where base = 1000000 * (baseUnixToUTC (unix - offset) + second) + micros (micros, pico) = fmap fromIntegral $ divMod picos 1000000 Second unix = epochToTime year month day hour minute 0 - offset = getUTCOffset zone * 60 + offset = TZ.getUTCOffset zone * 60 -- | Convert UTC seconds into Unix and leap seconds. baseUTCToUnix :: Int64 -> (Int64, Double) @@ -608,148 +607,148 @@ decompLocalDate :: LocalDate -> DateZoneStruct decompLocalDate LocalDate{..} = DateZoneStruct _d_year _d_mon _d_mday _d_wday zone - where DateStruct{..} = toDateStruct $ UnixDate _loc_day_base - zone = toZone _loc_day_zone + where DateStruct{..} = toDateStruct $ UnixDate _ld_day_base + zone = w82tz _ld_day_zone -- | Decompose a local date and time into a human-readable format. decompLocalDateTime :: LocalDateTime -> DateTimeZoneStruct decompLocalDateTime LocalDateTime{..} = DateTimeZoneStruct _dt_year _dt_mon _dt_mday _dt_wday _dt_hour _dt_min sec zone where DateTimeStruct{..} = toDateTimeStruct $ UnixDateTime base `plus` offset - (base, leap) = baseUTCToUnix _loc_sec_base + (base, leap) = baseUTCToUnix _ldt_sec_base sec = _dt_sec + leap - offset = getUTCOffset zone :: Minute - zone = toZone _loc_sec_zone + offset = TZ.getUTCOffset zone :: Minute + zone = w82tz _ldt_sec_zone -- | Decompose a local date and time with millisecond granularity into a human-readable format. decompLocalDateTimeMillis :: LocalDateTimeMillis -> DateTimeZoneStruct decompLocalDateTimeMillis LocalDateTimeMillis{..} = DateTimeZoneStruct _dt_year _dt_mon _dt_mday _dt_wday _dt_hour _dt_min sec zone where DateTimeStruct{..} = toDateTimeStruct $ UnixDateTime base `plus` offset - ((base, leap), millis) = baseUTCToUnix *** realToFrac $ divMod _loc_mil_base 0001000 + ((base, leap), millis) = baseUTCToUnix *** realToFrac $ divMod _ldt_mil_base 0001000 sec = _dt_sec + leap + millis / 0001000 - offset = getUTCOffset zone :: Minute - zone = toZone _loc_mil_zone + offset = TZ.getUTCOffset zone :: Minute + zone = w82tz _ldt_mil_zone -- | Decompose a local date and time with microsecond granularity into a human-readable format. decompLocalDateTimeMicros :: LocalDateTimeMicros -> DateTimeZoneStruct decompLocalDateTimeMicros LocalDateTimeMicros{..} = DateTimeZoneStruct _dt_year _dt_mon _dt_mday _dt_wday _dt_hour _dt_min sec zone where DateTimeStruct{..} = toDateTimeStruct $ UnixDateTime base `plus` offset - ((base, leap), micros) = baseUTCToUnix *** realToFrac $ divMod _loc_mic_base 1000000 + ((base, leap), micros) = baseUTCToUnix *** realToFrac $ divMod _ldt_mic_base 1000000 sec = _dt_sec + leap + micros / 1000000 - offset = getUTCOffset zone :: Minute - zone = toZone _loc_mic_zone + offset = TZ.getUTCOffset zone :: Minute + zone = w82tz _ldt_mic_zone -- | Decompose a local date and time with nanosecond granularity into a human-readable format. decompLocalDateTimeNanos :: LocalDateTimeNanos -> DateTimeZoneStruct decompLocalDateTimeNanos LocalDateTimeNanos{..} = DateTimeZoneStruct _dt_year _dt_mon _dt_mday _dt_wday _dt_hour _dt_min sec zone where DateTimeStruct{..} = toDateTimeStruct $ UnixDateTime base `plus` offset - ((base, leap), micros) = baseUTCToUnix *** realToFrac $ divMod _loc_nan_base 1000000 - sec = _dt_sec + leap + micros / 1000000 + realToFrac _loc_nan_nano / 1000000000 - offset = getUTCOffset zone :: Minute - zone = toZone _loc_nan_zone + ((base, leap), micros) = baseUTCToUnix *** realToFrac $ divMod _ldt_nan_base 1000000 + sec = _dt_sec + leap + micros / 1000000 + realToFrac _ldt_nan_nano / 1000000000 + offset = TZ.getUTCOffset zone :: Minute + zone = w82tz _ldt_nan_zone -- | Decompose a local date and time with picosecond granularity into a human-readable format. decompLocalDateTimePicos :: LocalDateTimePicos -> DateTimeZoneStruct decompLocalDateTimePicos LocalDateTimePicos{..} = DateTimeZoneStruct _dt_year _dt_mon _dt_mday _dt_wday _dt_hour _dt_min sec zone where DateTimeStruct{..} = toDateTimeStruct $ UnixDateTime base `plus` offset - ((base, leap), micros) = baseUTCToUnix *** realToFrac $ divMod _loc_pic_base 1000000 - sec = _dt_sec + leap + micros / 1000000 + realToFrac _loc_pic_pico / 1000000000000 - offset = getUTCOffset zone :: Minute - zone = toZone _loc_pic_zone + ((base, leap), micros) = baseUTCToUnix *** realToFrac $ divMod _ldt_pic_base 1000000 + sec = _dt_sec + leap + micros / 1000000 + realToFrac _ldt_pic_pico / 1000000000000 + offset = TZ.getUTCOffset zone :: Minute + zone = w82tz _ldt_pic_zone -- | Decompose a local base (in seconds) into day and second components. -decompLocalBase :: (Int64, TimeZone) -> (Int32, DiffTime) +decompLocalBase :: (Int64, TZ.TimeZone) -> (Int32, DiffTime) decompLocalBase = uncurry (flip f) . first (uncurry g . baseUTCToUnix) - where f x = first $ fromIntegral . flip div 86400 . (+ 60 * getUTCOffset x) + where f x = first $ fromIntegral . flip div 86400 . (+ 60 * TZ.getUTCOffset x) g x = (x, ) . fromIntegral . (+ mod x 86400) . truncate instance Convertible LocalDateTime LocalDate where - safeConvert LocalDateTime{..} = Right $ LocalDate base _loc_sec_zone - where base = fst $ decompLocalBase (_loc_sec_base, toZone _loc_sec_zone) + safeConvert LocalDateTime{..} = Right $ LocalDate base _ldt_sec_zone + where base = fst $ decompLocalBase (_ldt_sec_base, w82tz _ldt_sec_zone) instance Convertible LocalDateTimeMillis LocalDate where - safeConvert LocalDateTimeMillis{..} = Right $ LocalDate base _loc_mil_zone - where base = fst (decompLocalBase (div _loc_mil_base 0001000, toZone _loc_mil_zone)) + safeConvert LocalDateTimeMillis{..} = Right $ LocalDate base _ldt_mil_zone + where base = fst (decompLocalBase (div _ldt_mil_base 0001000, w82tz _ldt_mil_zone)) instance Convertible LocalDateTimeMicros LocalDate where - safeConvert LocalDateTimeMicros{..} = Right $ LocalDate base _loc_mic_zone - where base = fst (decompLocalBase (div _loc_mic_base 1000000, toZone _loc_mic_zone)) + safeConvert LocalDateTimeMicros{..} = Right $ LocalDate base _ldt_mic_zone + where base = fst (decompLocalBase (div _ldt_mic_base 1000000, w82tz _ldt_mic_zone)) instance Convertible LocalDateTimeNanos LocalDate where - safeConvert LocalDateTimeNanos{..} = Right $ LocalDate base _loc_nan_zone - where base = fst (decompLocalBase (div _loc_nan_base 1000000, toZone _loc_nan_zone)) + safeConvert LocalDateTimeNanos{..} = Right $ LocalDate base _ldt_nan_zone + where base = fst (decompLocalBase (div _ldt_nan_base 1000000, w82tz _ldt_nan_zone)) instance Convertible LocalDateTimePicos LocalDate where - safeConvert LocalDateTimePicos{..} = Right $ LocalDate base _loc_pic_zone - where base = fst (decompLocalBase (div _loc_pic_base 1000000, toZone _loc_pic_zone)) + safeConvert LocalDateTimePicos{..} = Right $ LocalDate base _ldt_pic_zone + where base = fst (decompLocalBase (div _ldt_pic_base 1000000, w82tz _ldt_pic_zone)) instance Convertible LocalDate Cal.Day where - safeConvert = Right . Cal.ModifiedJulianDay . toInteger . (+ 40587) . _loc_day_base + safeConvert = Right . Cal.ModifiedJulianDay . toInteger . (+ 40587) . _ld_day_base instance Convertible LocalDateTime UTCTime where safeConvert LocalDateTime{..} = Right $ UTCTime julian pico where julian = Cal.ModifiedJulianDay $ toInteger day + 40587 - (day, pico) = decompLocalBase (_loc_sec_base, toZone _loc_sec_zone) + (day, pico) = decompLocalBase (_ldt_sec_base, w82tz _ldt_sec_zone) instance Convertible LocalDateTimeMillis UTCTime where safeConvert LocalDateTimeMillis{..} = Right $ UTCTime julian pico where julian = Cal.ModifiedJulianDay $ toInteger day + 40587 frac = millis / 1000 - (base, millis) = fmap fromIntegral $ _loc_mil_base `divMod` 0001000 - (day , pico ) = fmap (+ frac) $ decompLocalBase (base, toZone _loc_mil_zone) + (base, millis) = fmap fromIntegral $ _ldt_mil_base `divMod` 0001000 + (day , pico ) = fmap (+ frac) $ decompLocalBase (base, w82tz _ldt_mil_zone) instance Convertible LocalDateTimeMicros UTCTime where safeConvert LocalDateTimeMicros{..} = Right $ UTCTime julian pico where julian = Cal.ModifiedJulianDay $ toInteger day + 40587 frac = micros / 1000000 - (base, micros) = fmap fromIntegral $ _loc_mic_base `divMod` 1000000 - (day , pico ) = fmap (+ frac) $ decompLocalBase (base, toZone _loc_mic_zone) + (base, micros) = fmap fromIntegral $ _ldt_mic_base `divMod` 1000000 + (day , pico ) = fmap (+ frac) $ decompLocalBase (base, w82tz _ldt_mic_zone) instance Convertible LocalDateTimeNanos UTCTime where safeConvert LocalDateTimeNanos{..} = Right $ UTCTime julian pico where julian = Cal.ModifiedJulianDay $ toInteger day + 40587 - frac = micros / 1000000 + fromIntegral _loc_nan_nano / 0001000000000 - (base, micros) = fmap fromIntegral $ _loc_nan_base `divMod` 1000000 - (day , pico ) = fmap (+ frac) $ decompLocalBase (base, toZone _loc_nan_zone) + frac = micros / 1000000 + fromIntegral _ldt_nan_nano / 0001000000000 + (base, micros) = fmap fromIntegral $ _ldt_nan_base `divMod` 1000000 + (day , pico ) = fmap (+ frac) $ decompLocalBase (base, w82tz _ldt_nan_zone) instance Convertible LocalDateTimePicos UTCTime where safeConvert LocalDateTimePicos{..} = Right $ UTCTime julian pico where julian = Cal.ModifiedJulianDay $ toInteger day + 40587 - frac = micros / 1000000 + fromIntegral _loc_pic_pico / 1000000000000 - (base, micros) = fmap fromIntegral $ _loc_pic_base `divMod` 1000000 - (day , pico ) = fmap (+ frac) $ decompLocalBase (base, toZone _loc_pic_zone) + frac = micros / 1000000 + fromIntegral _ldt_pic_pico / 1000000000000 + (base, micros) = fmap fromIntegral $ _ldt_pic_base `divMod` 1000000 + (day , pico ) = fmap (+ frac) $ decompLocalBase (base, w82tz _ldt_pic_zone) instance Convertible Cal.Day LocalDate where safeConvert = Right . check "safeConvert{Data.Time.Calendar.Day,LocalDate}" . - flip LocalDate (fromZone utc) . fromInteger . (subtract 40587) . Cal.toModifiedJulianDay + flip LocalDate (tz2w8 TZ.utc) . fromInteger . (subtract 40587) . Cal.toModifiedJulianDay instance Convertible UTCTime LocalDateTime where safeConvert UTCTime{..} = Right . check "safeConvert{Data.Time.Clock.UTCTime,LocalDateTime}" $ - LocalDateTime base (fromZone utc) + LocalDateTime base (tz2w8 TZ.utc) where base = baseUnixToUTC $ day * 86400 + truncate utctDayTime day = fromInteger (Cal.toModifiedJulianDay utctDay) - 40587 instance Convertible UTCTime LocalDateTimeMillis where safeConvert UTCTime{..} = Right . check "safeConvert{Data.Time.Clock.UTCTime,LocalDateTimeMillis}" $ - LocalDateTimeMillis base (fromZone utc) + LocalDateTimeMillis base (tz2w8 TZ.utc) where base = baseUnixToUTC (day * 86400 + sec) * 0001000 + millis day = fromInteger (Cal.toModifiedJulianDay utctDay) - 40587 (sec , millis) = fmap (truncate . (* 0000001000)) $ properFraction utctDayTime instance Convertible UTCTime LocalDateTimeMicros where safeConvert UTCTime{..} = Right . check "safeConvert{Data.Time.Clock.UTCTime,LocalDateTimeMicros}" $ - LocalDateTimeMicros base (fromZone utc) + LocalDateTimeMicros base (tz2w8 TZ.utc) where base = baseUnixToUTC (day * 86400 + sec) * 1000000 + micros day = fromInteger (Cal.toModifiedJulianDay utctDay) - 40587 (sec , micros) = fmap (truncate . (* 0001000000)) $ properFraction utctDayTime instance Convertible UTCTime LocalDateTimeNanos where safeConvert UTCTime{..} = Right . check "safeConvert{Data.Time.Clock.UTCTime,LocalDateTimeNanos}" $ - LocalDateTimeNanos base nano (fromZone utc) + LocalDateTimeNanos base nano (tz2w8 TZ.utc) where base = baseUnixToUTC (day * 86400 + sec) * 1000000 + micros day = fromInteger (Cal.toModifiedJulianDay utctDay) - 40587 (sec , nanos ) = fmap (truncate . (* 1000000000)) $ properFraction utctDayTime @@ -757,12 +756,30 @@ instance Convertible UTCTime LocalDateTimePicos where safeConvert UTCTime{..} = Right . check "safeConvert{Data.Time.Clock.UTCTime,LocalDateTimePicos}" $ - LocalDateTimePicos base pico (fromZone utc) + LocalDateTimePicos base pico (tz2w8 TZ.utc) where base = baseUnixToUTC (day * 86400 + sec) * 1000000 + micros day = fromInteger (Cal.toModifiedJulianDay utctDay) - 40587 (sec , picos ) = fmap (truncate . (* 1000000000000)) $ properFraction utctDayTime (pico, micros) = swap . fmap fromIntegral $ divMod picos 1000000 +instance Zone LocalDate where + toTimeZone time = flip (set ld_day_zone) time . tz2w8 + +instance Zone LocalDateTime where + toTimeZone time = flip (set ldt_sec_zone) time . tz2w8 + +instance Zone LocalDateTimeMillis where + toTimeZone time = flip (set ldt_mil_zone) time . tz2w8 + +instance Zone LocalDateTimeMicros where + toTimeZone time = flip (set ldt_mic_zone) time . tz2w8 + +instance Zone LocalDateTimeNanos where + toTimeZone time = flip (set ldt_nan_zone) time . tz2w8 + +instance Zone LocalDateTimePicos where + toTimeZone time = flip (set ldt_pic_zone) time . tz2w8 + instance DateZone LocalDate where toDateZoneStruct = decompLocalDate fromDateZoneStruct DateZoneStruct{..} = @@ -793,8 +810,6 @@ fromDateZoneStruct DateZoneStruct{..} = createLocalDateTimePicos _dz_year _dz_mon _dz_mday 0 0 0 0 _dz_zone -deriving instance DateZone Transition - instance DateTimeZone LocalDateTime where toDateTimeZoneStruct = decompLocalDateTime fromDateTimeZoneStruct DateTimeZoneStruct{..} = @@ -825,20 +840,18 @@ createLocalDateTimePicos _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec pic _dtz_zone where (sec, pic) = properFracPicos _dtz_sec -deriving instance DateTimeZone Transition - instance Show LocalDate where show date = printf str _dz_year mon _dz_mday abbr where DateZoneStruct{..} = toDateZoneStruct date str = "%04d-%02d-%02d %s" mon = fromEnum _dz_mon + 1 - abbr = show $ abbreviate _dz_zone + abbr = show $ TZ.abbreviate _dz_zone instance Show LocalDateTime where show time = printf str _dtz_year mon _dtz_mday _dtz_hour _dtz_min sec abbr where DateTimeZoneStruct{..} = toDateTimeZoneStruct time str = "%04d-%02d-%02d %02d:%02d:%02d %s" - abbr = show $ abbreviate _dtz_zone + abbr = show $ TZ.abbreviate _dtz_zone mon = fromEnum _dtz_mon + 1 sec = round _dtz_sec :: Second @@ -846,7 +859,7 @@ show time = printf str _dtz_year mon _dtz_mday _dtz_hour _dtz_min sec mil abbr where DateTimeZoneStruct{..} = toDateTimeZoneStruct time str = "%04d-%02d-%02d %02d:%02d:%02d.%03d %s" - abbr = show $ abbreviate _dtz_zone + abbr = show $ TZ.abbreviate _dtz_zone mon = fromEnum _dtz_mon + 1 (sec, mil) = properFracMillis _dtz_sec @@ -854,7 +867,7 @@ show time = printf str _dtz_year mon _dtz_mday _dtz_hour _dtz_min sec mic abbr where DateTimeZoneStruct{..} = toDateTimeZoneStruct time str = "%04d-%02d-%02d %02d:%02d:%02d.%06d %s" - abbr = show $ abbreviate _dtz_zone + abbr = show $ TZ.abbreviate _dtz_zone mon = fromEnum _dtz_mon + 1 (sec, mic) = properFracMicros _dtz_sec @@ -862,7 +875,7 @@ show time = printf str _dtz_year mon _dtz_mday _dtz_hour _dtz_min sec nan abbr where DateTimeZoneStruct{..} = toDateTimeZoneStruct time str = "%04d-%02d-%02d %02d:%02d:%02d.%09d %s" - abbr = show $ abbreviate _dtz_zone + abbr = show $ TZ.abbreviate _dtz_zone mon = fromEnum _dtz_mon + 1 (sec, nan) = properFracNanos _dtz_sec @@ -870,7 +883,7 @@ show time = printf str _dtz_year mon _dtz_mday _dtz_hour _dtz_min sec pic abbr where DateTimeZoneStruct{..} = toDateTimeZoneStruct time str = "%04d-%02d-%02d %02d:%02d:%02d.%012d %s" - abbr = show $ abbreviate _dtz_zone + abbr = show $ TZ.abbreviate _dtz_zone mon = fromEnum _dtz_mon + 1 (sec, pic) = properFracPicos _dtz_sec @@ -882,9 +895,9 @@ nextLeap = Nothing -- | Get a list of time zone transition times for the given city. -getTransitions :: City -> IO [Transition] +getTransitions :: TZ.City -> IO [Transition] getTransitions city = do - let file = getOlsonFile city + let file = TZ.getOlsonFile city Olson.OlsonData{..} <- Olson.getOlsonFromFile file let ttimes = uniquetimes $ sortBy future2past olsonTransitions return $! foldr (step olsonTypes) [] $ map last ttimes @@ -895,12 +908,12 @@ then [Transition (LocalDateTime 43200 zone)] else Transition (LocalDateTime base zone) : accum where Olson.TtInfo{..} = types !! transIndex - abbr = TimeZoneAbbr city tt_abbr + abbr = TZ.TimeZoneAbbr city tt_abbr base = baseUnixToUTC $ fromIntegral transTime - zone = fromZone $ unabbreviate abbr + zone = tz2w8 $ TZ.unabbreviate abbr -- | Get the last time zone transition time for the given city and time. -lastTransition :: (DateTime dt, Unix dt) => City -> dt -> IO (Maybe Transition) +lastTransition :: (DateTime dt, Unix dt) => TZ.City -> dt -> IO (Maybe Transition) lastTransition city time = do ttimes <- getTransitions city return $! listToMaybe $ dropWhile f ttimes @@ -912,7 +925,7 @@ -- > >>> getCurrentLocalDate London -- > 2013-11-03 GMT -- -getCurrentLocalDate :: City -> IO LocalDate +getCurrentLocalDate :: TZ.City -> IO LocalDate getCurrentLocalDate city = getTransitions city >>= getCurrentLocalDateTime' >>= return . convert -- | Get the current local date from the system clock using preloaded transition times. @@ -931,7 +944,7 @@ -- > >>> getCurrentLocalDateTime New_York -- > 2013-11-03 16:38:16 EST -- -getCurrentLocalDateTime :: City -> IO LocalDateTime +getCurrentLocalDateTime :: TZ.City -> IO LocalDateTime getCurrentLocalDateTime city = getTransitions city >>= getCurrentLocalDateTime' -- | Get the current local date and time from the system clock using preloaded transition @@ -946,13 +959,13 @@ getCurrentLocalDateTime' :: [Transition] -> IO LocalDateTime getCurrentLocalDateTime' ttimes = do time@UnixDateTime{..} <- getCurrentUnixDateTime - let base = baseUnixToUTC _uni_sec_base + let base = baseUnixToUTC _udt_sec_base f tt = localBase tt > base mval = listToMaybe $ dropWhile f ttimes - zone = maybe (fromZone utc) localZone mval + zone = maybe (tz2w8 TZ.utc) localZone mval if maybe True (/= convert time) nextLeap then return $! LocalDateTime base zone - else let leap = round (realToFrac (_uni_sec_base `mod` 86400) / 86400 :: Double) + else let leap = round (realToFrac (_udt_sec_base `mod` 86400) / 86400 :: Double) in return $! LocalDateTime base zone `plus` Second leap -- | Get the current local date and time with millisecond granularity from the system clock. @@ -960,7 +973,7 @@ -- > >>> getCurrentLocalDateTimeMillis Auckland -- > 2013-11-04 10:46:13.123 NZDT -- -getCurrentLocalDateTimeMillis :: City -> IO LocalDateTimeMillis +getCurrentLocalDateTimeMillis :: TZ.City -> IO LocalDateTimeMillis getCurrentLocalDateTimeMillis city = getTransitions city >>= getCurrentLocalDateTimeMillis' -- | Get the current local date and time with millisecond granularity from the system clock @@ -976,14 +989,14 @@ getCurrentLocalDateTimeMillis' :: [Transition] -> IO LocalDateTimeMillis getCurrentLocalDateTimeMillis' ttimes = do time@UnixDateTimeMillis{..} <- getCurrentUnixDateTimeMillis - let (seconds, millis) = first baseUnixToUTC $ _uni_mil_base `divMod` 1000 + let (seconds, millis) = first baseUnixToUTC $ _udt_mil_base `divMod` 1000 f tt = localBase tt > seconds mval = listToMaybe $ dropWhile f ttimes - zone = maybe (fromZone utc) localZone mval + zone = maybe (tz2w8 TZ.utc) localZone mval base = seconds * 1000 + millis if maybe True (/= convert time) nextLeap then return $! LocalDateTimeMillis base zone - else let leap = round (realToFrac (_uni_mil_base `mod` 86400) / 86.4 :: Double) + else let leap = round (realToFrac (_udt_mil_base `mod` 86400) / 86.4 :: Double) in return $! LocalDateTimeMillis base zone `plus` Millis leap -- | Get the current local date and time with microsecond granularity from the system clock. @@ -991,7 +1004,7 @@ -- > >>> getCurrentLocalDateTimeMicros Tel_Aviv -- > 2013-11-03 23:55:30.935387 IST -- -getCurrentLocalDateTimeMicros :: City -> IO LocalDateTimeMicros +getCurrentLocalDateTimeMicros :: TZ.City -> IO LocalDateTimeMicros getCurrentLocalDateTimeMicros city = getTransitions city >>= getCurrentLocalDateTimeMicros' -- | Get the current local date and time with microsecond granularity from the system clock @@ -1007,14 +1020,14 @@ getCurrentLocalDateTimeMicros' :: [Transition] -> IO LocalDateTimeMicros getCurrentLocalDateTimeMicros' ttimes = do time@UnixDateTimeMicros{..} <- getCurrentUnixDateTimeMicros - let (seconds, micros) = first baseUnixToUTC $ _uni_mic_base `divMod` 1000000 + let (seconds, micros) = first baseUnixToUTC $ _udt_mic_base `divMod` 1000000 f tt = localBase tt > seconds mval = listToMaybe $ dropWhile f ttimes - zone = maybe (fromZone utc) localZone mval + zone = maybe (tz2w8 TZ.utc) localZone mval base = seconds * 1000000 + micros if maybe True (/= convert time) nextLeap then return $! LocalDateTimeMicros base zone - else let leap = round (realToFrac (_uni_mic_base `mod` 86400) / 0.0864 :: Double) + else let leap = round (realToFrac (_udt_mic_base `mod` 86400) / 0.0864 :: Double) in return $! LocalDateTimeMicros base zone `plus` Micros leap -- | Get the current local date and time with nanosecond granularity from the system clock. @@ -1024,7 +1037,7 @@ -- -- Note that this functions calls @gettimeofday@ behind the scenes. Therefore, the resultant -- timestamp will have nanosecond granularity, but only microsecond resolution. -getCurrentLocalDateTimeNanos :: City -> IO LocalDateTimeNanos +getCurrentLocalDateTimeNanos :: TZ.City -> IO LocalDateTimeNanos getCurrentLocalDateTimeNanos city = getTransitions city >>= getCurrentLocalDateTimeNanos' -- | Get the current local date and time with nanosecond granularity from the system clock @@ -1043,15 +1056,15 @@ getCurrentLocalDateTimeNanos' :: [Transition] -> IO LocalDateTimeNanos getCurrentLocalDateTimeNanos' ttimes = do time@UnixDateTimeNanos{..} <- getCurrentUnixDateTimeNanos - let (seconds, micros) = first baseUnixToUTC $ _uni_nan_base `divMod` 1000000 + let (seconds, micros) = first baseUnixToUTC $ _udt_nan_base `divMod` 1000000 f tt = localBase tt > seconds mval = listToMaybe $ dropWhile f ttimes - zone = maybe (fromZone utc) localZone mval + zone = maybe (tz2w8 TZ.utc) localZone mval base = seconds * 1000000 + micros if maybe True (/= convert time) nextLeap - then return $! LocalDateTimeNanos base _uni_nan_nano zone - else let leap = round (realToFrac (_uni_nan_base `mod` 86400) / 0.0000864 :: Double) - in return $! LocalDateTimeNanos base _uni_nan_nano zone `plus` Nanos leap + then return $! LocalDateTimeNanos base _udt_nan_nano zone + else let leap = round (realToFrac (_udt_nan_base `mod` 86400) / 0.0000864 :: Double) + in return $! LocalDateTimeNanos base _udt_nan_nano zone `plus` Nanos leap -- | Get the current local date and time with picosecond granularity from the system clock. -- @@ -1060,7 +1073,7 @@ -- -- Note that this functions calls @gettimeofday@ behind the scenes. Therefore, the resultant -- timestamp will have picosecond granularity, but only microsecond resolution. -getCurrentLocalDateTimePicos :: City -> IO LocalDateTimePicos +getCurrentLocalDateTimePicos :: TZ.City -> IO LocalDateTimePicos getCurrentLocalDateTimePicos city = getTransitions city >>= getCurrentLocalDateTimePicos' -- | Get the current local date and time with picosecond granularity from the system clock using @@ -1079,33 +1092,33 @@ getCurrentLocalDateTimePicos' :: [Transition] -> IO LocalDateTimePicos getCurrentLocalDateTimePicos' ttimes = do time@UnixDateTimePicos{..} <- getCurrentUnixDateTimePicos - let (seconds, micros) = first baseUnixToUTC $ _uni_pic_base `divMod` 1000000 + let (seconds, micros) = first baseUnixToUTC $ _udt_pic_base `divMod` 1000000 f tt = localBase tt > seconds mval = listToMaybe $ dropWhile f ttimes - zone = maybe (fromZone utc) localZone mval + zone = maybe (tz2w8 TZ.utc) localZone mval base = seconds * 1000000 + micros if maybe True (/= convert time) nextLeap - then return $! LocalDateTimePicos base _uni_pic_pico zone - else let picos = round (realToFrac (_uni_pic_base `mod` 86400) / 0.0000000864 :: Double) - in return $! LocalDateTimePicos base _uni_pic_pico zone `plus` Picos picos + then return $! LocalDateTimePicos base _udt_pic_pico zone + else let picos = round (realToFrac (_udt_pic_base `mod` 86400) / 0.0000000864 :: Double) + in return $! LocalDateTimePicos base _udt_pic_pico zone `plus` Picos picos -- | Convert a local date and time with nanosecond granularity into an integer. -fromLocalDateTimeNanos :: LocalDateTimeNanos -> Integer -fromLocalDateTimeNanos (LocalDateTimeNanos base nano _) = toInteger base * 1000 + toInteger nano +fromNanos :: LocalDateTimeNanos -> Integer +fromNanos (LocalDateTimeNanos base nano _) = toInteger base * 1000 + toInteger nano -- | Convert an integer into a local date and time with nanosecond granularity. -toLocalDateTimeNanos :: Integer -> (Word8 -> LocalDateTimeNanos) -toLocalDateTimeNanos n = LocalDateTimeNanos base nano - where (base, nano) = doubleIntegral $ n `divMod` 1000 +toNanos :: Integer -> (Word8 -> LocalDateTimeNanos) +toNanos n = LocalDateTimeNanos base nano + where (base, nano) = doubleInt $ n `divMod` 1000 -- | Convert a local date and time with picosecond granularity into an integer. -fromLocalDateTimePicos :: LocalDateTimePicos -> Integer -fromLocalDateTimePicos (LocalDateTimePicos base pico _) = toInteger base * 1000000 + toInteger pico +fromPicos :: LocalDateTimePicos -> Integer +fromPicos (LocalDateTimePicos base pico _) = toInteger base * 1000000 + toInteger pico -- | Convert an integer into a local date and time with picosecond granularity. -toLocalDateTimePicos :: Integer -> (Word8 -> LocalDateTimePicos) -toLocalDateTimePicos n = LocalDateTimePicos base pico - where (base, pico) = doubleIntegral $ n `divMod` 1000000 +toPicos :: Integer -> (Word8 -> LocalDateTimePicos) +toPicos n = LocalDateTimePicos base pico + where (base, pico) = doubleInt $ n `divMod` 1000000 instance Duration LocalDate Day where duration (LocalDate old _) (LocalDate new _) = Day (new - old) @@ -1150,69 +1163,67 @@ duration old new = if res < toInteger (maxBound::Int64) then Nanos $ fromInteger res else error "duration{LocalDateTimeNanos,Nanos}: integer overflow" - where res = fromLocalDateTimeNanos new - fromLocalDateTimeNanos old + where res = fromNanos new - fromNanos old instance Duration LocalDateTimePicos Nanos where duration old new = if res < toInteger (maxBound::Int64) then Nanos $ fromInteger res `div` 1000 else error "duration{LocalDateTimePicos,Nanos}: integer overflow" - where res = fromLocalDateTimePicos new - fromLocalDateTimePicos old + where res = fromPicos new - fromPicos old instance Duration LocalDateTimePicos Picos where duration old new = if res < toInteger (maxBound::Int64) then Picos $ fromInteger res else error "duration{LocalDateTimePicos,Picos}: integer overflow" - where res = fromLocalDateTimePicos new - fromLocalDateTimePicos old + where res = fromPicos new - fromPicos old instance Random LocalDate where random g = - case randomR (0,2932896) g of { (base, g' ) -> - case randomR (0,maxZone) g' of { (zone, g'') -> (LocalDate base zone, g'') } } + case randomR (0, 2932896) g of { (base, g' ) -> + case randomR (0, maxzone) g' of { (zone, g'') -> (LocalDate base zone, g'') } } randomR (a,b) g = - case randomR (get loc_day_base a, get loc_day_base b) g of { (base, g' ) -> - case randomR (get loc_day_zone a, get loc_day_zone b) g' of { (zone, g'') -> (LocalDate base zone, g'') } } + case randomR (get ld_day_base a, get ld_day_base b) g of { (base, g' ) -> + case randomR (get ld_day_zone a, get ld_day_zone b) g' of { (zone, g'') -> (LocalDate base zone, g'') } } instance Random LocalDateTime where random g = - case randomR (43200,253402257624) g of { (base, g' ) -> - case randomR ( 0, maxZone) g' of { (zone, g'') -> (LocalDateTime base zone, g'') } } + case randomR (43200, 253402257624) g of { (base, g' ) -> + case randomR ( 0, maxzone) g' of { (zone, g'') -> (LocalDateTime base zone, g'') } } randomR (a,b) g = - case randomR (get loc_sec_base a, get loc_sec_base b) g of { (base, g' ) -> - case randomR (get loc_sec_zone a, get loc_sec_zone b) g' of { (zone, g'') -> (LocalDateTime base zone, g'') } } + case randomR (get ldt_sec_base a, get ldt_sec_base b) g of { (base, g' ) -> + case randomR (get ldt_sec_zone a, get ldt_sec_zone b) g' of { (zone, g'') -> (LocalDateTime base zone, g'') } } instance Random LocalDateTimeMillis where random g = - case randomR (43200,253402257624999) g of { (base, g' ) -> - case randomR ( 0, maxZone) g' of { (zone, g'') -> (LocalDateTimeMillis base zone, g'') } } + case randomR (43200, 253402257624999) g of { (base, g' ) -> + case randomR ( 0, maxzone) g' of { (zone, g'') -> (LocalDateTimeMillis base zone, g'') } } randomR (a,b) g = - case randomR (get loc_mil_base a, get loc_mil_base b) g of { (base, g' ) -> - case randomR (get loc_mil_zone a, get loc_mil_zone b) g' of { (zone, g'') -> (LocalDateTimeMillis base zone, g'') } } + case randomR (get ldt_mil_base a, get ldt_mil_base b) g of { (base, g' ) -> + case randomR (get ldt_mil_zone a, get ldt_mil_zone b) g' of { (zone, g'') -> (LocalDateTimeMillis base zone, g'') } } instance Random LocalDateTimeMicros where random g = - case randomR (43200,253402257624999999) g of { (base, g' ) -> - case randomR ( 0, maxZone) g' of { (zone, g'') -> (LocalDateTimeMicros base zone, g'') } } + case randomR (43200, 253402257624999999) g of { (base, g' ) -> + case randomR ( 0, maxzone) g' of { (zone, g'') -> (LocalDateTimeMicros base zone, g'') } } randomR (a,b) g = - case randomR (get loc_mic_base a, get loc_mic_base b) g of { (base, g' ) -> - case randomR (get loc_mic_zone a, get loc_mic_zone b) g' of { (zone, g'') -> (LocalDateTimeMicros base zone, g'') } } + case randomR (get ldt_mic_base a, get ldt_mic_base b) g of { (base, g' ) -> + case randomR (get ldt_mic_zone a, get ldt_mic_zone b) g' of { (zone, g'') -> (LocalDateTimeMicros base zone, g'') } } instance Random LocalDateTimeNanos where random g = - case randomR (43200,253402257624999999999) g of { (base, g' ) -> - case randomR ( 0, maxZone) g' of { (zone, g'') -> (toLocalDateTimeNanos base zone, g'') } } + case randomR (43200, 253402257624999999999) g of { (base, g' ) -> + case randomR ( 0, maxzone) g' of { (zone, g'') -> (toNanos base zone, g'') } } randomR (a,b) g = - case randomR (fromLocalDateTimeNanos a, fromLocalDateTimeNanos b) g of { (base, g' ) -> - case randomR ( get loc_nan_zone a, get loc_nan_zone b) g' of { (zone, g'') -> (toLocalDateTimeNanos base zone, g'') } } + case randomR (fromNanos a, fromNanos b) g of { (base, g' ) -> + case randomR (get ldt_nan_zone a, get ldt_nan_zone b) g' of { (zone, g'') -> (toNanos base zone, g'') } } instance Random LocalDateTimePicos where random g = - case randomR (43200,253402257624999999999999) g of { (base, g' ) -> - case randomR ( 0, maxZone) g' of { (zone, g'') -> (toLocalDateTimePicos base zone, g'') } } + case randomR (43200, 253402257624999999999999) g of { (base, g' ) -> + case randomR ( 0, maxzone) g' of { (zone, g'') -> (toPicos base zone, g'') } } randomR (a,b) g = - case randomR (fromLocalDateTimePicos a, fromLocalDateTimePicos b) g of { (base, g' ) -> - case randomR ( get loc_pic_zone a, get loc_pic_zone b) g' of { (zone, g'') -> (toLocalDateTimePicos base zone, g'') } } - -deriving instance Random Transition + case randomR (fromPicos a, fromPicos b) g of { (base, g' ) -> + case randomR (get ldt_pic_zone a, get ldt_pic_zone b) g' of { (zone, g'') -> (toPicos base zone, g'') } } -- | Show a local date as a pretty string. -- @@ -1226,7 +1237,7 @@ wday = show _dz_wday mon = show _dz_mon mday = show _dz_mday ++ showSuffix _dz_mday - abbr = show $ abbreviate _dz_zone + abbr = show $ TZ.abbreviate _dz_zone -- | Show a local date and time as a pretty string. -- @@ -1241,41 +1252,23 @@ wday = show _dtz_wday mon = show _dtz_mon mday = show _dtz_mday ++ showSuffix _dtz_mday - abbr = show $ abbreviate _dtz_zone + abbr = show $ TZ.abbreviate _dtz_zone ampm = showPeriod _dtz_hour hour | _dtz_hour == 00 = 12 | _dtz_hour <= 12 = _dtz_hour | otherwise = _dtz_hour - 12 -instance Zone LocalDate where - rezone time = flip (set loc_day_zone) time . fromZone - -instance Zone LocalDateTime where - rezone time = flip (set loc_sec_zone) time . fromZone - -instance Zone LocalDateTimeMillis where - rezone time = flip (set loc_mil_zone) time . fromZone - -instance Zone LocalDateTimeMicros where - rezone time = flip (set loc_mic_zone) time . fromZone - -instance Zone LocalDateTimeNanos where - rezone time = flip (set loc_nan_zone) time . fromZone - -instance Zone LocalDateTimePicos where - rezone time = flip (set loc_pic_zone) time . fromZone - -- | Maximum enumerated time zone value. -maxZone :: Word8 -maxZone = fromZone maxBound +maxzone :: Word8 +maxzone = tz2w8 maxBound -- | Convert an integral type into a time zone. -toZone :: Word8 -> TimeZone -toZone = toEnum . fromIntegral +w82tz :: Word8 -> TZ.TimeZone +w82tz = toEnum . fromIntegral -- | Convert a time zone into a numeric value. -fromZone :: TimeZone -> Word8 -fromZone = fromIntegral . fromEnum +tz2w8 :: TZ.TimeZone -> Word8 +tz2w8 = fromIntegral . fromEnum -- | Perform a bounds check on the given local timestamp. check :: forall a . Bounded a => Local a => Ord a => String -> a -> a @@ -1286,5 +1279,5 @@ bounds = show (localBase (minBound::a)) ++ "," ++ show (localBase (maxBound::a)) -- | Coerce a tuple of integral types. -doubleIntegral :: (Integral a, Integral b, Num c, Num d) => (a, b) -> (c, d) -doubleIntegral = fromIntegral *** fromIntegral +doubleInt :: (Integral a, Integral b, Num c, Num d) => (a, b) -> (c, d) +doubleInt = fromIntegral *** fromIntegral diff --git a/src/Data/Time/Exts/Test.hs b/src/Data/Time/Exts/Test.hs --- a/src/Data/Time/Exts/Test.hs +++ b/src/Data/Time/Exts/Test.hs @@ -25,6 +25,21 @@ instance Arbitrary UnixDate where arbitrary = choose (minBound, maxBound) +instance Arbitrary UnixTime where + arbitrary = choose (minBound, maxBound) + +instance Arbitrary UnixTimeMillis where + arbitrary = choose (minBound, maxBound) + +instance Arbitrary UnixTimeMicros where + arbitrary = choose (minBound, maxBound) + +instance Arbitrary UnixTimeNanos where + arbitrary = choose (minBound, maxBound) + +instance Arbitrary UnixTimePicos where + arbitrary = choose (minBound, maxBound) + instance Arbitrary UnixDateTime where arbitrary = choose (minBound, maxBound) @@ -113,14 +128,19 @@ test6 :: (Convertible x Calendar.Day, Convertible Calendar.Day x, Eq x, Show x, Zone x) => x -> Bool test6 x | x' == convert (convert x' :: Calendar.Day) = True | otherwise = error $ "test6: " ++ show x' - where x' = rezone x utc + where x' = x `toTimeZone` utc -- | Test utc time conversions. test7 :: (Convertible x UTCTime, Convertible UTCTime x, Eq x, Show x, Zone x) => x -> Bool test7 x | x' == convert (convert x' :: UTCTime) = True | otherwise = error $ "test7: " ++ show x' - where x' = rezone x utc + where x' = x `toTimeZone` utc +-- | Test Unix time struct conversions. +test8 :: (Eq x, Time x, Show x, Unix x) => x -> Bool +test8 x | x == fromTimeStruct (toTimeStruct x) = True + | otherwise = error $ "test8: " ++ show x + -- | Test properties. main :: IO () main = do @@ -147,3 +167,8 @@ quickCheck (test7 :: LocalDateTimeMicros -> Bool) quickCheck (test7 :: LocalDateTimeNanos -> Bool) quickCheck (test7 :: LocalDateTimePicos -> Bool) + quickCheck (test8 :: UnixTime -> Bool) + quickCheck (test8 :: UnixTimeMillis -> Bool) + quickCheck (test8 :: UnixTimeMicros -> Bool) + quickCheck (test8 :: UnixTimeNanos -> Bool) + quickCheck (test8 :: UnixTimePicos -> Bool) diff --git a/src/Data/Time/Exts/Unix.hs b/src/Data/Time/Exts/Unix.hs --- a/src/Data/Time/Exts/Unix.hs +++ b/src/Data/Time/Exts/Unix.hs @@ -20,865 +20,1515 @@ -- ** Unix Timestamps , UnixDate(..) - , UnixDateTime(..) - , UnixDateTimeMillis(..) - , UnixDateTimeMicros(..) - , UnixDateTimeNanos(..) - , UnixDateTimePicos(..) - - -- ** Create Unix Timestamps - , createUnixDate - , createUnixDateTime - , createUnixDateTimeMillis - , createUnixDateTimeMicros - , createUnixDateTimeNanos - , createUnixDateTimePicos - - -- ** Get Current Unix Timestamps - , getCurrentUnixDate - , getCurrentUnixDateTime - , getCurrentUnixDateTimeMillis - , getCurrentUnixDateTimeMicros - , getCurrentUnixDateTimeNanos - , getCurrentUnixDateTimePicos - - -- ** Pretty Unix Timestamps - , prettyUnixDate - , prettyUnixDateTime - - ) where - -import Control.Arrow ((***), first) -import Control.DeepSeq (NFData) -import Data.Aeson (FromJSON, ToJSON) -import Data.Convertible (Convertible(..), convert) -import Data.Int (Int16, Int32, Int64) -import Data.Label (get, mkLabels, modify) -import Data.Time.Exts.Base -import Data.Time.Exts.C -import Data.Typeable (Typeable) -import Foreign.C.Types (CLong(..)) -import Foreign.Marshal.Utils (with) -import Foreign.Ptr (castPtr, nullPtr, plusPtr) -import Foreign.Storable (Storable(..)) -import GHC.Generics (Generic) -import System.Random (Random(..)) -import Text.Printf (printf) - --- | The Unix timestamp type class. -class Unix u where - - -- | Get the base component of a Unix timestamp. - unixBase :: u -> Int64 - - -- | Get the normalized base component of a Unix timestamp. - unixNorm :: u -> Int64 - --- | Days since Unix epoch. -newtype UnixDate = UnixDate { - _uni_day_base :: Int32 - } deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable) - --- | Seconds since Unix epoch (excluding leap seconds). -newtype UnixDateTime = UnixDateTime { - _uni_sec_base :: Int64 - } deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable) - --- | Milliseconds since Unix epoch (excluding leap seconds). -newtype UnixDateTimeMillis = UnixDateTimeMillis { - _uni_mil_base :: Int64 - } deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable) - --- | Microseconds since Unix epoch (excluding leap seconds). -newtype UnixDateTimeMicros = UnixDateTimeMicros { - _uni_mic_base :: Int64 - } deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable) - --- | Nanoseconds since Unix epoch (excluding leap seconds). -data UnixDateTimeNanos = UnixDateTimeNanos { - _uni_nan_base :: {-# UNPACK #-} !Int64 - , _uni_nan_nano :: {-# UNPACK #-} !Int16 - } deriving (Eq,Generic,Ord,Typeable) - --- | Picoseconds since Unix epoch (excluding leap seconds). -data UnixDateTimePicos = UnixDateTimePicos { - _uni_pic_base :: {-# UNPACK #-} !Int64 - , _uni_pic_pico :: {-# UNPACK #-} !Int32 - } deriving (Eq,Generic,Ord,Typeable) - -instance FromJSON UnixDateTimeNanos -instance FromJSON UnixDateTimePicos - -instance NFData UnixDateTimeNanos -instance NFData UnixDateTimePicos - -instance Storable UnixDateTimeNanos where - sizeOf _ = 10 - alignment = sizeOf - peekElemOff ptr n = do - let off = 10 * n - base <- peek . plusPtr ptr $ off - nano <- peek . plusPtr ptr $ off + 8 - return $! UnixDateTimeNanos base nano - pokeElemOff ptr n UnixDateTimeNanos{..} = do - let off = 10 * n - poke (plusPtr ptr $ off ) _uni_nan_base - poke (plusPtr ptr $ off + 8) _uni_nan_nano - -instance Storable UnixDateTimePicos where - sizeOf _ = 12 - alignment = sizeOf - peekElemOff ptr n = do - let off = 12 * n - base <- peek . plusPtr ptr $ off - pico <- peek . plusPtr ptr $ off + 8 - return $! UnixDateTimePicos base pico - pokeElemOff ptr n UnixDateTimePicos{..} = do - let off = 12 * n - poke (plusPtr ptr $ off ) _uni_pic_base - poke (plusPtr ptr $ off + 8) _uni_pic_pico - -instance ToJSON UnixDateTimeNanos -instance ToJSON UnixDateTimePicos - -mkLabels [ ''DateTimeStruct - , ''UnixDate - , ''UnixDateTime - , ''UnixDateTimeMillis - , ''UnixDateTimeMicros - , ''UnixDateTimeNanos - , ''UnixDateTimePicos - ] - -instance Bounded UnixDate where - minBound = UnixDate 0 - maxBound = UnixDate 2932896 - -instance Bounded UnixDateTime where - minBound = UnixDateTime 0 - maxBound = UnixDateTime 253402300799 - -instance Bounded UnixDateTimeMillis where - minBound = UnixDateTimeMillis 0 - maxBound = UnixDateTimeMillis 253402300799999 - -instance Bounded UnixDateTimeMicros where - minBound = UnixDateTimeMicros 0 - maxBound = UnixDateTimeMicros 253402300799999999 - -instance Bounded UnixDateTimeNanos where - minBound = UnixDateTimeNanos 0 0 - maxBound = UnixDateTimeNanos 253402300799999999 999 - -instance Bounded UnixDateTimePicos where - minBound = UnixDateTimePicos 0 0 - maxBound = UnixDateTimePicos 253402300799999999 999999 - -instance Unix UnixDate where - unixBase = fromIntegral . get uni_day_base - unixNorm = unixBase - -instance Unix UnixDateTime where - unixBase = get uni_sec_base - unixNorm = unixBase - -instance Unix UnixDateTimeMillis where - unixBase = get uni_mil_base - unixNorm = flip div 1000 . unixBase - -instance Unix UnixDateTimeMicros where - unixBase = get uni_mic_base - unixNorm = flip div 1000000 . unixBase - -instance Unix UnixDateTimeNanos where - unixBase = get uni_nan_base - unixNorm = flip div 1000000 . unixBase - -instance Unix UnixDateTimePicos where - unixBase = get uni_pic_base - unixNorm = flip div 1000000 . unixBase - -instance DateTimeMath UnixDate Day where - date `plus` Day day = - check "plus{UnixDate,Day}" $ - modify uni_day_base (+ day) date - -instance DateTimeMath UnixDateTime Day where - time `plus` Day day = - check "plus{UnixDateTime,Day}" $ - modify uni_sec_base (+ fromIntegral day * 86400) time - -instance DateTimeMath UnixDateTimeMillis Day where - time `plus` Day day = - check "plus{UnixDateTimeMillis,Day}" $ - modify uni_mil_base (+ fromIntegral day * 86400000) time - -instance DateTimeMath UnixDateTimeMicros Day where - time `plus` Day day = - check "plus{UnixDateTimeMicros,Day}" $ - modify uni_mic_base (+ fromIntegral day * 86400000000) time - -instance DateTimeMath UnixDateTimeNanos Day where - time `plus` Day day = - check "plus{UnixDateTimeNanos,Day}" $ - modify uni_nan_base (+ fromIntegral day * 86400000000) time - -instance DateTimeMath UnixDateTimePicos Day where - time `plus` Day day = - check "plus{UnixDateTimePicos,Day}" $ - modify uni_pic_base (+ fromIntegral day * 86400000000) time - -instance DateTimeMath UnixDateTime Hour where - time `plus` Hour hour = - check "plus{UnixDateTime,Hour}" $ - modify uni_sec_base (+ hour * 3600) time - -instance DateTimeMath UnixDateTimeMillis Hour where - time `plus` Hour hour = - check "plus{UnixDateTimeMillis,Hour}" $ - modify uni_mil_base (+ hour * 3600000) time - -instance DateTimeMath UnixDateTimeMicros Hour where - time `plus` Hour hour = - check "plus{UnixDateTimeMicros,Hour}" $ - modify uni_mic_base (+ hour * 3600000000) time - -instance DateTimeMath UnixDateTimeNanos Hour where - time `plus` Hour hour = - check "plus{UnixDateTimeNanos,Hour}" $ - modify uni_nan_base (+ hour * 3600000000) time - -instance DateTimeMath UnixDateTimePicos Hour where - time `plus` Hour hour = - check "plus{UnixDateTimePicos,Hour}" $ - modify uni_pic_base (+ hour * 3600000000) time - -instance DateTimeMath UnixDateTime Minute where - time `plus` Minute minute = - check "plus{UnixDateTime,Minute}" $ - modify uni_sec_base (+ minute * 60) time - -instance DateTimeMath UnixDateTimeMillis Minute where - time `plus` Minute minute = - check "plus{UnixDateTimeMillis,Minute}" $ - modify uni_mil_base (+ minute * 60000) time - -instance DateTimeMath UnixDateTimeMicros Minute where - time `plus` Minute minute = - check "plus{UnixDateTimeMicros,Minute}" $ - modify uni_mic_base (+ minute * 60000000) time - -instance DateTimeMath UnixDateTimeNanos Minute where - time `plus` Minute minute = - check "plus{UnixDateTimeNanos,Minute}" $ - modify uni_nan_base (+ minute * 60000000) time - -instance DateTimeMath UnixDateTimePicos Minute where - time `plus` Minute minute = - check "plus{UnixDateTimePicos,Minute}" $ - modify uni_pic_base (+ minute * 60000000) time - -instance DateTimeMath UnixDateTime Second where - time `plus` Second second = - check "plus{UnixDateTime,Second}" $ - modify uni_sec_base (+ second) time - -instance DateTimeMath UnixDateTimeMillis Second where - time `plus` Second second = - check "plus{UnixDateTimeMillis,Second}" $ - modify uni_mil_base (+ second * 1000) time - -instance DateTimeMath UnixDateTimeMicros Second where - time `plus` Second second = - check "plus{UnixDateTimeMicros,Second}" $ - modify uni_mic_base (+ second * 1000000) time - -instance DateTimeMath UnixDateTimeNanos Second where - time `plus` Second second = - check "plus{UnixDateTimeNanos,Second}" $ - modify uni_nan_base (+ second * 1000000) time - -instance DateTimeMath UnixDateTimePicos Second where - time `plus` Second second = - check "plus{UnixDateTimePicos,Second}" $ - modify uni_pic_base (+ second * 1000000) time - -instance DateTimeMath UnixDateTimeMillis Millis where - time `plus` Millis millis = - check "plus{UnixDateTimeMillis,Millis}" $ - modify uni_mil_base (+ millis) time - -instance DateTimeMath UnixDateTimeMicros Millis where - time `plus` Millis millis = - check "plus{UnixDateTimeMicros,Millis}" $ - modify uni_mic_base (+ millis * 1000) time - -instance DateTimeMath UnixDateTimeNanos Millis where - time `plus` Millis millis = - check "plus{UnixDateTimeNanos,Millis}" $ - modify uni_nan_base (+ millis * 1000) time - -instance DateTimeMath UnixDateTimePicos Millis where - time `plus` Millis millis = - check "plus{UnixDateTimePicos,Millis}" $ - modify uni_pic_base (+ millis * 1000) time - -instance DateTimeMath UnixDateTimeMicros Micros where - time `plus` Micros micros = - check "plus{UnixDateTimeMicros,Micros}" $ - modify uni_mic_base (+ micros) time - -instance DateTimeMath UnixDateTimeNanos Micros where - time `plus` Micros micros = - check "plus{UnixDateTimeNanos,Micros}" $ - modify uni_nan_base (+ micros) time - -instance DateTimeMath UnixDateTimePicos Micros where - time `plus` Micros micros = - check "plus{UnixDateTimePicos,Micros}" $ - modify uni_pic_base (+ micros) time - -instance DateTimeMath UnixDateTimeNanos Nanos where - UnixDateTimeNanos{..} `plus` Nanos nanos = - check "plus{UnixDateTimeNanos,Nanos}" . - uncurry UnixDateTimeNanos . - both (+ _uni_nan_base) fromIntegral . - flip divMod 1000 $ - fromIntegral _uni_nan_nano + nanos - -instance DateTimeMath UnixDateTimePicos Nanos where - UnixDateTimePicos{..} `plus` Nanos nanos = - check "plus{UnixDateTimePicos,Nanos}" . - uncurry UnixDateTimePicos . - both (+ _uni_pic_base) fromIntegral . - flip divMod 1000000 $ - fromIntegral _uni_pic_pico + nanos * 1000 - -instance DateTimeMath UnixDateTimePicos Picos where - UnixDateTimePicos{..} `plus` Picos picos = - check "plus{UnixDateTimePicos,Picos}" . - uncurry UnixDateTimePicos . - both (+ _uni_pic_base) fromIntegral . - flip divMod 1000000 $ - fromIntegral _uni_pic_pico + picos - -instance Enum UnixDate where - succ = flip plus $ Day 1 - pred = flip plus . Day $ - 1 - toEnum = check "toEnum{UnixDate}" . UnixDate . fromIntegral - fromEnum = fromIntegral . _uni_day_base - -instance Enum UnixDateTime where - succ = flip plus $ Second 1 - pred = flip plus . Second $ - 1 - toEnum = check "toEnum{UnixDateTime}" . UnixDateTime . fromIntegral - fromEnum = fromIntegral . _uni_sec_base - -instance Enum UnixDateTimeMillis where - succ = flip plus $ Millis 1 - pred = flip plus . Millis $ - 1 - toEnum = check "toEnum{UnixDateTimeMillis}" . UnixDateTimeMillis . fromIntegral - fromEnum = fromIntegral . _uni_mil_base - -instance Enum UnixDateTimeMicros where - succ = flip plus $ Micros 1 - pred = flip plus . Micros $ - 1 - toEnum = check "toEnum{UnixDateTimeMicros}" . UnixDateTimeMicros . fromIntegral - fromEnum = fromIntegral . _uni_mic_base - --- | Create a Unix date. --- --- > >>> createUnixDate 2013 November 03 --- > 2013-11-03 --- -createUnixDate :: Year -> Month -> Day -> UnixDate -createUnixDate year month day = - check "createUnixDate" $ UnixDate base - where Day base = epochToDate year month day - --- | Create a Unix date and time. --- --- > >>> createUnixDateTime 2012 April 27 07 37 30 --- > 2012-04-27 07:37:30 --- -createUnixDateTime :: Year -> Month -> Day -> Hour -> Minute -> Second -> UnixDateTime -createUnixDateTime year month day hour minute second = - check "createUnixDateTime" $ UnixDateTime base - where Second base = epochToTime year month day hour minute second - --- | Create a Unix date and time with millisecond granularity. --- --- > >>> createUnixDateTimeMillis 2014 February 02 08 52 37 983 --- > 2014-02-02 08:52:37.983 --- -createUnixDateTimeMillis :: Year -> Month -> Day -> Hour -> Minute -> Second -> Millis -> UnixDateTimeMillis -createUnixDateTimeMillis year month day hour minute second (Millis millis) = - check "createUnixDateTimeMillis" $ UnixDateTimeMillis base - where Second seconds = epochToTime year month day hour minute second - base = seconds * 1000 + millis - --- | Create a Unix date and time with microsecond granularity. --- --- > >>> createUnixDateTimeMicros 2011 January 22 17 34 13 138563 --- > 2011-01-22 17:34:13.138563 --- -createUnixDateTimeMicros :: Year -> Month -> Day -> Hour -> Minute -> Second -> Micros -> UnixDateTimeMicros -createUnixDateTimeMicros year month day hour minute second (Micros micros) = - check "createUnixDateTimeMicros" $ UnixDateTimeMicros base - where Second seconds = epochToTime year month day hour minute second - base = seconds * 1000000 + micros - --- | Create a Unix date and time with nanosecond granularity. --- --- > >>> createUnixDateTimeNanos 2012 June 28 01 30 35 688279651 --- > 2012-06-28 01:30:35.688279651 --- -createUnixDateTimeNanos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Nanos -> UnixDateTimeNanos -createUnixDateTimeNanos year month day hour minute second (Nanos nanos) = - check "createUnixDateTimeNanos" $ UnixDateTimeNanos base nano - where (micros, nano) = fmap fromIntegral $ divMod nanos 1000 - Second seconds = epochToTime year month day hour minute second - base = seconds * 1000000 + micros - --- | Create a Unix date and time with picosecond granularity. --- --- > >>> createUnixDateTimePicos 2014 August 02 10 57 54 809479393286 --- > 2014-08-02 10:57:54.809479393286 --- -createUnixDateTimePicos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Picos -> UnixDateTimePicos -createUnixDateTimePicos year month day hour minute second (Picos picos) = - check "createUnixDateTimePicos" $ UnixDateTimePicos base pico - where (micros, pico) = fmap fromIntegral $ divMod picos 1000000 - Second seconds = epochToTime year month day hour minute second - base = seconds * 1000000 + micros - --- | Decompose the number of days since --- January 1st into month and day components. -decompYearToDate :: Day -> Bool -> (Month, Day) -decompYearToDate days leap = - if leap - then if days >= 182 - then if days >= 274 - then if days >= 335 - then (December, days - 334) - else if days >= 305 - then (November, days - 304) - else (October , days - 273) - else if days >= 244 - then (September, days - 243) - else if days >= 213 - then (August, days - 212) - else (July , days - 181) - else if days >= 091 - then if days >= 152 - then (June, days - 151) - else if days >= 121 - then (May , days - 120) - else (April, days - 090) - else if days >= 060 - then (March, days - 059) - else if days >= 031 - then (February, days - 030) - else (January , days + 001) - else if days >= 181 - then if days >= 273 - then if days >= 334 - then (December, days - 333) - else if days >= 304 - then (November, days - 303) - else (October , days - 272) - else if days >= 243 - then (September, days - 242) - else if days >= 212 - then (August, days - 211) - else (July , days - 180) - else if days >= 090 - then if days >= 151 - then (June, days - 150) - else if days >= 120 - then (May , days - 119) - else (April, days - 089) - else if days >= 059 - then (March, days - 058) - else if days >= 031 - then (February, days - 030) - else (January , days + 001) - --- | Decompose a Unix date into a human-readable format. -decompUnixDate :: UnixDate -> DateStruct -decompUnixDate (UnixDate base) = - go 1970 $ Day base - where go :: Year -> Day -> DateStruct - go !year !days = - if days >= size - then go (year + 1) (days - size) - else DateStruct year month mday wday - where wday = toEnum $ (fromIntegral base + 4) `mod` 7 - leap = isLeapYear year - size = if leap then 366 else 365 - (month, mday) = decompYearToDate days leap - --- | Decompose a Unix date and time into a human-readable format. -decompUnixDateTime :: UnixDateTime -> DateTimeStruct -decompUnixDateTime (UnixDateTime base) = - DateTimeStruct _d_year _d_mon _d_mday _d_wday hour mn sec - where DateStruct{..} = decompUnixDate $ UnixDate date - (date, mod1) = both fromIntegral Hour $ divMod base 86400 - (hour, mod2) = fmap fromIntegral $ divMod mod1 03600 - (mn , sec ) = fmap realToFrac $ divMod mod2 00060 - --- | Decompose a Unix date and time with millisecond granularity into a human-readable format. -decompUnixDateTimeMillis :: UnixDateTimeMillis -> DateTimeStruct -decompUnixDateTimeMillis (UnixDateTimeMillis base) = - DateTimeStruct _d_year _d_mon _d_mday _d_wday hour mn $ sec + mill / 0001000 - where DateStruct{..} = decompUnixDate $ UnixDate date - (date, mod1) = both fromIntegral Hour $ divMod base 86400000 - (hour, mod2) = fmap fromIntegral $ divMod mod1 03600000 - (mn , mod3) = divMod mod2 00060000 - (sec , mill) = both realToFrac realToFrac $ divMod mod3 00001000 - --- | Decompose a Unix date and time with microsecond granularity into a human-readable format. -decompUnixDateTimeMicros :: UnixDateTimeMicros -> DateTimeStruct -decompUnixDateTimeMicros (UnixDateTimeMicros base) = - DateTimeStruct _d_year _d_mon _d_mday _d_wday hour mn $ sec + micr / 1000000 - where DateStruct{..} = decompUnixDate $ UnixDate date - (date, mod1) = both fromIntegral Hour $ divMod base 86400000000 - (hour, mod2) = fmap fromIntegral $ divMod mod1 03600000000 - (mn , mod3) = divMod mod2 00060000000 - (sec , micr) = both realToFrac realToFrac $ divMod mod3 00001000000 - --- | Decompose a Unix date and time with nanosecond granularity into a human-readable format. -decompUnixDateTimeNanos :: UnixDateTimeNanos -> DateTimeStruct -decompUnixDateTimeNanos (UnixDateTimeNanos base nano) = - modify dt_sec (+ fromIntegral nano / 0001000000000) . decompUnixDateTimeMicros $ UnixDateTimeMicros base - --- | Decompose a Unix date and time with picosecond granularity into a human-readable format. -decompUnixDateTimePicos :: UnixDateTimePicos -> DateTimeStruct -decompUnixDateTimePicos (UnixDateTimePicos base pico) = - modify dt_sec (+ fromIntegral pico / 1000000000000) . decompUnixDateTimeMicros $ UnixDateTimeMicros base - -instance Convertible UnixDateTime UnixDate where - safeConvert = Right . UnixDate . fromIntegral . flip div 00000086400 . _uni_sec_base - -instance Convertible UnixDateTimeMillis UnixDate where - safeConvert = Right . UnixDate . fromIntegral . flip div 00086400000 . _uni_mil_base - -instance Convertible UnixDateTimeMicros UnixDate where - safeConvert = Right . UnixDate . fromIntegral . flip div 86400000000 . _uni_mic_base - -instance Convertible UnixDateTimeNanos UnixDate where - safeConvert = Right . UnixDate . fromIntegral . flip div 86400000000 . _uni_nan_base - -instance Convertible UnixDateTimePicos UnixDate where - safeConvert = Right . UnixDate . fromIntegral . flip div 86400000000 . _uni_pic_base - -instance Date UnixDate where - toDateStruct = decompUnixDate - fromDateStruct DateStruct{..} = - createUnixDate _d_year _d_mon _d_mday - -instance Date UnixDateTime where - toDateStruct = decompUnixDate . convert - fromDateStruct DateStruct{..} = - createUnixDateTime _d_year _d_mon _d_mday 0 0 0 - -instance Date UnixDateTimeMillis where - toDateStruct = decompUnixDate . convert - fromDateStruct DateStruct{..} = - createUnixDateTimeMillis _d_year _d_mon _d_mday 0 0 0 0 - -instance Date UnixDateTimeMicros where - toDateStruct = decompUnixDate . convert - fromDateStruct DateStruct{..} = - createUnixDateTimeMicros _d_year _d_mon _d_mday 0 0 0 0 - -instance Date UnixDateTimeNanos where - toDateStruct = decompUnixDate . convert - fromDateStruct DateStruct{..} = - createUnixDateTimeNanos _d_year _d_mon _d_mday 0 0 0 0 - -instance Date UnixDateTimePicos where - toDateStruct = decompUnixDate . convert - fromDateStruct DateStruct{..} = - createUnixDateTimePicos _d_year _d_mon _d_mday 0 0 0 0 - -instance DateTime UnixDateTime where - toDateTimeStruct = decompUnixDateTime - fromDateTimeStruct DateTimeStruct{..} = - createUnixDateTime _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec - where sec = round _dt_sec :: Second - -instance DateTime UnixDateTimeMillis where - toDateTimeStruct = decompUnixDateTimeMillis - fromDateTimeStruct DateTimeStruct{..} = - createUnixDateTimeMillis _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec mil - where (sec, mil) = properFracMillis _dt_sec - -instance DateTime UnixDateTimeMicros where - toDateTimeStruct = decompUnixDateTimeMicros - fromDateTimeStruct DateTimeStruct{..} = - createUnixDateTimeMicros _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec mic - where (sec, mic) = properFracMicros _dt_sec - -instance DateTime UnixDateTimeNanos where - toDateTimeStruct = decompUnixDateTimeNanos - fromDateTimeStruct DateTimeStruct{..} = - createUnixDateTimeNanos _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec nan - where (sec, nan) = properFracNanos _dt_sec - -instance DateTime UnixDateTimePicos where - toDateTimeStruct = decompUnixDateTimePicos - fromDateTimeStruct DateTimeStruct{..} = - createUnixDateTimePicos _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec pic - where (sec, pic) = properFracPicos _dt_sec - -instance Show UnixDate where - show date = printf "%04d-%02d-%02d" _d_year mon _d_mday - where DateStruct{..} = toDateStruct date - mon = fromEnum _d_mon + 1 - -instance Show UnixDateTime where - show time = printf "%04d-%02d-%02d %02d:%02d:%02d" _dt_year mon _dt_mday _dt_hour _dt_min sec - where DateTimeStruct{..} = toDateTimeStruct time - mon = fromEnum _dt_mon + 1 - sec = round _dt_sec :: Second - -instance Show UnixDateTimeMillis where - show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%03d" _dt_year mon _dt_mday _dt_hour _dt_min sec mill - where DateTimeStruct{..} = toDateTimeStruct time - mon = fromEnum _dt_mon + 1 - (sec, mill) = properFracMillis _dt_sec - -instance Show UnixDateTimeMicros where - show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%06d" _dt_year mon _dt_mday _dt_hour _dt_min sec micr - where DateTimeStruct{..} = toDateTimeStruct time - mon = fromEnum _dt_mon + 1 - (sec, micr) = properFracMicros _dt_sec - -instance Show UnixDateTimeNanos where - show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%09d" _dt_year mon _dt_mday _dt_hour _dt_min sec nano - where DateTimeStruct{..} = toDateTimeStruct time - mon = fromEnum _dt_mon + 1 - (sec, nano) = properFracNanos _dt_sec - -instance Show UnixDateTimePicos where - show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%012d" _dt_year mon _dt_mday _dt_hour _dt_min sec pico - where DateTimeStruct{..} = toDateTimeStruct time - mon = fromEnum _dt_mon + 1 - (sec, pico) = properFracPicos _dt_sec - --- | Get the current Unix date from the system clock. --- --- > >>> getCurrentUnixDate --- > 2013-11-03 --- -getCurrentUnixDate :: IO UnixDate -getCurrentUnixDate = getCurrentUnixDateTime >>= return . convert - --- | Get the current Unix date and time from the system clock. --- --- > >>> getCurrentUnixDateTime --- > 2013-11-03 23:09:38 --- -getCurrentUnixDateTime :: IO UnixDateTime -getCurrentUnixDateTime = - with (C'timeval 0 0) $ \ ptr -> - c'gettimeofday ptr nullPtr >>= getResult ptr - where getResult ptr 0 = peek $ castPtr ptr - getResult _ _ = error "getCurrentUnixDateTime: unknown" - --- | Get the current Unix date and time with millisecond granularity from the system clock. --- --- > >>> getCurrentUnixDateTimeMillis --- > 2013-11-03 23:09:51.986 --- -getCurrentUnixDateTimeMillis :: IO UnixDateTimeMillis -getCurrentUnixDateTimeMillis = - with (C'timeval 0 0) $ \ ptr -> - c'gettimeofday ptr nullPtr >>= getResult ptr - where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) -> - return $! UnixDateTimeMillis $ base * 1000 + micr `div` 1000 - getResult _ _ = error "getCurrentUnixDateTimeMillis: unknown" - --- | Get the current Unix date and time with microsecond granularity from the system clock. --- --- > >>> getCurrentUnixDateTimeMicros --- > 2013-11-03 23:10:06.498559 --- -getCurrentUnixDateTimeMicros :: IO UnixDateTimeMicros -getCurrentUnixDateTimeMicros = - with (C'timeval 0 0) $ \ ptr -> - c'gettimeofday ptr nullPtr >>= getResult ptr - where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) -> - return $! UnixDateTimeMicros $ base * 1000000 + micr - getResult _ _ = error "getCurrentUnixDateTimeMicros: unknown" - --- | Get the current Unix date and time with nanosecond granularity from the system clock. --- --- > >>> getCurrentUnixDateTimeNanos --- > 2013-11-03 23:10:23.697893000 --- --- Note that this functions calls @gettimeofday@ behind the scenes. Therefore, the resultant --- timestamp will have nanosecond granularity, but only microsecond resolution. -getCurrentUnixDateTimeNanos :: IO UnixDateTimeNanos -getCurrentUnixDateTimeNanos = - with (C'timeval 0 0) $ \ ptr -> - c'gettimeofday ptr nullPtr >>= getResult ptr - where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) -> - return $! UnixDateTimeNanos (base * 1000000 + micr) 0 - getResult _ _ = error "getCurrentUnixDateTimeNanos: unknown" - --- | Get the current Unix date and time with picosecond granularity from the system clock. --- --- > >>> getCurrentUnixDateTimePicos --- > 2013-11-03 23:10:44.633032000000 --- --- Note that this functions calls @gettimeofday@ behind the scenes. Therefore, the resultant --- timestamp will have picosecond granularity, but only microsecond resolution. -getCurrentUnixDateTimePicos :: IO UnixDateTimePicos -getCurrentUnixDateTimePicos = - with (C'timeval 0 0) $ \ ptr -> - c'gettimeofday ptr nullPtr >>= getResult ptr - where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) -> - return $! UnixDateTimePicos (base * 1000000 + micr) 0 - getResult _ _ = error "getCurrentUnixDateTimePicos: unknown" - --- | Convert a Unix date and time with nanosecond granularity into an integer. -fromNano :: UnixDateTimeNanos -> Integer -fromNano (UnixDateTimeNanos base nano) = toInteger base * 0001000 + toInteger nano - --- | Convert a Unix date and time with picosecond granularity into an integer. -fromPico :: UnixDateTimePicos -> Integer -fromPico (UnixDateTimePicos base pico) = toInteger base * 1000000 + toInteger pico - --- | Convert an integer into a Unix date and time with nanosecond granularity. -toNano :: Integer -> UnixDateTimeNanos -toNano = uncurry UnixDateTimeNanos . both fromInteger fromInteger . flip divMod 1000 - --- | Convert an integer into a Unix date and time with picosecond granularity. -toPico :: Integer -> UnixDateTimePicos -toPico = uncurry UnixDateTimePicos . both fromInteger fromInteger . flip divMod 1000000 - -instance Duration UnixDate Day where - duration (UnixDate old) (UnixDate new) = Day (new - old) - -instance Duration UnixDateTime Second where - duration (UnixDateTime old) (UnixDateTime new) = Second (new - old) - -instance Duration UnixDateTimeMillis Second where - duration (UnixDateTimeMillis old ) (UnixDateTimeMillis new ) = Second (new - old) `div` 1000 - -instance Duration UnixDateTimeMicros Second where - duration (UnixDateTimeMicros old ) (UnixDateTimeMicros new ) = Second (new - old) `div` 1000000 - -instance Duration UnixDateTimeNanos Second where - duration (UnixDateTimeNanos old _) (UnixDateTimeNanos new _) = Second (new - old) `div` 1000000 - -instance Duration UnixDateTimePicos Second where - duration (UnixDateTimePicos old _) (UnixDateTimePicos new _) = Second (new - old) `div` 1000000 - -instance Duration UnixDateTimeMillis Millis where - duration (UnixDateTimeMillis old ) (UnixDateTimeMillis new ) = Millis (new - old) - -instance Duration UnixDateTimeMicros Millis where - duration (UnixDateTimeMicros old ) (UnixDateTimeMicros new ) = Millis (new - old) `div` 1000 - -instance Duration UnixDateTimeNanos Millis where - duration (UnixDateTimeNanos old _) (UnixDateTimeNanos new _) = Millis (new - old) `div` 1000 - -instance Duration UnixDateTimePicos Millis where - duration (UnixDateTimePicos old _) (UnixDateTimePicos new _) = Millis (new - old) `div` 1000 - -instance Duration UnixDateTimeMicros Micros where - duration (UnixDateTimeMicros old ) (UnixDateTimeMicros new ) = Micros (new - old) - -instance Duration UnixDateTimeNanos Micros where - duration (UnixDateTimeNanos old _) (UnixDateTimeNanos new _) = Micros (new - old) - -instance Duration UnixDateTimePicos Micros where - duration (UnixDateTimePicos old _) (UnixDateTimePicos new _) = Micros (new - old) - -instance Duration UnixDateTimeNanos Nanos where - duration old new = - if res < toInteger (maxBound::Int64) then Nanos $ fromInteger res - else error "duration{UnixDateTimeNanos,Nanos}: integer overflow" - where res = fromNano new - fromNano old - -instance Duration UnixDateTimePicos Nanos where - duration old new = - if res < toInteger (maxBound::Int64) then Nanos $ fromInteger res `div` 1000 - else error "duration{UnixDateTimePicos,Nanos}: integer overflow" - where res = fromPico new - fromPico old - -instance Duration UnixDateTimePicos Picos where - duration old new = - if res < toInteger (maxBound::Int64) then Picos $ fromInteger res - else error "duration{UnixDateTimePicos,Picos}: integer overflow" - where res = fromPico new - fromPico old - -instance Random UnixDate where - random = first toEnum . randomR (0,000000000000000002932896) - randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b) - -instance Random UnixDateTime where - random = first toEnum . randomR (0,000000000000253402300799) - randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b) - -instance Random UnixDateTimeMillis where - random = first toEnum . randomR (0,000000000253402300799999) - randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b) - -instance Random UnixDateTimeMicros where - random = first toEnum . randomR (0,000000253402300799999999) - randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b) - -instance Random UnixDateTimeNanos where - random = first toNano . randomR (0,000253402300799999999999) - randomR (a,b) = first toNano . randomR (fromNano a, fromNano b) - -instance Random UnixDateTimePicos where - random = first toPico . randomR (0,253402300799999999999999) - randomR (a,b) = first toPico . randomR (fromPico a, fromPico b) - --- | Show a Unix date as a pretty string. --- --- > >>> prettyUnixDate $ createUnixDate 2014 August 16 --- > "Saturday, August 16th, 2014" --- -prettyUnixDate :: (Unix d, Date d) => d -> String -prettyUnixDate date = - printf "%s, %s %s, %04d" wday mon mday _d_year - where DateStruct{..} = toDateStruct date - wday = show _d_wday - mon = show _d_mon - mday = show _d_mday ++ showSuffix _d_mday - --- | Show a Unix date and time as a pretty string. --- --- > >>> getCurrentUnixDateTime >>= return . prettyUnixDateTime --- > "6:44 AM, Tuesday, December 31st, 2013" --- -prettyUnixDateTime :: (Unix dt, DateTime dt) => dt -> String -prettyUnixDateTime time = - printf str hour _dt_min ampm wday mon mday _dt_year - where DateTimeStruct{..} = toDateTimeStruct time - str = "%d:%02d %s, %s, %s %s, %04d" - wday = show _dt_wday - mon = show _dt_mon - mday = show _dt_mday ++ showSuffix _dt_mday - ampm = showPeriod _dt_hour - hour | _dt_hour == 00 = 12 - | _dt_hour <= 12 = _dt_hour - | otherwise = _dt_hour - 12 - --- | Perform a bounds check on the given Unix timestamp. -check :: forall a . Bounded a => Ord a => Unix a => String -> a -> a -check f x = - if minBound <= x && x <= maxBound then x - else error $ f ++ ": base (" ++ base ++ ") out of bounds (" ++ bounds ++ ")" - where base = show (unixBase x) - bounds = show (unixBase (minBound::a)) ++ "," ++ show (unixBase (maxBound::a)) - --- | A convenient synonym. -both :: forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d) -both = (***) + , UnixTime(..) + , UnixTimeMillis(..) + , UnixTimeMicros(..) + , UnixTimeNanos(..) + , UnixTimePicos(..) + , UnixDateTime(..) + , UnixDateTimeMillis(..) + , UnixDateTimeMicros(..) + , UnixDateTimeNanos(..) + , UnixDateTimePicos(..) + + -- ** Create Unix Timestamps + , createUnixDate + , createUnixTime + , createUnixTimeMillis + , createUnixTimeMicros + , createUnixTimeNanos + , createUnixTimePicos + , createUnixDateTime + , createUnixDateTimeMillis + , createUnixDateTimeMicros + , createUnixDateTimeNanos + , createUnixDateTimePicos + + -- ** Get Current Unix Timestamps + , getCurrentUnixDate + , getCurrentUnixTime + , getCurrentUnixTimeMillis + , getCurrentUnixTimeMicros + , getCurrentUnixTimeNanos + , getCurrentUnixTimePicos + , getCurrentUnixDateTime + , getCurrentUnixDateTimeMillis + , getCurrentUnixDateTimeMicros + , getCurrentUnixDateTimeNanos + , getCurrentUnixDateTimePicos + + -- ** Pretty Unix Timestamps + , prettyUnixDate + , prettyUnixTime + , prettyUnixDateTime + + ) where + +import Control.Arrow ((***), first) +import Control.DeepSeq (NFData) +import Data.Aeson (FromJSON, ToJSON) +import Data.Convertible (Convertible(..), convert) +import Data.Int (Int16, Int32, Int64) +import Data.Label (get, mkLabels, modify) +import Data.Time.Exts.Base +import Data.Time.Exts.C +import Data.Typeable (Typeable) +import Foreign.C.Types (CLong(..)) +import Foreign.Marshal.Utils (with) +import Foreign.Ptr (castPtr, nullPtr, plusPtr) +import Foreign.Storable (Storable(..)) +import GHC.Generics (Generic) +import System.Random (Random(..)) +import Text.Printf (printf) + +-- | The Unix timestamp type class. +class Unix u where + + -- | Get the base component of a Unix timestamp. + unixBase :: u -> Int64 + + -- | Get the normalized base component of a Unix timestamp. + unixNorm :: u -> Int64 + +-- | Days since Unix epoch. +newtype UnixDate = UnixDate { + _ud_day_base :: Int32 + } deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable) + +-- | Seconds since midnight (excluding leap seconds). +newtype UnixTime = UnixTime { + _ut_sec_base :: Int32 + } deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable) + +-- | Milliseconds since midnight (excluding leap seconds). +newtype UnixTimeMillis = UnixTimeMillis { + _ut_mil_base :: Int32 + } deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable) + +-- | Microseconds since midnight (excluding leap seconds). +newtype UnixTimeMicros = UnixTimeMicros { + _ut_mic_base :: Int64 + } deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable) + +-- | Nanoseconds since midnight (excluding leap seconds). +newtype UnixTimeNanos = UnixTimeNanos { + _ut_nan_base :: Int64 + } deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable) + +-- | Picoseconds since midnight (excluding leap seconds). +newtype UnixTimePicos = UnixTimePicos { + _ut_pic_base :: Int64 + } deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable) + +-- | Seconds since Unix epoch (excluding leap seconds). +newtype UnixDateTime = UnixDateTime { + _udt_sec_base :: Int64 + } deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable) + +-- | Milliseconds since Unix epoch (excluding leap seconds). +newtype UnixDateTimeMillis = UnixDateTimeMillis { + _udt_mil_base :: Int64 + } deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable) + +-- | Microseconds since Unix epoch (excluding leap seconds). +newtype UnixDateTimeMicros = UnixDateTimeMicros { + _udt_mic_base :: Int64 + } deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable) + +-- | Nanoseconds since Unix epoch (excluding leap seconds). +data UnixDateTimeNanos = UnixDateTimeNanos { + _udt_nan_base :: {-# UNPACK #-} !Int64 + , _udt_nan_nano :: {-# UNPACK #-} !Int16 + } deriving (Eq,Generic,Ord,Typeable) + +-- | Picoseconds since Unix epoch (excluding leap seconds). +data UnixDateTimePicos = UnixDateTimePicos { + _udt_pic_base :: {-# UNPACK #-} !Int64 + , _udt_pic_pico :: {-# UNPACK #-} !Int32 + } deriving (Eq,Generic,Ord,Typeable) + +instance FromJSON UnixDateTimeNanos +instance FromJSON UnixDateTimePicos + +instance NFData UnixDateTimeNanos +instance NFData UnixDateTimePicos + +instance Storable UnixDateTimeNanos where + sizeOf _ = 10 + alignment = sizeOf + peekElemOff ptr n = do + let off = 10 * n + base <- peek . plusPtr ptr $ off + nano <- peek . plusPtr ptr $ off + 8 + return $! UnixDateTimeNanos base nano + pokeElemOff ptr n UnixDateTimeNanos{..} = do + let off = 10 * n + poke (plusPtr ptr $ off ) _udt_nan_base + poke (plusPtr ptr $ off + 8) _udt_nan_nano + +instance Storable UnixDateTimePicos where + sizeOf _ = 12 + alignment = sizeOf + peekElemOff ptr n = do + let off = 12 * n + base <- peek . plusPtr ptr $ off + pico <- peek . plusPtr ptr $ off + 8 + return $! UnixDateTimePicos base pico + pokeElemOff ptr n UnixDateTimePicos{..} = do + let off = 12 * n + poke (plusPtr ptr $ off ) _udt_pic_base + poke (plusPtr ptr $ off + 8) _udt_pic_pico + +instance ToJSON UnixDateTimeNanos +instance ToJSON UnixDateTimePicos + +mkLabels [ ''DateTimeStruct + , ''UnixDate + , ''UnixTime + , ''UnixTimeMillis + , ''UnixTimeMicros + , ''UnixTimeNanos + , ''UnixTimePicos + , ''UnixDateTime + , ''UnixDateTimeMillis + , ''UnixDateTimeMicros + , ''UnixDateTimeNanos + , ''UnixDateTimePicos + ] + +instance Bounded UnixDate where + minBound = UnixDate 0 + maxBound = UnixDate 2932896 + +instance Bounded UnixTime where + minBound = UnixTime 0 + maxBound = UnixTime 86399 + +instance Bounded UnixTimeMillis where + minBound = UnixTimeMillis 0 + maxBound = UnixTimeMillis 86399999 + +instance Bounded UnixTimeMicros where + minBound = UnixTimeMicros 0 + maxBound = UnixTimeMicros 86399999999 + +instance Bounded UnixTimeNanos where + minBound = UnixTimeNanos 0 + maxBound = UnixTimeNanos 86399999999999 + +instance Bounded UnixTimePicos where + minBound = UnixTimePicos 0 + maxBound = UnixTimePicos 86399999999999999 + +instance Bounded UnixDateTime where + minBound = UnixDateTime 0 + maxBound = UnixDateTime 253402300799 + +instance Bounded UnixDateTimeMillis where + minBound = UnixDateTimeMillis 0 + maxBound = UnixDateTimeMillis 253402300799999 + +instance Bounded UnixDateTimeMicros where + minBound = UnixDateTimeMicros 0 + maxBound = UnixDateTimeMicros 253402300799999999 + +instance Bounded UnixDateTimeNanos where + minBound = UnixDateTimeNanos 0 0 + maxBound = UnixDateTimeNanos 253402300799999999 999 + +instance Bounded UnixDateTimePicos where + minBound = UnixDateTimePicos 0 0 + maxBound = UnixDateTimePicos 253402300799999999 999999 + +instance Unix UnixDate where + unixBase = fromIntegral . get ud_day_base + unixNorm = unixBase + +instance Unix UnixTime where + unixBase = fromIntegral . get ut_sec_base + unixNorm = unixBase + +instance Unix UnixTimeMillis where + unixBase = fromIntegral . get ut_mil_base + unixNorm = flip div 1000 . unixBase + +instance Unix UnixTimeMicros where + unixBase = get ut_mic_base + unixNorm = flip div 1000000 . unixBase + +instance Unix UnixTimeNanos where + unixBase = get ut_nan_base + unixNorm = flip div 1000000000 . unixBase + +instance Unix UnixTimePicos where + unixBase = get ut_pic_base + unixNorm = flip div 1000000000000 . unixBase + +instance Unix UnixDateTime where + unixBase = get udt_sec_base + unixNorm = unixBase + +instance Unix UnixDateTimeMillis where + unixBase = get udt_mil_base + unixNorm = flip div 1000 . unixBase + +instance Unix UnixDateTimeMicros where + unixBase = get udt_mic_base + unixNorm = flip div 1000000 . unixBase + +instance Unix UnixDateTimeNanos where + unixBase = get udt_nan_base + unixNorm = flip div 1000000 . unixBase + +instance Unix UnixDateTimePicos where + unixBase = get udt_pic_base + unixNorm = flip div 1000000 . unixBase + +instance DateTimeMath UnixDate Day where + date `plus` Day day = + check "plus{UnixDate,Day}" $ + modify ud_day_base (+ day) date + +instance DateTimeMath UnixTime Hour where + time `plus` Hour hour = + check "plus{UnixTime,Hour}" $ + modify ut_sec_base (+ fromIntegral hour * 3600) time + +instance DateTimeMath UnixTime Minute where + time `plus` Minute minute = + check "plus{UnixTime,Minute}" $ + modify ut_sec_base (+ fromIntegral minute * 60) time + +instance DateTimeMath UnixTime Second where + time `plus` Second second = + check "plus{UnixTime,Second}" $ + modify ut_sec_base (+ fromIntegral second) time + +instance DateTimeMath UnixTimeMillis Hour where + time `plus` Hour hour = + check "plus{UnixTimeMillis,Hour}" $ + modify ut_mil_base (+ fromIntegral hour * 3600000) time + +instance DateTimeMath UnixTimeMillis Minute where + time `plus` Minute minute = + check "plus{UnixTimeMillis,Minute}" $ + modify ut_mil_base (+ fromIntegral minute * 60000) time + +instance DateTimeMath UnixTimeMillis Second where + time `plus` Second second = + check "plus{UnixTimeMillis,Second}" $ + modify ut_mil_base (+ fromIntegral second * 1000) time + +instance DateTimeMath UnixTimeMillis Millis where + time `plus` Millis millis = + check "plus{UnixTimeMillis,Millis}" $ + modify ut_mil_base (+ fromIntegral millis) time + +instance DateTimeMath UnixTimeMicros Hour where + time `plus` Hour hour = + check "plus{UnixTimeMicros,Hour}" $ + modify ut_mic_base (+ hour * 3600000000) time + +instance DateTimeMath UnixTimeMicros Minute where + time `plus` Minute minute = + check "plus{UnixTimeMicros,Minute}" $ + modify ut_mic_base (+ minute * 60000000) time + +instance DateTimeMath UnixTimeMicros Second where + time `plus` Second second = + check "plus{UnixTimeMicros,Second}" $ + modify ut_mic_base (+ second * 1000000) time + +instance DateTimeMath UnixTimeMicros Millis where + time `plus` Millis millis = + check "plus{UnixTimeMicros,Millis}" $ + modify ut_mic_base (+ millis * 1000) time + +instance DateTimeMath UnixTimeMicros Micros where + time `plus` Micros micros = + check "plus{UnixTimeMicros,Micros}" $ + modify ut_mic_base (+ micros) time + +instance DateTimeMath UnixTimeNanos Hour where + time `plus` Hour hour = + check "plus{UnixTimeNanos,Hour}" $ + modify ut_nan_base (+ hour * 3600000000000) time + +instance DateTimeMath UnixTimeNanos Minute where + time `plus` Minute minute = + check "plus{UnixTimeNanos,Minute}" $ + modify ut_nan_base (+ minute * 60000000000) time + +instance DateTimeMath UnixTimeNanos Second where + time `plus` Second second = + check "plus{UnixTimeNanos,Second}" $ + modify ut_nan_base (+ second * 1000000000) time + +instance DateTimeMath UnixTimeNanos Millis where + time `plus` Millis millis = + check "plus{UnixTimeNanos,Millis}" $ + modify ut_nan_base (+ millis * 1000000) time + +instance DateTimeMath UnixTimeNanos Micros where + time `plus` Micros micros = + check "plus{UnixTimeNanos,Micros}" $ + modify ut_nan_base (+ micros * 1000) time + +instance DateTimeMath UnixTimeNanos Nanos where + time `plus` Nanos nanos = + check "plus{UnixTimeNanos,Nanos}" $ + modify ut_nan_base (+ nanos) time + +instance DateTimeMath UnixTimePicos Hour where + time `plus` Hour hour = + check "plus{UnixTimePicos,Hour}" $ + modify ut_pic_base (+ hour * 3600000000000000) time + +instance DateTimeMath UnixTimePicos Minute where + time `plus` Minute minute = + check "plus{UnixTimePicos,Minute}" $ + modify ut_pic_base (+ minute * 60000000000000) time + +instance DateTimeMath UnixTimePicos Second where + time `plus` Second second = + check "plus{UnixTimePicos,Second}" $ + modify ut_pic_base (+ second * 1000000000000) time + +instance DateTimeMath UnixTimePicos Millis where + time `plus` Millis millis = + check "plus{UnixTimePicos,Millis}" $ + modify ut_pic_base (+ millis * 1000000000) time + +instance DateTimeMath UnixTimePicos Micros where + time `plus` Micros micros = + check "plus{UnixTimePicos,Micros}" $ + modify ut_pic_base (+ micros * 1000000) time + +instance DateTimeMath UnixTimePicos Nanos where + time `plus` Nanos nanos = + check "plus{UnixTimePicos,Nanos}" $ + modify ut_pic_base (+ nanos * 1000) time + +instance DateTimeMath UnixTimePicos Picos where + time `plus` Picos picos = + check "plus{UnixTimePicos,Picos}" $ + modify ut_pic_base (+ picos) time + +instance DateTimeMath UnixDateTime Day where + time `plus` Day day = + check "plus{UnixDateTime,Day}" $ + modify udt_sec_base (+ fromIntegral day * 86400) time + +instance DateTimeMath UnixDateTime Hour where + time `plus` Hour hour = + check "plus{UnixDateTime,Hour}" $ + modify udt_sec_base (+ hour * 3600) time + +instance DateTimeMath UnixDateTime Minute where + time `plus` Minute minute = + check "plus{UnixDateTime,Minute}" $ + modify udt_sec_base (+ minute * 60) time + +instance DateTimeMath UnixDateTime Second where + time `plus` Second second = + check "plus{UnixDateTime,Second}" $ + modify udt_sec_base (+ second) time + +instance DateTimeMath UnixDateTimeMillis Day where + time `plus` Day day = + check "plus{UnixDateTimeMillis,Day}" $ + modify udt_mil_base (+ fromIntegral day * 86400000) time + +instance DateTimeMath UnixDateTimeMillis Hour where + time `plus` Hour hour = + check "plus{UnixDateTimeMillis,Hour}" $ + modify udt_mil_base (+ hour * 3600000) time + +instance DateTimeMath UnixDateTimeMillis Minute where + time `plus` Minute minute = + check "plus{UnixDateTimeMillis,Minute}" $ + modify udt_mil_base (+ minute * 60000) time + +instance DateTimeMath UnixDateTimeMillis Second where + time `plus` Second second = + check "plus{UnixDateTimeMillis,Second}" $ + modify udt_mil_base (+ second * 1000) time + +instance DateTimeMath UnixDateTimeMillis Millis where + time `plus` Millis millis = + check "plus{UnixDateTimeMillis,Millis}" $ + modify udt_mil_base (+ millis) time + +instance DateTimeMath UnixDateTimeMicros Day where + time `plus` Day day = + check "plus{UnixDateTimeMicros,Day}" $ + modify udt_mic_base (+ fromIntegral day * 86400000000) time + +instance DateTimeMath UnixDateTimeMicros Hour where + time `plus` Hour hour = + check "plus{UnixDateTimeMicros,Hour}" $ + modify udt_mic_base (+ hour * 3600000000) time + +instance DateTimeMath UnixDateTimeMicros Minute where + time `plus` Minute minute = + check "plus{UnixDateTimeMicros,Minute}" $ + modify udt_mic_base (+ minute * 60000000) time + +instance DateTimeMath UnixDateTimeMicros Second where + time `plus` Second second = + check "plus{UnixDateTimeMicros,Second}" $ + modify udt_mic_base (+ second * 1000000) time + +instance DateTimeMath UnixDateTimeMicros Millis where + time `plus` Millis millis = + check "plus{UnixDateTimeMicros,Millis}" $ + modify udt_mic_base (+ millis * 1000) time + +instance DateTimeMath UnixDateTimeMicros Micros where + time `plus` Micros micros = + check "plus{UnixDateTimeMicros,Micros}" $ + modify udt_mic_base (+ micros) time + +instance DateTimeMath UnixDateTimeNanos Day where + time `plus` Day day = + check "plus{UnixDateTimeNanos,Day}" $ + modify udt_nan_base (+ fromIntegral day * 86400000000) time + +instance DateTimeMath UnixDateTimeNanos Hour where + time `plus` Hour hour = + check "plus{UnixDateTimeNanos,Hour}" $ + modify udt_nan_base (+ hour * 3600000000) time + +instance DateTimeMath UnixDateTimeNanos Minute where + time `plus` Minute minute = + check "plus{UnixDateTimeNanos,Minute}" $ + modify udt_nan_base (+ minute * 60000000) time + +instance DateTimeMath UnixDateTimeNanos Second where + time `plus` Second second = + check "plus{UnixDateTimeNanos,Second}" $ + modify udt_nan_base (+ second * 1000000) time + +instance DateTimeMath UnixDateTimeNanos Millis where + time `plus` Millis millis = + check "plus{UnixDateTimeNanos,Millis}" $ + modify udt_nan_base (+ millis * 1000) time + +instance DateTimeMath UnixDateTimeNanos Micros where + time `plus` Micros micros = + check "plus{UnixDateTimeNanos,Micros}" $ + modify udt_nan_base (+ micros) time + +instance DateTimeMath UnixDateTimeNanos Nanos where + UnixDateTimeNanos{..} `plus` Nanos nanos = + check "plus{UnixDateTimeNanos,Nanos}" . + uncurry UnixDateTimeNanos . + ((+ _udt_nan_base) *** fromIntegral) . + flip divMod 1000 $ + fromIntegral _udt_nan_nano + nanos + +instance DateTimeMath UnixDateTimePicos Day where + time `plus` Day day = + check "plus{UnixDateTimePicos,Day}" $ + modify udt_pic_base (+ fromIntegral day * 86400000000) time + +instance DateTimeMath UnixDateTimePicos Hour where + time `plus` Hour hour = + check "plus{UnixDateTimePicos,Hour}" $ + modify udt_pic_base (+ hour * 3600000000) time + +instance DateTimeMath UnixDateTimePicos Minute where + time `plus` Minute minute = + check "plus{UnixDateTimePicos,Minute}" $ + modify udt_pic_base (+ minute * 60000000) time + +instance DateTimeMath UnixDateTimePicos Second where + time `plus` Second second = + check "plus{UnixDateTimePicos,Second}" $ + modify udt_pic_base (+ second * 1000000) time + +instance DateTimeMath UnixDateTimePicos Millis where + time `plus` Millis millis = + check "plus{UnixDateTimePicos,Millis}" $ + modify udt_pic_base (+ millis * 1000) time + +instance DateTimeMath UnixDateTimePicos Micros where + time `plus` Micros micros = + check "plus{UnixDateTimePicos,Micros}" $ + modify udt_pic_base (+ micros) time + +instance DateTimeMath UnixDateTimePicos Nanos where + UnixDateTimePicos{..} `plus` Nanos nanos = + check "plus{UnixDateTimePicos,Nanos}" . + uncurry UnixDateTimePicos . + ((+ _udt_pic_base) *** fromIntegral) . + flip divMod 1000000 $ + fromIntegral _udt_pic_pico + nanos * 1000 + +instance DateTimeMath UnixDateTimePicos Picos where + UnixDateTimePicos{..} `plus` Picos picos = + check "plus{UnixDateTimePicos,Picos}" . + uncurry UnixDateTimePicos . + ((+ _udt_pic_base) *** fromIntegral) . + flip divMod 1000000 $ + fromIntegral _udt_pic_pico + picos + +instance Enum UnixDate where + succ = flip plus $ Day 1 + pred = flip plus . Day $ - 1 + toEnum = check "toEnum{UnixDate}" . UnixDate . fromIntegral + fromEnum = fromIntegral . _ud_day_base + +instance Enum UnixTime where + succ = flip plus $ Second 1 + pred = flip plus . Second $ - 1 + toEnum = check "toEnum{UnixTime}" . UnixTime . fromIntegral + fromEnum = fromIntegral . _ut_sec_base + +instance Enum UnixTimeMillis where + succ = flip plus $ Millis 1 + pred = flip plus . Millis $ - 1 + toEnum = check "toEnum{UnixTimeMillis}" . UnixTimeMillis . fromIntegral + fromEnum = fromIntegral . _ut_mil_base + +instance Enum UnixTimeMicros where + succ = flip plus $ Micros 1 + pred = flip plus . Micros $ - 1 + toEnum = check "toEnum{UnixTimeMicros}" . UnixTimeMicros . fromIntegral + fromEnum = fromIntegral . _ut_mic_base + +instance Enum UnixTimeNanos where + succ = flip plus $ Nanos 1 + pred = flip plus . Nanos $ - 1 + toEnum = check "toEnum{UnixTimeNanos}" . UnixTimeNanos . fromIntegral + fromEnum = fromIntegral . _ut_nan_base + +instance Enum UnixTimePicos where + succ = flip plus $ Picos 1 + pred = flip plus . Picos $ - 1 + toEnum = check "toEnum{UnixTimePicos}" . UnixTimePicos . fromIntegral + fromEnum = fromIntegral . _ut_pic_base + +instance Enum UnixDateTime where + succ = flip plus $ Second 1 + pred = flip plus . Second $ - 1 + toEnum = check "toEnum{UnixDateTime}" . UnixDateTime . fromIntegral + fromEnum = fromIntegral . _udt_sec_base + +instance Enum UnixDateTimeMillis where + succ = flip plus $ Millis 1 + pred = flip plus . Millis $ - 1 + toEnum = check "toEnum{UnixDateTimeMillis}" . UnixDateTimeMillis . fromIntegral + fromEnum = fromIntegral . _udt_mil_base + +instance Enum UnixDateTimeMicros where + succ = flip plus $ Micros 1 + pred = flip plus . Micros $ - 1 + toEnum = check "toEnum{UnixDateTimeMicros}" . UnixDateTimeMicros . fromIntegral + fromEnum = fromIntegral . _udt_mic_base + +-- | Create a Unix date. +-- +-- > >>> createUnixDate 2013 November 3 +-- > 2013-11-03 +-- +createUnixDate :: Year -> Month -> Day -> UnixDate +createUnixDate year month day = + check "createUnixDate" $ UnixDate base + where Day base = epochToDate year month day + +-- | Create a Unix time. +-- +-- > >>> createUnixTime 4 52 7 +-- > 04:52:07 +-- +createUnixTime :: Hour -> Minute -> Second -> UnixTime +createUnixTime hour minute second = + check "createUnixTime" $ UnixTime base + where base = fromIntegral $ midnightToTime hour minute second + +-- | Create a Unix time with millisecond granularity. +-- +-- > >>> createUnixTimeMillis 15 22 47 2 +-- > 15:22:47.002 +-- +createUnixTimeMillis :: Hour -> Minute -> Second -> Millis -> UnixTimeMillis +createUnixTimeMillis hour minute second (Millis millis) = + check "createUnixTimeMillis" $ UnixTimeMillis base + where Second seconds = midnightToTime hour minute second + base = fromIntegral seconds * 1000 + fromIntegral millis + +-- | Create a Unix time with microsecond granularity. +-- +-- > >>> createUnixTimeMicros 10 6 33 575630 +-- > 10:06:33.575630 +-- +createUnixTimeMicros :: Hour -> Minute -> Second -> Micros -> UnixTimeMicros +createUnixTimeMicros hour minute second (Micros micros) = + check "createUnixTimeMicros" $ UnixTimeMicros base + where Second seconds = midnightToTime hour minute second + base = seconds * 1000000 + fromIntegral micros + +-- | Create a Unix time with nanosecond granularity. +-- +-- > >>> createUnixTimeNanos 23 19 54 465837593 +-- > 23:19:54.465837593 +-- +createUnixTimeNanos :: Hour -> Minute -> Second -> Nanos -> UnixTimeNanos +createUnixTimeNanos hour minute second (Nanos nanos) = + check "createUnixTimeNanos" $ UnixTimeNanos base + where Second seconds = midnightToTime hour minute second + base = seconds * 1000000000 + fromIntegral nanos + +-- | Create a Unix time with picosecond granularity. +-- +-- > >>> createUnixTimePicos 17 25 36 759230473534 +-- > 17:25:36.759230473534 +-- +createUnixTimePicos :: Hour -> Minute -> Second -> Picos -> UnixTimePicos +createUnixTimePicos hour minute second (Picos picos) = + check "createUnixTimePicos" $ UnixTimePicos base + where Second seconds = midnightToTime hour minute second + base = seconds * 1000000000000 + fromIntegral picos + +-- | Create a Unix date and time. +-- +-- > >>> createUnixDateTime 2012 April 27 7 37 30 +-- > 2012-04-27 07:37:30 +-- +createUnixDateTime :: Year -> Month -> Day -> Hour -> Minute -> Second -> UnixDateTime +createUnixDateTime year month day hour minute second = + check "createUnixDateTime" $ UnixDateTime base + where Second base = epochToTime year month day hour minute second + +-- | Create a Unix date and time with millisecond granularity. +-- +-- > >>> createUnixDateTimeMillis 2014 February 2 8 52 37 983 +-- > 2014-02-02 08:52:37.983 +-- +createUnixDateTimeMillis :: Year -> Month -> Day -> Hour -> Minute -> Second -> Millis -> UnixDateTimeMillis +createUnixDateTimeMillis year month day hour minute second (Millis millis) = + check "createUnixDateTimeMillis" $ UnixDateTimeMillis base + where Second seconds = epochToTime year month day hour minute second + base = seconds * 1000 + millis + +-- | Create a Unix date and time with microsecond granularity. +-- +-- > >>> createUnixDateTimeMicros 2011 January 22 17 34 13 138563 +-- > 2011-01-22 17:34:13.138563 +-- +createUnixDateTimeMicros :: Year -> Month -> Day -> Hour -> Minute -> Second -> Micros -> UnixDateTimeMicros +createUnixDateTimeMicros year month day hour minute second (Micros micros) = + check "createUnixDateTimeMicros" $ UnixDateTimeMicros base + where Second seconds = epochToTime year month day hour minute second + base = seconds * 1000000 + micros + +-- | Create a Unix date and time with nanosecond granularity. +-- +-- > >>> createUnixDateTimeNanos 2012 June 28 1 30 35 688279651 +-- > 2012-06-28 01:30:35.688279651 +-- +createUnixDateTimeNanos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Nanos -> UnixDateTimeNanos +createUnixDateTimeNanos year month day hour minute second (Nanos nanos) = + check "createUnixDateTimeNanos" $ UnixDateTimeNanos base nano + where (micros, nano) = fmap fromIntegral $ divMod nanos 1000 + Second seconds = epochToTime year month day hour minute second + base = seconds * 1000000 + micros + +-- | Create a Unix date and time with picosecond granularity. +-- +-- > >>> createUnixDateTimePicos 2014 August 2 10 57 54 809479393286 +-- > 2014-08-02 10:57:54.809479393286 +-- +createUnixDateTimePicos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Picos -> UnixDateTimePicos +createUnixDateTimePicos year month day hour minute second (Picos picos) = + check "createUnixDateTimePicos" $ UnixDateTimePicos base pico + where (micros, pico) = fmap fromIntegral $ divMod picos 1000000 + Second seconds = epochToTime year month day hour minute second + base = seconds * 1000000 + micros + +-- | Decompose the number of days since +-- January 1st into month and day components. +decompYearToDate :: Day -> Bool -> (Month, Day) +decompYearToDate days leap = + if leap + then if days >= 182 + then if days >= 274 + then if days >= 335 + then (December, days - 334) + else if days >= 305 + then (November, days - 304) + else (October , days - 273) + else if days >= 244 + then (September, days - 243) + else if days >= 213 + then (August, days - 212) + else (July , days - 181) + else if days >= 091 + then if days >= 152 + then (June, days - 151) + else if days >= 121 + then (May , days - 120) + else (April, days - 090) + else if days >= 060 + then (March, days - 059) + else if days >= 031 + then (February, days - 030) + else (January , days + 001) + else if days >= 181 + then if days >= 273 + then if days >= 334 + then (December, days - 333) + else if days >= 304 + then (November, days - 303) + else (October , days - 272) + else if days >= 243 + then (September, days - 242) + else if days >= 212 + then (August, days - 211) + else (July , days - 180) + else if days >= 090 + then if days >= 151 + then (June, days - 150) + else if days >= 120 + then (May , days - 119) + else (April, days - 089) + else if days >= 059 + then (March, days - 058) + else if days >= 031 + then (February, days - 030) + else (January , days + 001) + +-- | Decompose a Unix date into a human-readable format. +decompUnixDate :: UnixDate -> DateStruct +decompUnixDate (UnixDate base) = + go 1970 $ Day base + where go :: Year -> Day -> DateStruct + go !year !days = + if days >= size + then go (year + 1) (days - size) + else DateStruct year month mday wday + where wday = toEnum $ (fromIntegral base + 4) `mod` 7 + leap = isLeapYear year + size = if leap then 366 else 365 + (month, mday) = decompYearToDate days leap + +-- | Decompose a Unix time into a human-readable format. +decompUnixTime :: UnixTime -> TimeStruct +decompUnixTime (UnixTime base) = + TimeStruct hour mn sec + where (hour, mod1) = fromIntegral *** fromIntegral $ divMod base 3600 + (mn , sec ) = fmap realToFrac $ divMod mod1 0060 + +-- | Decompose a Unix time with millisecond granularity into a human-readable format. +decompUnixTimeMillis :: UnixTimeMillis -> TimeStruct +decompUnixTimeMillis (UnixTimeMillis base) = + TimeStruct hour mn $ sec + mill / 1000 + where (hour, mod1) = fromIntegral *** fromIntegral $ divMod base 3600000 + (mn , mod2) = divMod mod1 0060000 + (sec , mill) = realToFrac *** realToFrac $ divMod mod2 0001000 + +-- | Decompose a Unix time with microsecond granularity into a human-readable format. +decompUnixTimeMicros :: UnixTimeMicros -> TimeStruct +decompUnixTimeMicros (UnixTimeMicros base) = + TimeStruct hour mn $ sec + micr / 1000000 + where (hour, mod1) = Hour *** Minute $ divMod base 3600000000 + (mn , mod2) = divMod mod1 0060000000 + (sec , micr) = realToFrac *** realToFrac $ divMod mod2 0001000000 + +-- | Decompose a Unix time with nanosecond granularity into a human-readable format. +decompUnixTimeNanos :: UnixTimeNanos -> TimeStruct +decompUnixTimeNanos (UnixTimeNanos base) = + TimeStruct hour mn $ sec + nano / 1000000000 + where (hour, mod1) = Hour *** Minute $ divMod base 3600000000000 + (mn , mod2) = divMod mod1 0060000000000 + (sec , nano) = realToFrac *** realToFrac $ divMod mod2 0001000000000 + +-- | Decompose a Unix time with picosecond granularity into a human-readable format. +decompUnixTimePicos :: UnixTimePicos -> TimeStruct +decompUnixTimePicos (UnixTimePicos base) = + TimeStruct hour mn $ sec + pico / 1000000000000 + where (hour, mod1) = Hour *** Minute $ divMod base 3600000000000000 + (mn , mod2) = divMod mod1 0060000000000000 + (sec , pico) = realToFrac *** realToFrac $ divMod mod2 0001000000000000 + +-- | Decompose a Unix date and time into a human-readable format. +decompUnixDateTime :: UnixDateTime -> DateTimeStruct +decompUnixDateTime (UnixDateTime base) = + DateTimeStruct _d_year _d_mon _d_mday _d_wday hour mn sec + where DateStruct{..} = decompUnixDate $ UnixDate date + (date, mod1) = fromIntegral *** Hour $ divMod base 86400 + (hour, mod2) = fmap fromIntegral $ divMod mod1 03600 + (mn , sec ) = fmap realToFrac $ divMod mod2 00060 + +-- | Decompose a Unix date and time with millisecond granularity into a human-readable format. +decompUnixDateTimeMillis :: UnixDateTimeMillis -> DateTimeStruct +decompUnixDateTimeMillis (UnixDateTimeMillis base) = + DateTimeStruct _d_year _d_mon _d_mday _d_wday hour mn $ sec + mill / 1000 + where DateStruct{..} = decompUnixDate $ UnixDate date + (date, mod1) = fromIntegral *** Hour $ divMod base 86400000 + (hour, mod2) = fmap fromIntegral $ divMod mod1 03600000 + (mn , mod3) = divMod mod2 00060000 + (sec , mill) = realToFrac *** realToFrac $ divMod mod3 00001000 + +-- | Decompose a Unix date and time with microsecond granularity into a human-readable format. +decompUnixDateTimeMicros :: UnixDateTimeMicros -> DateTimeStruct +decompUnixDateTimeMicros (UnixDateTimeMicros base) = + DateTimeStruct _d_year _d_mon _d_mday _d_wday hour mn $ sec + micr / 1000000 + where DateStruct{..} = decompUnixDate $ UnixDate date + (date, mod1) = fromIntegral *** Hour $ divMod base 86400000000 + (hour, mod2) = fmap fromIntegral $ divMod mod1 03600000000 + (mn , mod3) = divMod mod2 00060000000 + (sec , micr) = realToFrac *** realToFrac $ divMod mod3 00001000000 + +-- | Decompose a Unix date and time with nanosecond granularity into a human-readable format. +decompUnixDateTimeNanos :: UnixDateTimeNanos -> DateTimeStruct +decompUnixDateTimeNanos (UnixDateTimeNanos base nano) = + modify dt_sec (+ fromIntegral nano / 1000000000) . decompUnixDateTimeMicros $ UnixDateTimeMicros base + +-- | Decompose a Unix date and time with picosecond granularity into a human-readable format. +decompUnixDateTimePicos :: UnixDateTimePicos -> DateTimeStruct +decompUnixDateTimePicos (UnixDateTimePicos base pico) = + modify dt_sec (+ fromIntegral pico / 1000000000000) . decompUnixDateTimeMicros $ UnixDateTimeMicros base + +instance Convertible UnixDateTime UnixDate where + safeConvert = Right . UnixDate . fromIntegral . flip div 00000086400 . _udt_sec_base + +instance Convertible UnixDateTime UnixTime where + safeConvert = Right . UnixTime . fromIntegral . flip mod 00000086400 . _udt_sec_base + +instance Convertible UnixDateTimeMillis UnixDate where + safeConvert = Right . UnixDate . fromIntegral . flip div 00086400000 . _udt_mil_base + +instance Convertible UnixDateTimeMillis UnixTime where + safeConvert = Right . UnixTime . fromIntegral . flip mod 00086400000 . _udt_mil_base + +instance Convertible UnixDateTimeMicros UnixDate where + safeConvert = Right . UnixDate . fromIntegral . flip div 86400000000 . _udt_mic_base + +instance Convertible UnixDateTimeMicros UnixTime where + safeConvert = Right . UnixTime . fromIntegral . flip mod 86400000000 . _udt_mic_base + +instance Convertible UnixDateTimeNanos UnixDate where + safeConvert = Right . UnixDate . fromIntegral . flip div 86400000000 . _udt_nan_base + +instance Convertible UnixDateTimeNanos UnixTime where + safeConvert = Right . UnixTime . fromIntegral . flip mod 86400000000 . _udt_nan_base + +instance Convertible UnixDateTimePicos UnixDate where + safeConvert = Right . UnixDate . fromIntegral . flip div 86400000000 . _udt_pic_base + +instance Convertible UnixDateTimePicos UnixTime where + safeConvert = Right . UnixTime . fromIntegral . flip mod 86400000000 . _udt_pic_base + +instance Date UnixDate where + toDateStruct = decompUnixDate + fromDateStruct DateStruct{..} = + createUnixDate _d_year _d_mon _d_mday + +instance Date UnixDateTime where + toDateStruct = decompUnixDate . convert + fromDateStruct DateStruct{..} = + createUnixDateTime _d_year _d_mon _d_mday 0 0 0 + +instance Date UnixDateTimeMillis where + toDateStruct = decompUnixDate . convert + fromDateStruct DateStruct{..} = + createUnixDateTimeMillis _d_year _d_mon _d_mday 0 0 0 0 + +instance Date UnixDateTimeMicros where + toDateStruct = decompUnixDate . convert + fromDateStruct DateStruct{..} = + createUnixDateTimeMicros _d_year _d_mon _d_mday 0 0 0 0 + +instance Date UnixDateTimeNanos where + toDateStruct = decompUnixDate . convert + fromDateStruct DateStruct{..} = + createUnixDateTimeNanos _d_year _d_mon _d_mday 0 0 0 0 + +instance Date UnixDateTimePicos where + toDateStruct = decompUnixDate . convert + fromDateStruct DateStruct{..} = + createUnixDateTimePicos _d_year _d_mon _d_mday 0 0 0 0 + +instance Time UnixTime where + toTimeStruct = decompUnixTime + fromTimeStruct TimeStruct{..} = + createUnixTime _t_hour _t_min sec + where sec = round _t_sec + +instance Time UnixTimeMillis where + toTimeStruct = decompUnixTimeMillis + fromTimeStruct TimeStruct{..} = + createUnixTimeMillis _t_hour _t_min sec mil + where (sec, mil) = properFracMillis _t_sec + +instance Time UnixTimeMicros where + toTimeStruct = decompUnixTimeMicros + fromTimeStruct TimeStruct{..} = + createUnixTimeMicros _t_hour _t_min sec mic + where (sec, mic) = properFracMicros _t_sec + +instance Time UnixTimeNanos where + toTimeStruct = decompUnixTimeNanos + fromTimeStruct TimeStruct{..} = + createUnixTimeNanos _t_hour _t_min sec nan + where (sec, nan) = properFracNanos _t_sec + +instance Time UnixTimePicos where + toTimeStruct = decompUnixTimePicos + fromTimeStruct TimeStruct{..} = + createUnixTimePicos _t_hour _t_min sec pic + where (sec, pic) = properFracPicos _t_sec + +instance Time UnixDateTime where + toTimeStruct = decompUnixTime . convert + fromTimeStruct TimeStruct{..} = + createUnixDateTime 1970 January 1 _t_hour _t_min sec + where sec = round _t_sec + +instance Time UnixDateTimeMillis where + toTimeStruct = decompUnixTime . convert + fromTimeStruct TimeStruct{..} = + createUnixDateTimeMillis 1970 January 1 _t_hour _t_min sec mil + where (sec, mil) = properFracMillis _t_sec + +instance Time UnixDateTimeMicros where + toTimeStruct = decompUnixTime . convert + fromTimeStruct TimeStruct{..} = + createUnixDateTimeMicros 1970 January 1 _t_hour _t_min sec mic + where (sec, mic) = properFracMicros _t_sec + +instance Time UnixDateTimeNanos where + toTimeStruct = decompUnixTime . convert + fromTimeStruct TimeStruct{..} = + createUnixDateTimeNanos 1970 January 1 _t_hour _t_min sec nan + where (sec, nan) = properFracNanos _t_sec + +instance Time UnixDateTimePicos where + toTimeStruct = decompUnixTime . convert + fromTimeStruct TimeStruct{..} = + createUnixDateTimePicos 1970 January 1 _t_hour _t_min sec pic + where (sec, pic) = properFracPicos _t_sec + +instance DateTime UnixDateTime where + toDateTimeStruct = decompUnixDateTime + fromDateTimeStruct DateTimeStruct{..} = + createUnixDateTime _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec + where sec = round _dt_sec :: Second + +instance DateTime UnixDateTimeMillis where + toDateTimeStruct = decompUnixDateTimeMillis + fromDateTimeStruct DateTimeStruct{..} = + createUnixDateTimeMillis _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec mil + where (sec, mil) = properFracMillis _dt_sec + +instance DateTime UnixDateTimeMicros where + toDateTimeStruct = decompUnixDateTimeMicros + fromDateTimeStruct DateTimeStruct{..} = + createUnixDateTimeMicros _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec mic + where (sec, mic) = properFracMicros _dt_sec + +instance DateTime UnixDateTimeNanos where + toDateTimeStruct = decompUnixDateTimeNanos + fromDateTimeStruct DateTimeStruct{..} = + createUnixDateTimeNanos _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec nan + where (sec, nan) = properFracNanos _dt_sec + +instance DateTime UnixDateTimePicos where + toDateTimeStruct = decompUnixDateTimePicos + fromDateTimeStruct DateTimeStruct{..} = + createUnixDateTimePicos _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec pic + where (sec, pic) = properFracPicos _dt_sec + +instance Show UnixDate where + show date = printf "%04d-%02d-%02d" _d_year mon _d_mday + where DateStruct{..} = toDateStruct date + mon = fromEnum _d_mon + 1 + +instance Show UnixTime where + show time = printf "%02d:%02d:%02d" _t_hour _t_min sec + where TimeStruct{..} = toTimeStruct time + sec = round _t_sec :: Second + +instance Show UnixTimeMillis where + show time = printf "%02d:%02d:%02d.%03d" _t_hour _t_min sec mil + where TimeStruct{..} = toTimeStruct time + (sec, mil) = properFracMillis _t_sec + +instance Show UnixTimeMicros where + show time = printf "%02d:%02d:%02d.%06d" _t_hour _t_min sec mic + where TimeStruct{..} = toTimeStruct time + (sec, mic) = properFracMicros _t_sec + +instance Show UnixTimeNanos where + show time = printf "%02d:%02d:%02d.%09d" _t_hour _t_min sec nan + where TimeStruct{..} = toTimeStruct time + (sec, nan) = properFracNanos _t_sec + +instance Show UnixTimePicos where + show time = printf "%02d:%02d:%02d.%012d" _t_hour _t_min sec pic + where TimeStruct{..} = toTimeStruct time + (sec, pic) = properFracPicos _t_sec + +instance Show UnixDateTime where + show time = printf "%04d-%02d-%02d %02d:%02d:%02d" _dt_year mon _dt_mday _dt_hour _dt_min sec + where DateTimeStruct{..} = toDateTimeStruct time + mon = fromEnum _dt_mon + 1 + sec = round _dt_sec :: Second + +instance Show UnixDateTimeMillis where + show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%03d" _dt_year mon _dt_mday _dt_hour _dt_min sec mil + where DateTimeStruct{..} = toDateTimeStruct time + mon = fromEnum _dt_mon + 1 + (sec, mil) = properFracMillis _dt_sec + +instance Show UnixDateTimeMicros where + show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%06d" _dt_year mon _dt_mday _dt_hour _dt_min sec mic + where DateTimeStruct{..} = toDateTimeStruct time + mon = fromEnum _dt_mon + 1 + (sec, mic) = properFracMicros _dt_sec + +instance Show UnixDateTimeNanos where + show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%09d" _dt_year mon _dt_mday _dt_hour _dt_min sec nan + where DateTimeStruct{..} = toDateTimeStruct time + mon = fromEnum _dt_mon + 1 + (sec, nan) = properFracNanos _dt_sec + +instance Show UnixDateTimePicos where + show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%012d" _dt_year mon _dt_mday _dt_hour _dt_min sec pic + where DateTimeStruct{..} = toDateTimeStruct time + mon = fromEnum _dt_mon + 1 + (sec, pic) = properFracPicos _dt_sec + +-- | Get the current Unix date from the system clock. +-- +-- > >>> getCurrentUnixDate +-- > 2013-11-03 +-- +getCurrentUnixDate :: IO UnixDate +getCurrentUnixDate = getCurrentUnixDateTime >>= return . convert + +-- | Get the current Unix time from the system clock. +-- +-- > >>> getCurrentUnixTime +-- > 05:45:06 +-- +getCurrentUnixTime :: IO UnixTime +getCurrentUnixTime = getCurrentUnixDateTime >>= return . convert + +-- | Get the current Unix time with millisecond granularity from the system clock. +-- +-- > >>> getCurrentUnixTimeMillis +-- > 06:30:08.840 +-- +getCurrentUnixTimeMillis :: IO UnixTimeMillis +getCurrentUnixTimeMillis = + with (C'timeval 0 0) $ \ ptr -> + c'gettimeofday ptr nullPtr >>= getResult ptr + where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) -> + return $! UnixTimeMillis . fromIntegral $ (base `mod` 86400) * 1000 + micr `div` 1000 + getResult _ _ = error "getCurrentUnixTimeMillis: unknown" + +-- | Get the current Unix time with microsecond granularity from the system clock. +-- +-- > >>> getCurrentUnixTimeMicros +-- > 06:40:39.102910 +-- +getCurrentUnixTimeMicros :: IO UnixTimeMicros +getCurrentUnixTimeMicros = + with (C'timeval 0 0) $ \ ptr -> + c'gettimeofday ptr nullPtr >>= getResult ptr + where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) -> + return $! UnixTimeMicros $ (base `mod` 86400) * 1000000 + micr + getResult _ _ = error "getCurrentUnixTimeMicros: unknown" + +-- | Get the current Unix time with nanosecond granularity from the system clock. +-- +-- > >>> getCurrentUnixTimeNanos +-- > 06:40:45.903610000 +-- +-- Note that this functions calls @gettimeofday@ behind the scenes. Therefore, +-- the resultant timestamp will have nanosecond granularity, but only microsecond +-- resolution. +getCurrentUnixTimeNanos :: IO UnixTimeNanos +getCurrentUnixTimeNanos = + with (C'timeval 0 0) $ \ ptr -> + c'gettimeofday ptr nullPtr >>= getResult ptr + where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) -> + return $! UnixTimeNanos $ (base `mod` 86400) * 1000000000 + micr * 1000 + getResult _ _ = error "getCurrentUnixTimeNanos: unknown" + +-- | Get the current Unix time with picosecond granularity from the system clock. +-- +-- > >>> getCurrentUnixTimePicos +-- > 06:47:15.379247000000 +-- +-- Note that this functions calls @gettimeofday@ behind the scenes. Therefore, +-- the resultant timestamp will have picosecond granularity, but only microsecond +-- resolution. +getCurrentUnixTimePicos :: IO UnixTimePicos +getCurrentUnixTimePicos = + with (C'timeval 0 0) $ \ ptr -> + c'gettimeofday ptr nullPtr >>= getResult ptr + where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) -> + return $! UnixTimePicos $ (base `mod` 86400) * 1000000000000 + micr * 1000000 + getResult _ _ = error "getCurrentUnixTimePicos: unknown" + +-- | Get the current Unix date and time from the system clock. +-- +-- > >>> getCurrentUnixDateTime +-- > 2013-11-03 23:09:38 +-- +getCurrentUnixDateTime :: IO UnixDateTime +getCurrentUnixDateTime = + with (C'timeval 0 0) $ \ ptr -> + c'gettimeofday ptr nullPtr >>= getResult ptr + where getResult ptr 0 = peek $ castPtr ptr + getResult _ _ = error "getCurrentUnixDateTime: unknown" + +-- | Get the current Unix date and time with millisecond granularity from the system clock. +-- +-- > >>> getCurrentUnixDateTimeMillis +-- > 2013-11-03 23:09:51.986 +-- +getCurrentUnixDateTimeMillis :: IO UnixDateTimeMillis +getCurrentUnixDateTimeMillis = + with (C'timeval 0 0) $ \ ptr -> + c'gettimeofday ptr nullPtr >>= getResult ptr + where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) -> + return $! UnixDateTimeMillis $ base * 1000 + micr `div` 1000 + getResult _ _ = error "getCurrentUnixDateTimeMillis: unknown" + +-- | Get the current Unix date and time with microsecond granularity from the system clock. +-- +-- > >>> getCurrentUnixDateTimeMicros +-- > 2013-11-03 23:10:06.498559 +-- +getCurrentUnixDateTimeMicros :: IO UnixDateTimeMicros +getCurrentUnixDateTimeMicros = + with (C'timeval 0 0) $ \ ptr -> + c'gettimeofday ptr nullPtr >>= getResult ptr + where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) -> + return $! UnixDateTimeMicros $ base * 1000000 + micr + getResult _ _ = error "getCurrentUnixDateTimeMicros: unknown" + +-- | Get the current Unix date and time with nanosecond granularity from the system clock. +-- +-- > >>> getCurrentUnixDateTimeNanos +-- > 2013-11-03 23:10:23.697893000 +-- +-- Note that this functions calls @gettimeofday@ behind the scenes. Therefore, the +-- resultant timestamp will have nanosecond granularity, but only microsecond resolution. +getCurrentUnixDateTimeNanos :: IO UnixDateTimeNanos +getCurrentUnixDateTimeNanos = + with (C'timeval 0 0) $ \ ptr -> + c'gettimeofday ptr nullPtr >>= getResult ptr + where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) -> + return $! UnixDateTimeNanos (base * 1000000 + micr) 0 + getResult _ _ = error "getCurrentUnixDateTimeNanos: unknown" + +-- | Get the current Unix date and time with picosecond granularity from the system clock. +-- +-- > >>> getCurrentUnixDateTimePicos +-- > 2013-11-03 23:10:44.633032000000 +-- +-- Note that this functions calls @gettimeofday@ behind the scenes. Therefore, the +-- resultant timestamp will have nanosecond granularity, but only microsecond resolution. +getCurrentUnixDateTimePicos :: IO UnixDateTimePicos +getCurrentUnixDateTimePicos = + with (C'timeval 0 0) $ \ ptr -> + c'gettimeofday ptr nullPtr >>= getResult ptr + where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) -> + return $! UnixDateTimePicos (base * 1000000 + micr) 0 + getResult _ _ = error "getCurrentUnixDateTimePicos: unknown" + +-- | Convert a Unix date and time with nanosecond granularity into an integer. +fromNanos :: UnixDateTimeNanos -> Integer +fromNanos (UnixDateTimeNanos base nano) = toInteger base * 0001000 + toInteger nano + +-- | Convert a Unix date and time with picosecond granularity into an integer. +fromPicos :: UnixDateTimePicos -> Integer +fromPicos (UnixDateTimePicos base pico) = toInteger base * 1000000 + toInteger pico + +-- | Convert an integer into a Unix date and time with nanosecond granularity. +toNanos :: Integer -> UnixDateTimeNanos +toNanos = uncurry UnixDateTimeNanos . (fromInteger *** fromInteger) . flip divMod 0001000 + +-- | Convert an integer into a Unix date and time with picosecond granularity. +toPicos :: Integer -> UnixDateTimePicos +toPicos = uncurry UnixDateTimePicos . (fromInteger *** fromInteger) . flip divMod 1000000 + +instance Duration UnixDate Day where + duration (UnixDate old) (UnixDate new) = Day (new - old) + +instance Duration UnixTime Hour where + duration (UnixTime old) (UnixTime new) = fromIntegral (new - old) `div` 3600 + +instance Duration UnixTime Minute where + duration (UnixTime old) (UnixTime new) = fromIntegral (new - old) `div` 60 + +instance Duration UnixTime Second where + duration (UnixTime old) (UnixTime new) = fromIntegral (new - old) + +instance Duration UnixTimeMillis Hour where + duration (UnixTimeMillis old) (UnixTimeMillis new) = fromIntegral (new - old) `div` 3600000 + +instance Duration UnixTimeMillis Minute where + duration (UnixTimeMillis old) (UnixTimeMillis new) = fromIntegral (new - old) `div` 60000 + +instance Duration UnixTimeMillis Second where + duration (UnixTimeMillis old) (UnixTimeMillis new) = fromIntegral (new - old) `div` 1000 + +instance Duration UnixTimeMillis Millis where + duration (UnixTimeMillis old) (UnixTimeMillis new) = fromIntegral (new - old) + +instance Duration UnixTimeMicros Hour where + duration (UnixTimeMicros old) (UnixTimeMicros new) = Hour (new - old) `div` 3600000000 + +instance Duration UnixTimeMicros Minute where + duration (UnixTimeMicros old) (UnixTimeMicros new) = Minute (new - old) `div` 60000000 + +instance Duration UnixTimeMicros Second where + duration (UnixTimeMicros old) (UnixTimeMicros new) = Second (new - old) `div` 1000000 + +instance Duration UnixTimeMicros Millis where + duration (UnixTimeMicros old) (UnixTimeMicros new) = Millis (new - old) `div` 1000 + +instance Duration UnixTimeMicros Micros where + duration (UnixTimeMicros old) (UnixTimeMicros new) = Micros (new - old) + +instance Duration UnixTimeNanos Hour where + duration (UnixTimeNanos old) (UnixTimeNanos new) = Hour (new - old) `div` 3600000000000 + +instance Duration UnixTimeNanos Minute where + duration (UnixTimeNanos old) (UnixTimeNanos new) = Minute (new - old) `div` 60000000000 + +instance Duration UnixTimeNanos Second where + duration (UnixTimeNanos old) (UnixTimeNanos new) = Second (new - old) `div` 1000000000 + +instance Duration UnixTimeNanos Millis where + duration (UnixTimeNanos old) (UnixTimeNanos new) = Millis (new - old) `div` 1000000 + +instance Duration UnixTimeNanos Micros where + duration (UnixTimeNanos old) (UnixTimeNanos new) = Micros (new - old) `div` 1000 + +instance Duration UnixTimeNanos Nanos where + duration (UnixTimeNanos old) (UnixTimeNanos new) = Nanos (new - old) + +instance Duration UnixTimePicos Hour where + duration (UnixTimePicos old) (UnixTimePicos new) = Hour (new - old) `div` 3600000000000000 + +instance Duration UnixTimePicos Minute where + duration (UnixTimePicos old) (UnixTimePicos new) = Minute (new - old) `div` 60000000000000 + +instance Duration UnixTimePicos Second where + duration (UnixTimePicos old) (UnixTimePicos new) = Second (new - old) `div` 1000000000000 + +instance Duration UnixTimePicos Millis where + duration (UnixTimePicos old) (UnixTimePicos new) = Millis (new - old) `div` 1000000000 + +instance Duration UnixTimePicos Micros where + duration (UnixTimePicos old) (UnixTimePicos new) = Micros (new - old) `div` 1000000 + +instance Duration UnixTimePicos Nanos where + duration (UnixTimePicos old) (UnixTimePicos new) = Nanos (new - old) `div` 1000 + +instance Duration UnixTimePicos Picos where + duration (UnixTimePicos old) (UnixTimePicos new) = Picos (new - old) + +instance Duration UnixDateTime Day where + duration (UnixDateTime old) (UnixDateTime new) = fromIntegral $ (new - old) `div` 86400 + +instance Duration UnixDateTime Hour where + duration (UnixDateTime old) (UnixDateTime new) = Hour (new - old) `div` 3600 + +instance Duration UnixDateTime Minute where + duration (UnixDateTime old) (UnixDateTime new) = Minute (new - old) `div` 60 + +instance Duration UnixDateTime Second where + duration (UnixDateTime old) (UnixDateTime new) = Second (new - old) + +instance Duration UnixDateTimeMillis Day where + duration (UnixDateTimeMillis old) (UnixDateTimeMillis new) = fromIntegral $ (new - old) `div` 86400000 + +instance Duration UnixDateTimeMillis Hour where + duration (UnixDateTimeMillis old) (UnixDateTimeMillis new) = Hour (new - old) `div` 3600000 + +instance Duration UnixDateTimeMillis Minute where + duration (UnixDateTimeMillis old) (UnixDateTimeMillis new) = Minute (new - old) `div` 60000 + +instance Duration UnixDateTimeMillis Second where + duration (UnixDateTimeMillis old) (UnixDateTimeMillis new) = Second (new - old) `div` 1000 + +instance Duration UnixDateTimeMillis Millis where + duration (UnixDateTimeMillis old) (UnixDateTimeMillis new) = Millis (new - old) + +instance Duration UnixDateTimeMicros Day where + duration (UnixDateTimeMicros old) (UnixDateTimeMicros new) = fromIntegral $ (new - old) `div` 86400000000 + +instance Duration UnixDateTimeMicros Hour where + duration (UnixDateTimeMicros old) (UnixDateTimeMicros new) = Hour (new - old) `div` 3600000000 + +instance Duration UnixDateTimeMicros Minute where + duration (UnixDateTimeMicros old) (UnixDateTimeMicros new) = Minute (new - old) `div` 60000000 + +instance Duration UnixDateTimeMicros Second where + duration (UnixDateTimeMicros old) (UnixDateTimeMicros new) = Second (new - old) `div` 1000000 + +instance Duration UnixDateTimeMicros Millis where + duration (UnixDateTimeMicros old) (UnixDateTimeMicros new) = Millis (new - old) `div` 1000 + +instance Duration UnixDateTimeMicros Micros where + duration (UnixDateTimeMicros old) (UnixDateTimeMicros new) = Micros (new - old) + +instance Duration UnixDateTimeNanos Day where + duration (UnixDateTimeNanos old _) (UnixDateTimeNanos new _) = fromIntegral $ (new - old) `div` 86400000000 + +instance Duration UnixDateTimeNanos Hour where + duration (UnixDateTimeNanos old _) (UnixDateTimeNanos new _) = Hour (new - old) `div` 3600000000 + +instance Duration UnixDateTimeNanos Minute where + duration (UnixDateTimeNanos old _) (UnixDateTimeNanos new _) = Minute (new - old) `div` 60000000 + +instance Duration UnixDateTimeNanos Second where + duration (UnixDateTimeNanos old _) (UnixDateTimeNanos new _) = Second (new - old) `div` 1000000 + +instance Duration UnixDateTimeNanos Millis where + duration (UnixDateTimeNanos old _) (UnixDateTimeNanos new _) = Millis (new - old) `div` 1000 + +instance Duration UnixDateTimeNanos Micros where + duration (UnixDateTimeNanos old _) (UnixDateTimeNanos new _) = Micros (new - old) + +instance Duration UnixDateTimeNanos Nanos where + duration old new = + if res < toInteger (maxBound::Int64) then fromInteger res + else error "duration{UnixDateTimeNanos,Nanos}: integer overflow" + where res = (fromNanos new - fromNanos old) + +instance Duration UnixDateTimePicos Day where + duration (UnixDateTimePicos old _) (UnixDateTimePicos new _) = fromIntegral $ (new - old) `div` 86400000000 + +instance Duration UnixDateTimePicos Hour where + duration (UnixDateTimePicos old _) (UnixDateTimePicos new _) = Hour (new - old) `div` 3600000000 + +instance Duration UnixDateTimePicos Minute where + duration (UnixDateTimePicos old _) (UnixDateTimePicos new _) = Minute (new - old) `div` 60000000 + +instance Duration UnixDateTimePicos Second where + duration (UnixDateTimePicos old _) (UnixDateTimePicos new _) = Second (new - old) `div` 1000000 + +instance Duration UnixDateTimePicos Millis where + duration (UnixDateTimePicos old _) (UnixDateTimePicos new _) = Millis (new - old) `div` 1000 + +instance Duration UnixDateTimePicos Micros where + duration (UnixDateTimePicos old _) (UnixDateTimePicos new _) = Micros (new - old) + +instance Duration UnixDateTimePicos Nanos where + duration old new = + if res < toInteger (maxBound::Int64) then fromInteger res + else error "duration{UnixDateTimePicos,Nanos}: integer overflow" + where res = (fromPicos new - fromPicos old) `div` 1000 + +instance Duration UnixDateTimePicos Picos where + duration old new = + if res < toInteger (maxBound::Int64) then fromInteger res + else error "duration{UnixDateTimePicos,Picos}: integer overflow" + where res = (fromPicos new - fromPicos old) + +instance Random UnixDate where + random = first toEnum . randomR (0,2932896) + randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b) + +instance Random UnixTime where + random = first toEnum . randomR (0,86399) + randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b) + +instance Random UnixTimeMillis where + random = first toEnum . randomR (0,86399999) + randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b) + +instance Random UnixTimeMicros where + random = first toEnum . randomR (0,86399999999) + randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b) + +instance Random UnixTimeNanos where + random = first toEnum . randomR (0,86399999999999) + randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b) + +instance Random UnixTimePicos where + random = first toEnum . randomR (0,86399999999999999) + randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b) + +instance Random UnixDateTime where + random = first toEnum . randomR (0,253402300799) + randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b) + +instance Random UnixDateTimeMillis where + random = first toEnum . randomR (0,253402300799999) + randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b) + +instance Random UnixDateTimeMicros where + random = first toEnum . randomR (0,253402300799999999) + randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b) + +instance Random UnixDateTimeNanos where + random = first toNanos . randomR (0,253402300799999999999) + randomR (a,b) = first toNanos . randomR (fromNanos a, fromNanos b) + +instance Random UnixDateTimePicos where + random = first toPicos . randomR (0,253402300799999999999999) + randomR (a,b) = first toPicos . randomR (fromPicos a, fromPicos b) + +-- | Show a Unix date as a pretty string. +-- +-- > >>> prettyUnixDate $ createUnixDate 2014 August 16 +-- > "Saturday, August 16th, 2014" +-- +prettyUnixDate :: (Unix d, Date d) => d -> String +prettyUnixDate date = + printf "%s, %s %s, %04d" wday mon mday _d_year + where DateStruct{..} = toDateStruct date + wday = show _d_wday + mon = show _d_mon + mday = show _d_mday ++ showSuffix _d_mday + +-- | Show a Unix time as a pretty string. +-- +-- > >>> getCurrentUnixTime >>= putStrLn . prettyUnixTime +-- > 9:12 AM +-- +prettyUnixTime :: (Unix t, Time t) => t -> String +prettyUnixTime time = + printf "%d:%02d %s" hour _t_min ampm + where TimeStruct{..} = toTimeStruct time + ampm = showPeriod _t_hour + hour | _t_hour == 00 = 12 + | _t_hour <= 12 = _t_hour + | otherwise = _t_hour - 12 + +-- | Show a Unix date and time as a pretty string. +-- +-- > >>> getCurrentUnixDateTime >>= return . prettyUnixDateTime +-- > "6:44 AM, Tuesday, December 31st, 2013" +-- +prettyUnixDateTime :: (Unix dt, DateTime dt) => dt -> String +prettyUnixDateTime time = + printf str hour _dt_min ampm wday mon mday _dt_year + where DateTimeStruct{..} = toDateTimeStruct time + str = "%d:%02d %s, %s, %s %s, %04d" + wday = show _dt_wday + mon = show _dt_mon + mday = show _dt_mday ++ showSuffix _dt_mday + ampm = showPeriod _dt_hour + hour | _dt_hour == 00 = 12 + | _dt_hour <= 12 = _dt_hour + | otherwise = _dt_hour - 12 + +-- | Perform a bounds check on the given Unix timestamp. +check :: forall a . Bounded a => Ord a => Unix a => String -> a -> a +check f x = + if minBound <= x && x <= maxBound then x + else error $ f ++ ": base (" ++ base ++ ") out of bounds (" ++ bounds ++ ")" + where base = show (unixBase x) + bounds = show (unixBase (minBound::a)) ++ "," ++ show (unixBase (maxBound::a)) diff --git a/src/Data/Time/Exts/Zone.hs b/src/Data/Time/Exts/Zone.hs --- a/src/Data/Time/Exts/Zone.hs +++ b/src/Data/Time/Exts/Zone.hs @@ -34,12 +34,12 @@ ) where -import Control.Arrow (first) -import Data.Aeson (FromJSON, ToJSON) +import Control.Arrow (first) +import Data.Aeson (FromJSON, ToJSON) import Data.Map.Strict (Map, (!), fromDistinctAscList) -import Data.Typeable (Typeable) -import GHC.Generics (Generic) -import System.Random (Random(..)) +import Data.Typeable (Typeable) +import GHC.Generics (Generic) +import System.Random (Random(..)) -- | Cities from around the world. data City = diff --git a/time-exts.cabal b/time-exts.cabal --- a/time-exts.cabal +++ b/time-exts.cabal @@ -1,10 +1,10 @@ Name: time-exts -Version: 1.1.3 +Version: 2.0.0 License: BSD3 License-File: LICENSE Copyright: Copyright (c) 2014, Enzo Haussecker. All rights reserved. -Author: Enzo Haussecker -Maintainer: Enzo Haussecker +Author: Enzo Haussecker +Maintainer: Enzo Haussecker Stability: Experimental Category: Time Synopsis: Efficient Timestamps