time-exts 1.1.3 → 2.0.0
raw patch · 8 files changed
+1904/−1200 lines, 8 files
Files
- src/Data/Time/Exts.hs +1/−1
- src/Data/Time/Exts/Base.hs +79/−38
- src/Data/Time/Exts/C.hsc +7/−12
- src/Data/Time/Exts/Local.hs +270/−277
- src/Data/Time/Exts/Test.hs +27/−2
- src/Data/Time/Exts/Unix.hs +1512/−862
- src/Data/Time/Exts/Zone.hs +5/−5
- time-exts.cabal +3/−3
src/Data/Time/Exts.hs view
@@ -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
src/Data/Time/Exts/Base.hs view
@@ -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
src/Data/Time/Exts/C.hsc view
@@ -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 <bindings.dsl.h> #include <time.h>@@ -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
src/Data/Time/Exts/Local.hs view
@@ -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
src/Data/Time/Exts/Test.hs view
@@ -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)
src/Data/Time/Exts/Unix.hs view
@@ -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))
src/Data/Time/Exts/Zone.hs view
@@ -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 =
time-exts.cabal view
@@ -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 <ehaussecker@gmail.com>-Maintainer: Enzo Haussecker <ehaussecker@gmail.com>+Author: Enzo Haussecker <enzo@ucsd.edu>+Maintainer: Enzo Haussecker <enzo@ucsd.edu> Stability: Experimental Category: Time Synopsis: Efficient Timestamps