time-exts-2.0.0: src/Data/Time/Exts/Local.hs
---------------------------------------------------------------
-- Copyright (c) 2014, Enzo Haussecker. All rights reserved. --
---------------------------------------------------------------
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS -Wall #-}
-- | Local timestamps of varying granularity.
module Data.Time.Exts.Local (
-- ** Local Class
Local(..)
-- ** Local Timestamps
, LocalDate(..)
, LocalDateTime(..)
, LocalDateTimeMillis(..)
, LocalDateTimeMicros(..)
, LocalDateTimeNanos(..)
, LocalDateTimePicos(..)
-- ** Create Local Timestamps
, createLocalDate
, createLocalDateTime
, createLocalDateTimeMillis
, createLocalDateTimeMicros
, createLocalDateTimeNanos
, createLocalDateTimePicos
-- ** Get Current Local Timestamps
, getCurrentLocalDate
, getCurrentLocalDateTime
, getCurrentLocalDateTimeMillis
, getCurrentLocalDateTimeMicros
, getCurrentLocalDateTimeNanos
, getCurrentLocalDateTimePicos
-- ** Time Zone Transition Times
, Transition(..)
, getTransitions
, lastTransition
-- ** Get Current Local Timestamps Using Preloaded Time Zone Transitions Times
, getCurrentLocalDate'
, getCurrentLocalDateTime'
, getCurrentLocalDateTimeMillis'
, getCurrentLocalDateTimeMicros'
, getCurrentLocalDateTimeNanos'
, getCurrentLocalDateTimePicos'
-- ** Pretty Local Timestamps
, prettyLocalDate
, prettyLocalDateTime
-- ** Base Conversions
, baseUnixToUTC
, baseUTCToUnix
) where
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 Data.Time.Exts.Base
import Data.Time.Exts.Unix
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 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
-- | Get the base component of a local timestamp.
localBase :: u -> Int64
-- | Get the zone component of a local timestamp.
localZone :: u -> Word8
-- | Days since Unix epoch.
data LocalDate = LocalDate {
_ld_day_base :: {-# UNPACK #-} !Int32
, _ld_day_zone :: {-# UNPACK #-} !Word8
} deriving (Eq,Generic,Typeable)
-- | Seconds since Unix epoch (including leap seconds).
data LocalDateTime = LocalDateTime {
_ldt_sec_base :: {-# UNPACK #-} !Int64
, _ldt_sec_zone :: {-# UNPACK #-} !Word8
} deriving (Eq,Generic,Typeable)
-- | Milliseconds since Unix epoch (including leap seconds).
data LocalDateTimeMillis = LocalDateTimeMillis {
_ldt_mil_base :: {-# UNPACK #-} !Int64
, _ldt_mil_zone :: {-# UNPACK #-} !Word8
} deriving (Eq,Generic,Typeable)
-- | Microseconds since Unix epoch (including leap seconds).
data LocalDateTimeMicros = LocalDateTimeMicros {
_ldt_mic_base :: {-# UNPACK #-} !Int64
, _ldt_mic_zone :: {-# UNPACK #-} !Word8
} deriving (Eq,Generic,Typeable)
-- | Nanoseconds since Unix epoch (including leap seconds).
data LocalDateTimeNanos = LocalDateTimeNanos {
_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 {
_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,Generic,Typeable)
instance FromJSON LocalDate
instance FromJSON LocalDateTime
instance FromJSON LocalDateTimeMillis
instance FromJSON LocalDateTimeMicros
instance FromJSON LocalDateTimeNanos
instance FromJSON LocalDateTimePicos
instance NFData LocalDate
instance NFData LocalDateTime
instance NFData LocalDateTimeMillis
instance NFData LocalDateTimeMicros
instance NFData LocalDateTimeNanos
instance NFData LocalDateTimePicos
instance Storable LocalDate where
sizeOf _ = 5
alignment = sizeOf
peekElemOff ptr n = do
let off = 5 * n
base <- peek . plusPtr ptr $ off
zone <- peek . plusPtr ptr $ off + 4
return $! LocalDate base zone
pokeElemOff ptr n LocalDate{..} = do
let off = 5 * n
poke (plusPtr ptr $ off ) _ld_day_base
poke (plusPtr ptr $ off + 4) _ld_day_zone
instance Storable LocalDateTime where
sizeOf _ = 9
alignment = sizeOf
peekElemOff ptr n = do
let off = 9 * n
base <- peek . plusPtr ptr $ off
zone <- peek . plusPtr ptr $ off + 8
return $! LocalDateTime base zone
pokeElemOff ptr n LocalDateTime{..} = do
let off = 9 * n
poke (plusPtr ptr $ off ) _ldt_sec_base
poke (plusPtr ptr $ off + 8) _ldt_sec_zone
instance Storable LocalDateTimeMillis where
sizeOf _ = 9
alignment = sizeOf
peekElemOff ptr n = do
let off = 9 * n
base <- peek . plusPtr ptr $ off
zone <- peek . plusPtr ptr $ off + 8
return $! LocalDateTimeMillis base zone
pokeElemOff ptr n LocalDateTimeMillis{..} = do
let off = 9 * n
poke (plusPtr ptr $ off ) _ldt_mil_base
poke (plusPtr ptr $ off + 8) _ldt_mil_zone
instance Storable LocalDateTimeMicros where
sizeOf _ = 9
alignment = sizeOf
peekElemOff ptr n = do
let off = 9 * n
base <- peek . plusPtr ptr $ off
zone <- peek . plusPtr ptr $ off + 8
return $! LocalDateTimeMicros base zone
pokeElemOff ptr n LocalDateTimeMicros{..} = do
let off = 9 * n
poke (plusPtr ptr $ off ) _ldt_mic_base
poke (plusPtr ptr $ off + 8) _ldt_mic_zone
instance Storable LocalDateTimeNanos where
sizeOf _ = 11
alignment = sizeOf
peekElemOff ptr n = do
let off = 11 * n
base <- peek . plusPtr ptr $ off
nano <- peek . plusPtr ptr $ off + 08
zone <- peek . plusPtr ptr $ off + 10
return $! LocalDateTimeNanos base nano zone
pokeElemOff ptr n LocalDateTimeNanos{..} = do
let off = 11 * n
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
alignment = sizeOf
peekElemOff ptr n = do
let off = 13 * n
base <- peek . plusPtr ptr $ off
pico <- peek . plusPtr ptr $ off + 08
zone <- peek . plusPtr ptr $ off + 12
return $! LocalDateTimePicos base pico zone
pokeElemOff ptr n LocalDateTimePicos{..} = do
let off = 13 * n
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
instance ToJSON LocalDateTimeMillis
instance ToJSON LocalDateTimeMicros
instance ToJSON LocalDateTimeNanos
instance ToJSON LocalDateTimePicos
mkLabels [ ''LocalDate
, ''LocalDateTime
, ''LocalDateTimeMillis
, ''LocalDateTimeMicros
, ''LocalDateTimeNanos
, ''LocalDateTimePicos
]
instance Bounded LocalDate where
minBound = LocalDate 0 0
maxBound = LocalDate 2932896 maxzone
instance Bounded LocalDateTime where
minBound = LocalDateTime 43200 0
maxBound = LocalDateTime 253402257624 maxzone
instance Bounded LocalDateTimeMillis where
minBound = LocalDateTimeMillis 43200000 0
maxBound = LocalDateTimeMillis 253402257624999 maxzone
instance Bounded LocalDateTimeMicros where
minBound = LocalDateTimeMicros 43200000000 0
maxBound = LocalDateTimeMicros 253402257624999999 maxzone
instance Bounded LocalDateTimeNanos where
minBound = LocalDateTimeNanos 43200000000 0 0
maxBound = LocalDateTimeNanos 253402257624999999 999 maxzone
instance Bounded LocalDateTimePicos where
minBound = LocalDateTimePicos 43200000000 0 0
maxBound = LocalDateTimePicos 253402257624999999 999999 maxzone
instance Local LocalDate where
localBase = fromIntegral . get ld_day_base
localZone = get ld_day_zone
instance Local LocalDateTime where
localBase = get ldt_sec_base
localZone = get ldt_sec_zone
instance Local LocalDateTimeMillis where
localBase = get ldt_mil_base
localZone = get ldt_mil_zone
instance Local LocalDateTimeMicros where
localBase = get ldt_mic_base
localZone = get ldt_mic_zone
instance Local LocalDateTimeNanos where
localBase = get ldt_nan_base
localZone = get ldt_nan_zone
instance Local LocalDateTimePicos where
localBase = get ldt_pic_base
localZone = get ldt_pic_zone
deriving instance Local Transition
instance Ord LocalDate where
compare = comparing localBase
instance Ord LocalDateTime where
compare = comparing localBase
instance Ord LocalDateTimeMillis where
compare = comparing localBase
instance Ord LocalDateTimeMicros where
compare = comparing localBase
instance Ord LocalDateTimeNanos where
compare = comparing localBase <> comparing (get ldt_nan_nano)
instance Ord LocalDateTimePicos where
compare = comparing localBase <> comparing (get ldt_pic_pico)
instance DateTimeMath LocalDate Day where
date `plus` Day day =
check "plus{LocalDate,Day}" $
modify ld_day_base (+ day) date
instance DateTimeMath LocalDateTime Second where
time `plus` Second second =
check "plus{LocalDateTime,Second}" $
modify ldt_sec_base (+ second) time
instance DateTimeMath LocalDateTimeMillis Second where
time `plus` Second second =
check "plus{LocalDateTimeMillis,Second}" $
modify ldt_mil_base (+ second * 1000) time
instance DateTimeMath LocalDateTimeMicros Second where
time `plus` Second second =
check "plus{LocalDateTimeMicros,Second}" $
modify ldt_mic_base (+ second * 1000000) time
instance DateTimeMath LocalDateTimeNanos Second where
time `plus` Second second =
check "plus{LocalDateTimeNanos,Second}" $
modify ldt_nan_base (+ second * 1000000) time
instance DateTimeMath LocalDateTimePicos Second where
time `plus` Second second =
check "plus{LocalDateTimePicos,Second}" $
modify ldt_pic_base (+ second * 1000000) time
instance DateTimeMath LocalDateTimeMillis Millis where
time `plus` Millis millis =
check "plus{LocalDateTimeMillis,Millis}" $
modify ldt_mil_base (+ millis) time
instance DateTimeMath LocalDateTimeMicros Millis where
time `plus` Millis millis =
check "plus{LocalDateTimeMicros,Millis}" $
modify ldt_mic_base (+ millis * 1000) time
instance DateTimeMath LocalDateTimeNanos Millis where
time `plus` Millis millis =
check "plus{LocalDateTimeNanos,Millis}" $
modify ldt_nan_base (+ millis * 1000) time
instance DateTimeMath LocalDateTimePicos Millis where
time `plus` Millis millis =
check "plus{LocalDateTimePicos,Millis}" $
modify ldt_pic_base (+ millis * 1000) time
instance DateTimeMath LocalDateTimeMicros Micros where
time `plus` Micros micros =
check "plus{LocalDateTimeMicros,Micros}" $
modify ldt_mic_base (+ micros) time
instance DateTimeMath LocalDateTimeNanos Micros where
time `plus` Micros micros =
check "plus{LocalDateTimeNanos,Micros}" $
modify ldt_nan_base (+ micros) time
instance DateTimeMath LocalDateTimePicos Micros where
time `plus` Micros micros =
check "plus{LocalDateTimePicos,Micros}" $
modify ldt_pic_base (+ micros) time
instance DateTimeMath LocalDateTimeNanos Nanos where
time `plus` Nanos nanos =
check "plus{UnixDateTimeNanos,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 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 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 . 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]
| v1 < v2 = [t | t <- v1 : enumFromTo (succ v1) v2]
| otherwise = [t | t <- v1 : enumFromTo (pred v1) v2]
instance Enum LocalDateTime where
succ = flip plus $ Second 1
pred = flip plus . Second $ - 1
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]
| v1 < v2 = [t | t <- v1 : enumFromTo (succ v1) v2]
| otherwise = [t | t <- v1 : enumFromTo (pred v1) v2]
instance Enum LocalDateTimeMillis where
succ = flip plus $ Millis 1
pred = flip plus . Millis $ - 1
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]
-- | Convert Unix seconds into a UTC seconds.
baseUnixToUTC :: Int64 -> Int64
baseUnixToUTC base
| base >= 1341100800 = base + 25
| base >= 1230768000 = base + 24
| base >= 1136073600 = base + 23
| base >= 0915148800 = base + 22
| base >= 0867715200 = base + 21
| base >= 0820454400 = base + 20
| base >= 0773020800 = base + 19
| base >= 0741484800 = base + 18
| base >= 0709948800 = base + 17
| base >= 0662688000 = base + 16
| base >= 0631152000 = base + 15
| base >= 0567993600 = base + 14
| base >= 0489024000 = base + 13
| base >= 0425865600 = base + 12
| base >= 0394329600 = base + 11
| base >= 0362793600 = base + 10
| base >= 0315532800 = base + 09
| base >= 0283996800 = base + 08
| base >= 0252460800 = base + 07
| base >= 0220924800 = base + 06
| base >= 0189302400 = base + 05
| base >= 0157766400 = base + 04
| base >= 0126230400 = base + 03
| base >= 0094694400 = base + 02
| base >= 0078796800 = base + 01
| otherwise = base + 00
-- | Create a local date.
--
-- > >>> createLocalDate 2013 November 03 Pacific_Standard_Time
-- > 2013-11-03 PST
--
createLocalDate :: Year -> Month -> Day -> TZ.TimeZone -> LocalDate
createLocalDate year month day zone =
check "createLocalDate" . LocalDate base $ tz2w8 zone
where Day base = epochToDate year month day
-- | Create a local date and time.
--
-- > >>> 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 -> TZ.TimeZone -> LocalDateTime
createLocalDateTime year month day hour minute (Second second) zone =
check "createLocalDateTime" . LocalDateTime base $ tz2w8 zone
where base = baseUnixToUTC (unix - offset) + second
Second unix = epochToTime year month day hour minute 0
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 -> TZ.TimeZone -> LocalDateTimeMillis
createLocalDateTimeMillis year month day hour minute (Second second) (Millis millis) 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 = 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 -> TZ.TimeZone -> LocalDateTimeMicros
createLocalDateTimeMicros year month day hour minute (Second second) (Micros micros) 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 = 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 -> TZ.TimeZone -> LocalDateTimeNanos
createLocalDateTimeNanos year month day hour minute (Second second) (Nanos nanos) 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 = 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 -> TZ.TimeZone -> LocalDateTimePicos
createLocalDateTimePicos year month day hour minute (Second second) (Picos picos) 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 = TZ.getUTCOffset zone * 60
-- | Convert UTC seconds into Unix and leap seconds.
baseUTCToUnix :: Int64 -> (Int64, Double)
baseUTCToUnix base
| base >= 1341100825 = (base - 0025, 0)
| base == 1341100824 = (01341100799, 1)
| base >= 1230768024 = (base - 0024, 0)
| base == 1230768023 = (01230767999, 1)
| base >= 1136073623 = (base - 0023, 0)
| base == 1136073622 = (01136073599, 1)
| base >= 0915148822 = (base - 0022, 0)
| base == 0915148821 = (00915148799, 1)
| base >= 0867715221 = (base - 0021, 0)
| base == 0867715220 = (00867715199, 1)
| base >= 0820454420 = (base - 0020, 0)
| base == 0820454419 = (00820454399, 1)
| base >= 0773020819 = (base - 0019, 0)
| base == 0773020818 = (00773020799, 1)
| base >= 0741484818 = (base - 0018, 0)
| base == 0741484817 = (00741484799, 1)
| base >= 0709948817 = (base - 0017, 0)
| base == 0709948816 = (00709948799, 1)
| base >= 0662688016 = (base - 0016, 0)
| base == 0662688015 = (00662687999, 1)
| base >= 0631152015 = (base - 0015, 0)
| base == 0631152014 = (00631151999, 1)
| base >= 0567993614 = (base - 0014, 0)
| base == 0567993613 = (00567993599, 1)
| base >= 0489024013 = (base - 0013, 0)
| base == 0489024012 = (00489023999, 1)
| base >= 0425865612 = (base - 0012, 0)
| base == 0425865611 = (00425865599, 1)
| base >= 0394329611 = (base - 0011, 0)
| base == 0394329610 = (00394329599, 1)
| base >= 0362793610 = (base - 0010, 0)
| base == 0362793609 = (00362793599, 1)
| base >= 0315532809 = (base - 0009, 0)
| base == 0315532808 = (00315532799, 1)
| base >= 0283996808 = (base - 0008, 0)
| base == 0283996807 = (00283996799, 1)
| base >= 0252460807 = (base - 0007, 0)
| base == 0252460806 = (00252460799, 1)
| base >= 0220924806 = (base - 0006, 0)
| base == 0220924805 = (00220924799, 1)
| base >= 0189302405 = (base - 0005, 0)
| base == 0189302404 = (00189302399, 1)
| base >= 0157766404 = (base - 0004, 0)
| base == 0157766403 = (00157766399, 1)
| base >= 0126230403 = (base - 0003, 0)
| base == 0126230402 = (00126230399, 1)
| base >= 0094694402 = (base - 0002, 0)
| base == 0094694401 = (00094694399, 1)
| base >= 0078796801 = (base - 0001, 0)
| base == 0078796800 = (00078796799, 1)
| otherwise = (base - 0000, 0)
-- | Decompose a local date into a human-readable format.
decompLocalDate :: LocalDate -> DateZoneStruct
decompLocalDate LocalDate{..} =
DateZoneStruct _d_year _d_mon _d_mday _d_wday 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 _ldt_sec_base
sec = _dt_sec + leap
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 _ldt_mil_base 0001000
sec = _dt_sec + leap + millis / 0001000
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 _ldt_mic_base 1000000
sec = _dt_sec + leap + micros / 1000000
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 _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 _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, TZ.TimeZone) -> (Int32, DiffTime)
decompLocalBase = uncurry (flip f) . first (uncurry g . baseUTCToUnix)
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 _ldt_sec_zone
where base = fst $ decompLocalBase (_ldt_sec_base, w82tz _ldt_sec_zone)
instance Convertible LocalDateTimeMillis LocalDate where
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 _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 _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 _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) . _ld_day_base
instance Convertible LocalDateTime UTCTime where
safeConvert LocalDateTime{..} = Right $ UTCTime julian pico
where julian = Cal.ModifiedJulianDay $ toInteger day + 40587
(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 $ _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 $ _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 _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 _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 (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 (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 (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 (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 (tz2w8 TZ.utc)
where base = baseUnixToUTC (day * 86400 + sec) * 1000000 + micros
day = fromInteger (Cal.toModifiedJulianDay utctDay) - 40587
(sec , nanos ) = fmap (truncate . (* 1000000000)) $ properFraction utctDayTime
(nano, micros) = swap . fmap fromIntegral $ divMod nanos 1000
instance Convertible UTCTime LocalDateTimePicos where
safeConvert UTCTime{..} = Right . check "safeConvert{Data.Time.Clock.UTCTime,LocalDateTimePicos}" $
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{..} =
createLocalDate _dz_year _dz_mon _dz_mday _dz_zone
instance DateZone LocalDateTime where
toDateZoneStruct = decompLocalDate . convert
fromDateZoneStruct DateZoneStruct{..} =
createLocalDateTime _dz_year _dz_mon _dz_mday 0 0 0 _dz_zone
instance DateZone LocalDateTimeMillis where
toDateZoneStruct = decompLocalDate . convert
fromDateZoneStruct DateZoneStruct{..} =
createLocalDateTimeMillis _dz_year _dz_mon _dz_mday 0 0 0 0 _dz_zone
instance DateZone LocalDateTimeMicros where
toDateZoneStruct = decompLocalDate . convert
fromDateZoneStruct DateZoneStruct{..} =
createLocalDateTimeMicros _dz_year _dz_mon _dz_mday 0 0 0 0 _dz_zone
instance DateZone LocalDateTimeNanos where
toDateZoneStruct = decompLocalDate . convert
fromDateZoneStruct DateZoneStruct{..} =
createLocalDateTimeNanos _dz_year _dz_mon _dz_mday 0 0 0 0 _dz_zone
instance DateZone LocalDateTimePicos where
toDateZoneStruct = decompLocalDate . convert
fromDateZoneStruct DateZoneStruct{..} =
createLocalDateTimePicos _dz_year _dz_mon _dz_mday 0 0 0 0 _dz_zone
instance DateTimeZone LocalDateTime where
toDateTimeZoneStruct = decompLocalDateTime
fromDateTimeZoneStruct DateTimeZoneStruct{..} =
createLocalDateTime _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec _dtz_zone
where sec = round _dtz_sec :: Second
instance DateTimeZone LocalDateTimeMillis where
toDateTimeZoneStruct = decompLocalDateTimeMillis
fromDateTimeZoneStruct DateTimeZoneStruct{..} =
createLocalDateTimeMillis _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec mil _dtz_zone
where (sec, mil) = properFracMillis _dtz_sec
instance DateTimeZone LocalDateTimeMicros where
toDateTimeZoneStruct = decompLocalDateTimeMicros
fromDateTimeZoneStruct DateTimeZoneStruct{..} =
createLocalDateTimeMicros _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec mic _dtz_zone
where (sec, mic) = properFracMicros _dtz_sec
instance DateTimeZone LocalDateTimeNanos where
toDateTimeZoneStruct = decompLocalDateTimeNanos
fromDateTimeZoneStruct DateTimeZoneStruct{..} =
createLocalDateTimeNanos _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec nan _dtz_zone
where (sec, nan) = properFracNanos _dtz_sec
instance DateTimeZone LocalDateTimePicos where
toDateTimeZoneStruct = decompLocalDateTimePicos
fromDateTimeZoneStruct DateTimeZoneStruct{..} =
createLocalDateTimePicos _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec pic _dtz_zone
where (sec, pic) = properFracPicos _dtz_sec
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 $ 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 $ TZ.abbreviate _dtz_zone
mon = fromEnum _dtz_mon + 1
sec = round _dtz_sec :: Second
instance Show LocalDateTimeMillis where
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 $ TZ.abbreviate _dtz_zone
mon = fromEnum _dtz_mon + 1
(sec, mil) = properFracMillis _dtz_sec
instance Show LocalDateTimeMicros where
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 $ TZ.abbreviate _dtz_zone
mon = fromEnum _dtz_mon + 1
(sec, mic) = properFracMicros _dtz_sec
instance Show LocalDateTimeNanos where
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 $ TZ.abbreviate _dtz_zone
mon = fromEnum _dtz_mon + 1
(sec, nan) = properFracNanos _dtz_sec
instance Show LocalDateTimePicos where
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 $ TZ.abbreviate _dtz_zone
mon = fromEnum _dtz_mon + 1
(sec, pic) = properFracPicos _dtz_sec
instance Show Transition where
show = show . unboxTrans
-- | The next leap second insertion date.
nextLeap :: Maybe UnixDate
nextLeap = Nothing
-- | Get a list of time zone transition times for the given city.
getTransitions :: TZ.City -> IO [Transition]
getTransitions city = do
let file = TZ.getOlsonFile city
Olson.OlsonData{..} <- Olson.getOlsonFromFile file
let ttimes = uniquetimes $ sortBy future2past olsonTransitions
return $! foldr (step olsonTypes) [] $ map last ttimes
where uniquetimes = groupBy $ on (==) Olson.transTime
future2past = comparing $ negate . Olson.transTime
step types Olson.Transition{..} accum =
if transTime < 0
then [Transition (LocalDateTime 43200 zone)]
else Transition (LocalDateTime base zone) : accum
where Olson.TtInfo{..} = types !! transIndex
abbr = TZ.TimeZoneAbbr city tt_abbr
base = baseUnixToUTC $ fromIntegral transTime
zone = tz2w8 $ TZ.unabbreviate abbr
-- | Get the last time zone transition time for the given city and time.
lastTransition :: (DateTime dt, Unix dt) => TZ.City -> dt -> IO (Maybe Transition)
lastTransition city time = do
ttimes <- getTransitions city
return $! listToMaybe $ dropWhile f ttimes
where base = baseUnixToUTC $ unixNorm time
f tt = localBase tt > base
-- | Get the current local date from the system clock.
--
-- > >>> getCurrentLocalDate London
-- > 2013-11-03 GMT
--
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.
--
-- > >>> ttimes <- getTransitions Tokyo
-- > >>> getCurrentLocalDate' ttimes
-- > 2013-11-04 JST
--
-- Use this function if you need to get the current local date more than once. The
-- use of preloaded transition times will avoid unnecessary parsing of Olson files.
getCurrentLocalDate' :: [Transition] -> IO LocalDate
getCurrentLocalDate' ttimes = getCurrentLocalDateTime' ttimes >>= return . convert
-- | Get the current local date and time from the system clock.
--
-- > >>> getCurrentLocalDateTime New_York
-- > 2013-11-03 16:38:16 EST
--
getCurrentLocalDateTime :: TZ.City -> IO LocalDateTime
getCurrentLocalDateTime city = getTransitions city >>= getCurrentLocalDateTime'
-- | Get the current local date and time from the system clock using preloaded transition
-- times.
--
-- > >>> ttimes <- getTransitions Moscow
-- > >>> getCurrentLocalDateTime' ttimes
-- > 2013-11-04 01:41:50 MSK
--
-- Use this function if you need to get the current local date and time more than once.
-- The use of preloaded transition times will avoid unnecessary parsing of Olson files.
getCurrentLocalDateTime' :: [Transition] -> IO LocalDateTime
getCurrentLocalDateTime' ttimes = do
time@UnixDateTime{..} <- getCurrentUnixDateTime
let base = baseUnixToUTC _udt_sec_base
f tt = localBase tt > base
mval = listToMaybe $ dropWhile f ttimes
zone = maybe (tz2w8 TZ.utc) localZone mval
if maybe True (/= convert time) nextLeap
then return $! LocalDateTime base zone
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.
--
-- > >>> getCurrentLocalDateTimeMillis Auckland
-- > 2013-11-04 10:46:13.123 NZDT
--
getCurrentLocalDateTimeMillis :: TZ.City -> IO LocalDateTimeMillis
getCurrentLocalDateTimeMillis city = getTransitions city >>= getCurrentLocalDateTimeMillis'
-- | Get the current local date and time with millisecond granularity from the system clock
-- using preloaded transition times.
--
-- > >>> ttimes <- getTransitions Tehran
-- > >>> getCurrentLocalDateTimeMillis' ttimes
-- > 2013-11-04 01:20:49.435 IRST
--
-- Use this function if you need to get the current local date and time with millisecond
-- granularity more than once. The use of preloaded transition times will avoid unnecessary
-- parsing of Olson files.
getCurrentLocalDateTimeMillis' :: [Transition] -> IO LocalDateTimeMillis
getCurrentLocalDateTimeMillis' ttimes = do
time@UnixDateTimeMillis{..} <- getCurrentUnixDateTimeMillis
let (seconds, millis) = first baseUnixToUTC $ _udt_mil_base `divMod` 1000
f tt = localBase tt > seconds
mval = listToMaybe $ dropWhile f ttimes
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 (_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.
--
-- > >>> getCurrentLocalDateTimeMicros Tel_Aviv
-- > 2013-11-03 23:55:30.935387 IST
--
getCurrentLocalDateTimeMicros :: TZ.City -> IO LocalDateTimeMicros
getCurrentLocalDateTimeMicros city = getTransitions city >>= getCurrentLocalDateTimeMicros'
-- | Get the current local date and time with microsecond granularity from the system clock
-- using preloaded transition times.
--
-- > >>> ttimes <- getTransitions Sao_Paulo
-- > >>> getCurrentLocalDateTimeMicros' ttimes
-- > 2013-11-03 19:58:50.405806 BRST
--
-- Use this function if you need to get the current local date and time with microsecond
-- granularity more than once. The use of preloaded transition times will avoid unnecessary
-- parsing of Olson files.
getCurrentLocalDateTimeMicros' :: [Transition] -> IO LocalDateTimeMicros
getCurrentLocalDateTimeMicros' ttimes = do
time@UnixDateTimeMicros{..} <- getCurrentUnixDateTimeMicros
let (seconds, micros) = first baseUnixToUTC $ _udt_mic_base `divMod` 1000000
f tt = localBase tt > seconds
mval = listToMaybe $ dropWhile f ttimes
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 (_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.
--
-- > >>> getCurrentLocalDateTimeNanos Brussels
-- > 2013-11-03 23:01:07.337488000 CET
--
-- Note that this functions calls @gettimeofday@ behind the scenes. Therefore, the resultant
-- timestamp will have nanosecond granularity, but only microsecond resolution.
getCurrentLocalDateTimeNanos :: TZ.City -> IO LocalDateTimeNanos
getCurrentLocalDateTimeNanos city = getTransitions city >>= getCurrentLocalDateTimeNanos'
-- | Get the current local date and time with nanosecond granularity from the system clock
-- using preloaded transition times.
--
-- > >>> ttimes <- getTransitions Mogadishu
-- > >>> getCurrentLocalDateTimeNanos' ttimes
-- > 2013-11-04 01:15:08.664426000 EAT
--
-- Use this function if you need to get the current local date and time with nanosecond
-- granularity more than once. The use of preloaded transition times will avoid unnecessary
-- parsing of Olson files.
--
-- Note that this functions calls @gettimeofday@ behind the scenes. Therefore, the resultant
-- timestamp will have nanosecond granularity, but only microsecond resolution.
getCurrentLocalDateTimeNanos' :: [Transition] -> IO LocalDateTimeNanos
getCurrentLocalDateTimeNanos' ttimes = do
time@UnixDateTimeNanos{..} <- getCurrentUnixDateTimeNanos
let (seconds, micros) = first baseUnixToUTC $ _udt_nan_base `divMod` 1000000
f tt = localBase tt > seconds
mval = listToMaybe $ dropWhile f ttimes
zone = maybe (tz2w8 TZ.utc) localZone mval
base = seconds * 1000000 + micros
if maybe True (/= convert time) nextLeap
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.
--
-- > >>> getCurrentLocalDateTimePicos Karachi
-- > 2013-11-04 22:05:17.556043000000 PKT
--
-- Note that this functions calls @gettimeofday@ behind the scenes. Therefore, the resultant
-- timestamp will have picosecond granularity, but only microsecond resolution.
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
-- preloaded transition times.
--
-- > >>> ttimes <- getTransitions Baghdad
-- > >>> getCurrentLocalDateTimePicos' ttimes
-- > 2013-11-04 01:20:57.502906000000 AST
--
-- Use this function if you need to get the current local date and time with picosecond
-- granularity more than once. The use of preloaded transition times will avoid unnecessary
-- parsing of Olson files.
--
-- Note that this functions calls @gettimeofday@ behind the scenes. Therefore, the resultant
-- timestamp will have picosecond granularity, but only microsecond resolution.
getCurrentLocalDateTimePicos' :: [Transition] -> IO LocalDateTimePicos
getCurrentLocalDateTimePicos' ttimes = do
time@UnixDateTimePicos{..} <- getCurrentUnixDateTimePicos
let (seconds, micros) = first baseUnixToUTC $ _udt_pic_base `divMod` 1000000
f tt = localBase tt > seconds
mval = listToMaybe $ dropWhile f ttimes
zone = maybe (tz2w8 TZ.utc) localZone mval
base = seconds * 1000000 + micros
if maybe True (/= convert time) nextLeap
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.
fromNanos :: LocalDateTimeNanos -> Integer
fromNanos (LocalDateTimeNanos base nano _) = toInteger base * 1000 + toInteger nano
-- | Convert an integer into a local date and time with nanosecond granularity.
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.
fromPicos :: LocalDateTimePicos -> Integer
fromPicos (LocalDateTimePicos base pico _) = toInteger base * 1000000 + toInteger pico
-- | Convert an integer into a local date and time with picosecond granularity.
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)
instance Duration LocalDateTime Second where
duration (LocalDateTime old _) (LocalDateTime new _) = Second (new - old)
instance Duration LocalDateTimeMillis Second where
duration (LocalDateTimeMillis old _ ) (LocalDateTimeMillis new _ ) = Second (new - old) `div` 1000
instance Duration LocalDateTimeMicros Second where
duration (LocalDateTimeMicros old _ ) (LocalDateTimeMicros new _ ) = Second (new - old) `div` 1000000
instance Duration LocalDateTimeNanos Second where
duration (LocalDateTimeNanos old _ _) (LocalDateTimeNanos new _ _) = Second (new - old) `div` 1000000
instance Duration LocalDateTimePicos Second where
duration (LocalDateTimePicos old _ _) (LocalDateTimePicos new _ _) = Second (new - old) `div` 1000000
instance Duration LocalDateTimeMillis Millis where
duration (LocalDateTimeMillis old _ ) (LocalDateTimeMillis new _ ) = Millis (new - old)
instance Duration LocalDateTimeMicros Millis where
duration (LocalDateTimeMicros old _ ) (LocalDateTimeMicros new _ ) = Millis (new - old) `div` 1000
instance Duration LocalDateTimeNanos Millis where
duration (LocalDateTimeNanos old _ _) (LocalDateTimeNanos new _ _) = Millis (new - old) `div` 1000
instance Duration LocalDateTimePicos Millis where
duration (LocalDateTimePicos old _ _) (LocalDateTimePicos new _ _) = Millis (new - old) `div` 1000
instance Duration LocalDateTimeMicros Micros where
duration (LocalDateTimeMicros old _ ) (LocalDateTimeMicros new _ ) = Micros (new - old)
instance Duration LocalDateTimeNanos Micros where
duration (LocalDateTimeNanos old _ _) (LocalDateTimeNanos new _ _) = Micros (new - old)
instance Duration LocalDateTimePicos Micros where
duration (LocalDateTimePicos old _ _) (LocalDateTimePicos new _ _) = Micros (new - old)
instance Duration LocalDateTimeNanos Nanos where
duration old new =
if res < toInteger (maxBound::Int64) then Nanos $ fromInteger res
else error "duration{LocalDateTimeNanos,Nanos}: integer overflow"
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 = 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 = 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'') } }
randomR (a,b) 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'') } }
randomR (a,b) 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'') } }
randomR (a,b) 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'') } }
randomR (a,b) 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'') -> (toNanos base zone, g'') } }
randomR (a,b) 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'') -> (toPicos base zone, g'') } }
randomR (a,b) g =
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.
--
-- > >>> prettyLocalDate $ createLocalDate 2014 September 25 Japan_Standard_Time
-- > "Thursday, September 25th, 2014 (JST)"
--
prettyLocalDate :: LocalDate -> String
prettyLocalDate date =
printf "%s, %s %s, %04d (%s)" wday mon mday _dz_year abbr
where DateZoneStruct{..} = toDateZoneStruct date
wday = show _dz_wday
mon = show _dz_mon
mday = show _dz_mday ++ showSuffix _dz_mday
abbr = show $ TZ.abbreviate _dz_zone
-- | Show a local date and time as a pretty string.
--
-- > >>> getCurrentLocalDateTime Los_Angeles >>= return . prettyLocalDateTime
-- > "2:17 AM, Wednesday, January 1st, 2014 (PST)"
--
prettyLocalDateTime :: DateTimeZone dtz => dtz -> String
prettyLocalDateTime time =
printf str hour _dtz_min ampm wday mon mday _dtz_year abbr
where DateTimeZoneStruct{..} = toDateTimeZoneStruct time
str = "%d:%02d %s, %s, %s %s, %04d (%s)"
wday = show _dtz_wday
mon = show _dtz_mon
mday = show _dtz_mday ++ showSuffix _dtz_mday
abbr = show $ TZ.abbreviate _dtz_zone
ampm = showPeriod _dtz_hour
hour | _dtz_hour == 00 = 12
| _dtz_hour <= 12 = _dtz_hour
| otherwise = _dtz_hour - 12
-- | Maximum enumerated time zone value.
maxzone :: Word8
maxzone = tz2w8 maxBound
-- | Convert an integral type into a time zone.
w82tz :: Word8 -> TZ.TimeZone
w82tz = toEnum . fromIntegral
-- | Convert a time zone into a numeric value.
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
check f x =
if minBound <= x && x <= maxBound then x
else error $ f ++ ": base (" ++ base ++ ") out of bounds (" ++ bounds ++ ")"
where base = show (localBase x)
bounds = show (localBase (minBound::a)) ++ "," ++ show (localBase (maxBound::a))
-- | Coerce a tuple of integral types.
doubleInt :: (Integral a, Integral b, Num c, Num d) => (a, b) -> (c, d)
doubleInt = fromIntegral *** fromIntegral