time-exts-1.1.1: src/Data/Time/Exts/Unix
---------------------------------------------------------------
-- Copyright (c) 2014, Enzo Haussecker. All rights reserved. --
---------------------------------------------------------------
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS -Wall #-}
-- | Unix timestamps of varying granularity.
module Data.Time.Exts.Unix (
-- ** Unix Class
Unix(..)
-- ** 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
-- | 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
instance Unix UnixDateTime where
unixBase = get uni_sec_base
instance Unix UnixDateTimeMillis where
unixBase = get uni_mil_base
instance Unix UnixDateTimeMicros where
unixBase = get uni_mic_base
instance Unix UnixDateTimeNanos where
unixBase = get uni_nan_base
instance Unix UnixDateTimePicos where
unixBase = get uni_pic_base
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 = (***)