time-exts-1.0.2: src/Data/Time/Exts/Unix.hs
---------------------------------------------------------------
-- Copyright (c) 2013, Enzo Haussecker. All rights reserved. --
---------------------------------------------------------------
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS -Wall #-}
{-# OPTIONS -fno-warn-name-shadowing #-}
#include "MachDeps.h"
-- | Types and functions for Unix timestamps.
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
) 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 (mkLabels, modify)
import Data.Time.Exts.Base
import Data.Typeable (Typeable)
import Foreign.C.Types (CInt(..))
import Foreign.Marshal.Utils (with)
import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr)
import Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import System.Random (Random(..))
import Text.Printf (printf)
-- | A class of Unix timestamps.
class Unix x
-- | A Unix date.
newtype UnixDate = UnixDate Int32
deriving (Eq,FromJSON,Generic,Integral,NFData,Num,Ord,Random,Real,Storable,ToJSON,Typeable)
-- | A Unix date and time.
newtype UnixDateTime = UnixDateTime Int64
deriving (Eq,FromJSON,Generic,Integral,NFData,Num,Ord,Random,Real,Storable,ToJSON,Typeable)
-- | A Unix date and time with millisecond granularity.
data UnixDateTimeMillis = UnixDateTimeMillis {
_uni_mil_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (excluding leap seconds)
, _uni_mil_mill :: {-# UNPACK #-} !Int16 -- ^ millisecinds
} deriving (Eq,Generic,Ord,Typeable)
-- | A Unix date and time with microsecond granularity.
data UnixDateTimeMicros = UnixDateTimeMicros {
_uni_mic_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (excluding leap seconds)
, _uni_mic_micr :: {-# UNPACK #-} !Int32 -- ^ microsecinds
} deriving (Eq,Generic,Ord,Typeable)
-- | A Unix date and time with nanosecond granularity.
data UnixDateTimeNanos = UnixDateTimeNanos {
_uni_nan_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (excluding leap seconds)
, _uni_nan_nano :: {-# UNPACK #-} !Int32 -- ^ nanosecinds
} deriving (Eq,Generic,Ord,Typeable)
-- | A Unix date and time with picosecond granularity.
data UnixDateTimePicos = UnixDateTimePicos {
_uni_pic_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (excluding leap seconds)
, _uni_pic_pico :: {-# UNPACK #-} !Int64 -- ^ picosecinds
} deriving (Eq,Generic,Ord,Typeable)
data TimeOfDay = TimeOfDay {
tod_base :: Int64
, tod_mic :: Int64
}
instance Enum UnixDate where
succ = flip plus $ Day 1
pred = flip plus . Day $ - 1
toEnum n | minBound <= day && day <= maxBound = day
| otherwise = error "toEnum: out of range"
where day = fromIntegral n
fromEnum = fromIntegral
instance Enum UnixDateTime where
succ = flip plus $ Second 1
pred = flip plus . Second $ - 1
toEnum n | minBound <= sec && sec <= maxBound = sec
| otherwise = error "toEnum: out of range"
where sec = fromIntegral n
#if WORD_SIZE_IN_BITS == 64
fromEnum = fromIntegral
#endif
mkLabels [''UnixDateTimeMicros
,''UnixDateTimeMillis
,''UnixDateTimeNanos
,''UnixDateTimePicos
]
instance Bounded UnixDate where
minBound = 0000000
maxBound = 2932896
instance Bounded UnixDateTime where
minBound = 000000000000
maxBound = 253402300799
instance Bounded UnixDateTimeMillis where
minBound = UnixDateTimeMillis 000000000000 000
maxBound = UnixDateTimeMillis 253402300799 999
instance Bounded UnixDateTimeMicros where
minBound = UnixDateTimeMicros 000000000000 000000
maxBound = UnixDateTimeMicros 253402300799 999999
instance Bounded UnixDateTimeNanos where
minBound = UnixDateTimeNanos 000000000000 000000000
maxBound = UnixDateTimeNanos 253402300799 999999999
instance Bounded UnixDateTimePicos where
minBound = UnixDateTimePicos 000000000000 000000000000
maxBound = UnixDateTimePicos 253402300799 999999999999
instance Convertible UnixDateTime UnixDate where
safeConvert = Right . fromIntegral . flip div 86400
instance Convertible UnixDateTimeMillis UnixDate where
safeConvert = Right . fromIntegral . flip div 86400 . _uni_mil_base
instance Convertible UnixDateTimeMicros UnixDate where
safeConvert = Right . fromIntegral . flip div 86400 . _uni_mic_base
instance Convertible UnixDateTimeNanos UnixDate where
safeConvert = Right . fromIntegral . flip div 86400 . _uni_nan_base
instance Convertible UnixDateTimePicos UnixDate where
safeConvert = Right . fromIntegral . flip div 86400 . _uni_pic_base
instance Date UnixDate where
toDateStruct = decompUnixDate
fromDateStruct DateStruct{..} =
createUnixDate _d_year _d_mon _d_mday
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 DateTimeMath UnixDate Day where
timestamp `plus` days =
if minBound <= date && date <= maxBound
then date else error "plus: out of range"
where date = timestamp + fromIntegral days
instance DateTimeMath UnixDateTime Day where
timestamp `plus` days =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = timestamp + fromIntegral days * 86400
instance DateTimeMath UnixDateTimeMillis Day where
timestamp `plus` days =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_mil_base (+ fromIntegral days * 86400) timestamp
instance DateTimeMath UnixDateTimeMicros Day where
timestamp `plus` days =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_mic_base (+ fromIntegral days * 86400) timestamp
instance DateTimeMath UnixDateTimeNanos Day where
timestamp `plus` days =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_nan_base (+ fromIntegral days * 86400) timestamp
instance DateTimeMath UnixDateTimePicos Day where
timestamp `plus` days =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_pic_base (+ fromIntegral days * 86400) timestamp
instance DateTimeMath UnixDateTime Hour where
timestamp `plus` hour =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = timestamp + fromIntegral hour * 3600
instance DateTimeMath UnixDateTimeMillis Hour where
timestamp `plus` hour =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_mil_base (+ fromIntegral hour * 3600) timestamp
instance DateTimeMath UnixDateTimeMicros Hour where
timestamp `plus` hour =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_mic_base (+ fromIntegral hour * 3600) timestamp
instance DateTimeMath UnixDateTimeNanos Hour where
timestamp `plus` hour =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_nan_base (+ fromIntegral hour * 3600) timestamp
instance DateTimeMath UnixDateTimePicos Hour where
timestamp `plus` hour =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_pic_base (+ fromIntegral hour * 3600) timestamp
instance DateTimeMath UnixDateTime Minute where
timestamp `plus` mins =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = timestamp + fromIntegral mins * 60
instance DateTimeMath UnixDateTimeMillis Minute where
timestamp `plus` mins =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_mil_base (+ fromIntegral mins * 60) timestamp
instance DateTimeMath UnixDateTimeMicros Minute where
timestamp `plus` mins =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_mic_base (+ fromIntegral mins * 60) timestamp
instance DateTimeMath UnixDateTimeNanos Minute where
timestamp `plus` mins =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_nan_base (+ fromIntegral mins * 60) timestamp
instance DateTimeMath UnixDateTimePicos Minute where
timestamp `plus` mins =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_pic_base (+ fromIntegral mins * 60) timestamp
instance DateTimeMath UnixDateTime Second where
timestamp `plus` secs =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = timestamp + fromIntegral secs
instance DateTimeMath UnixDateTimeMillis Second where
timestamp `plus` secs =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_mil_base (+ fromIntegral secs) timestamp
instance DateTimeMath UnixDateTimeMicros Second where
timestamp `plus` secs =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_mic_base (+ fromIntegral secs) timestamp
instance DateTimeMath UnixDateTimeNanos Second where
timestamp `plus` secs =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_nan_base (+ fromIntegral secs) timestamp
instance DateTimeMath UnixDateTimePicos Second where
timestamp `plus` secs =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where time = modify uni_pic_base (+ fromIntegral secs) timestamp
instance DateTimeMath UnixDateTimeMillis Millis where
UnixDateTimeMillis{..} `plus` mils =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where msum = fromIntegral _uni_mil_mill + fromIntegral mils
base = _uni_mil_base + msum `div` 1000
time = UnixDateTimeMillis base . fromIntegral $ msum `mod` 1000
instance DateTimeMath UnixDateTimeMicros Millis where
UnixDateTimeMicros{..} `plus` mils =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where msum = fromIntegral _uni_mic_micr + fromIntegral mils * 1000
base = _uni_mic_base + msum `div` 1000000
time = UnixDateTimeMicros base . fromIntegral $ msum `mod` 1000000
instance DateTimeMath UnixDateTimeNanos Millis where
UnixDateTimeNanos{..} `plus` mils =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where msum = fromIntegral _uni_nan_nano + fromIntegral mils * 1000000
base = _uni_nan_base + msum `div` 1000000000
time = UnixDateTimeNanos base . fromIntegral $ msum `mod` 1000000000
instance DateTimeMath UnixDateTimePicos Millis where
UnixDateTimePicos{..} `plus` mils =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where psum = fromIntegral _uni_pic_pico + fromIntegral mils * 1000000000
base = _uni_pic_base + psum `div` 1000000000000
time = UnixDateTimePicos base . fromIntegral $ psum `mod` 1000000000000
instance DateTimeMath UnixDateTimeMicros Micros where
UnixDateTimeMicros{..} `plus` mics =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where msum = fromIntegral _uni_mic_micr + fromIntegral mics
base = _uni_mic_base + msum `div` 1000000
time = UnixDateTimeMicros base . fromIntegral $ msum `mod` 1000000
instance DateTimeMath UnixDateTimeNanos Micros where
UnixDateTimeNanos{..} `plus` mics =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where msum = fromIntegral _uni_nan_nano + fromIntegral mics * 1000
base = _uni_nan_base + msum `div` 1000000000
time = UnixDateTimeNanos base . fromIntegral $ msum `mod` 1000000000
instance DateTimeMath UnixDateTimePicos Micros where
UnixDateTimePicos{..} `plus` mics =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where psum = fromIntegral _uni_pic_pico + fromIntegral mics * 1000000
base = _uni_pic_base + psum `div` 1000000000000
time = UnixDateTimePicos base . fromIntegral $ psum `mod` 1000000000000
instance DateTimeMath UnixDateTimeNanos Nanos where
UnixDateTimeNanos{..} `plus` nans =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where msum = fromIntegral _uni_nan_nano + fromIntegral nans
base = _uni_nan_base + msum `div` 1000000000
time = UnixDateTimeNanos base . fromIntegral $ msum `mod` 1000000000
instance DateTimeMath UnixDateTimePicos Nanos where
UnixDateTimePicos{..} `plus` nans =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where psum = fromIntegral _uni_pic_pico + fromIntegral nans * 1000
base = _uni_pic_base + psum `div` 1000000000000
time = UnixDateTimePicos base . fromIntegral $ psum `mod` 1000000000000
instance DateTimeMath UnixDateTimePicos Picos where
UnixDateTimePicos{..} `plus` pics =
if minBound <= time && time <= maxBound
then time else error "plus: out of range"
where psum = fromIntegral _uni_pic_pico + fromIntegral pics
base = _uni_pic_base + psum `div` 1000000000000
time = UnixDateTimePicos base . fromIntegral $ psum `mod` 1000000000000
instance FromJSON UnixDateTimeMillis
instance FromJSON UnixDateTimeMicros
instance FromJSON UnixDateTimeNanos
instance FromJSON UnixDateTimePicos
instance NFData UnixDateTimeMillis
instance NFData UnixDateTimeMicros
instance NFData UnixDateTimeNanos
instance NFData UnixDateTimePicos
instance Pretty UnixDate where pretty = prettyUnixDate
instance Pretty UnixDateTime where pretty = prettyUnixDateTime
instance Pretty UnixDateTimeMillis where pretty = prettyUnixDateTime
instance Pretty UnixDateTimeMicros where pretty = prettyUnixDateTime
instance Pretty UnixDateTimeNanos where pretty = prettyUnixDateTime
instance Pretty UnixDateTimePicos where pretty = prettyUnixDateTime
instance Random UnixDateTimeMillis where
random = first (uncurry UnixDateTimeMillis . (***) fromInteger fromInteger . flip divMod 1000) . randomR (0, 253402300799999)
randomR (a, b) = first (uncurry UnixDateTimeMillis . (***) fromInteger fromInteger . flip divMod 1000) . randomR (minval, maxval)
where minval = toInteger (_uni_mil_mill a) + toInteger (_uni_mil_base a) * 1000
maxval = toInteger (_uni_mil_mill b) + toInteger (_uni_mil_base b) * 1000
instance Random UnixDateTimeMicros where
random = first (uncurry UnixDateTimeMicros . (***) fromInteger fromInteger . flip divMod 1000000) . randomR (0, 253402300799999999)
randomR (a, b) = first (uncurry UnixDateTimeMicros . (***) fromInteger fromInteger . flip divMod 1000000) . randomR (minval, maxval)
where minval = toInteger (_uni_mic_micr a) + toInteger (_uni_mic_base a) * 1000000
maxval = toInteger (_uni_mic_micr b) + toInteger (_uni_mic_base b) * 1000000
instance Random UnixDateTimeNanos where
random = first (uncurry UnixDateTimeNanos . (***) fromInteger fromInteger . flip divMod 1000000000) . randomR (0, 253402300799999999999)
randomR (a, b) = first (uncurry UnixDateTimeNanos . (***) fromInteger fromInteger . flip divMod 1000000000) . randomR (minval, maxval)
where minval = toInteger (_uni_nan_nano a) + toInteger (_uni_nan_base a) * 1000000000
maxval = toInteger (_uni_nan_nano b) + toInteger (_uni_nan_base b) * 1000000000
instance Random UnixDateTimePicos where
random = first (uncurry UnixDateTimePicos . (***) fromInteger fromInteger . flip divMod 1000000000000) . randomR (0, 253402300799999999999999)
randomR (a, b) = first (uncurry UnixDateTimePicos . (***) fromInteger fromInteger . flip divMod 1000000000000) . randomR (minval, maxval)
where minval = toInteger (_uni_pic_pico a) + toInteger (_uni_pic_base a) * 1000000000000
maxval = toInteger (_uni_pic_pico b) + toInteger (_uni_pic_base b) * 1000000000000
instance Show UnixDate where
show date = printf "%04d-%02d-%02d" _d_year _d_mon _d_mday
where DateStruct{..} = toDateStruct date
instance Show UnixDateTime where
show time = printf "%04d-%02d-%02d %02d:%02d:%02d" _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec
where DateTimeStruct{..} = toDateTimeStruct time
sec = round _dt_sec :: Second
instance Show UnixDateTimeMillis where
show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%03d" _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec mil
where DateTimeStruct{..} = toDateTimeStruct time
(sec, mil) = properFracMillis _dt_sec
instance Show UnixDateTimeMicros where
show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%06d" _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec mic
where DateTimeStruct{..} = toDateTimeStruct time
(sec, mic) = properFracMicros _dt_sec
instance Show UnixDateTimeNanos where
show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%09d" _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec nan
where DateTimeStruct{..} = toDateTimeStruct time
(sec, nan) = properFracNanos _dt_sec
instance Show UnixDateTimePicos where
show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%012d" _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec pic
where DateTimeStruct{..} = toDateTimeStruct time
(sec, pic) = properFracPicos _dt_sec
instance Storable UnixDateTimeMillis where
sizeOf _ = 10
alignment = sizeOf
peekElemOff ptr n = do
let off = 10 * n
base <- peek . plusPtr ptr $ off
mil <- peek . plusPtr ptr $ off + 8
return $! UnixDateTimeMillis base mil
pokeElemOff ptr n UnixDateTimeMillis{..} = do
let off = 10 * n
poke (plusPtr ptr $ off ) _uni_mil_base
poke (plusPtr ptr $ off + 8) _uni_mil_mill
instance Storable UnixDateTimeMicros where
sizeOf _ = 12
alignment = sizeOf
peekElemOff ptr n = do
let off = 12 * n
base <- peek . plusPtr ptr $ off
mic <- peek . plusPtr ptr $ off + 8
return $! UnixDateTimeMicros base mic
pokeElemOff ptr n UnixDateTimeMicros{..} = do
let off = 12 * n
poke (plusPtr ptr $ off ) _uni_mic_base
poke (plusPtr ptr $ off + 8) _uni_mic_micr
instance Storable UnixDateTimeNanos where
sizeOf _ = 12
alignment = sizeOf
peekElemOff ptr n = do
let off = 12 * n
base <- peek . plusPtr ptr $ off
nan <- peek . plusPtr ptr $ off + 8
return $! UnixDateTimeNanos base nan
pokeElemOff ptr n UnixDateTimeNanos{..} = do
let off = 12 * n
poke (plusPtr ptr $ off ) _uni_nan_base
poke (plusPtr ptr $ off + 8) _uni_nan_nano
instance Storable UnixDateTimePicos where
sizeOf _ = 16
alignment = sizeOf
peekElemOff ptr n = do
let off = 16 * n
base <- peek . plusPtr ptr $ off
pic <- peek . plusPtr ptr $ off + 8
return $! UnixDateTimePicos base pic
pokeElemOff ptr n UnixDateTimePicos{..} = do
let off = 16 * n
poke (plusPtr ptr $ off ) _uni_pic_base
poke (plusPtr ptr $ off + 8) _uni_pic_pico
instance Storable TimeOfDay where
sizeOf _ = 16
alignment = sizeOf
peekElemOff ptr n = do
let off = 16 * n
base <- peek . plusPtr ptr $ off
mic <- peek . plusPtr ptr $ off + 8
return $! TimeOfDay base mic
pokeElemOff ptr n TimeOfDay{..} = do
let off = 16 * n
poke (plusPtr ptr $ off ) tod_base
poke (plusPtr ptr $ off + 8) tod_mic
instance ToJSON UnixDateTimeMillis
instance ToJSON UnixDateTimeMicros
instance ToJSON UnixDateTimeNanos
instance ToJSON UnixDateTimePicos
instance Unix UnixDate
instance Unix UnixDateTime
instance Unix UnixDateTimeMillis
instance Unix UnixDateTimeMicros
instance Unix UnixDateTimeNanos
instance Unix UnixDateTimePicos
foreign import ccall "gettimeofday"
getTimeOfDay :: Ptr TimeOfDay -> Ptr () -> IO CInt
-- | Create a Unix date.
--
-- > >>> createUnixDate 2013 11 03
-- > 2013-11-03
--
createUnixDate :: Year -> Month -> Day -> UnixDate
createUnixDate year month day =
if minBound <= date && date <= maxBound then date
else error "createUnixDate: date not supported"
where date = fromIntegral $ epochToDate year month day
-- | Create a Unix date and time.
--
-- > >>> createUnixDateTime 2013 11 03 22 58 29
-- > 2013-11-03 22:58:29
--
createUnixDateTime :: Year -> Month -> Day -> Hour -> Minute -> Second -> UnixDateTime
createUnixDateTime year month day hour minute second =
if minBound <= time && time <= maxBound then time
else error "createUnixDateTime: time not supported"
where days = epochToDate year month day
secs = dateToTime hour minute second
time = fromIntegral days * 86400 + fromIntegral secs
-- | Create a Unix date and time with millisecond granularity.
--
-- > >>> createUnixDateTimeMillis 2013 11 03 22 59 13 922
-- > 2013-11-03 22:59:13.922
--
createUnixDateTimeMillis :: Year -> Month -> Day -> Hour -> Minute -> Second -> Millis -> UnixDateTimeMillis
createUnixDateTimeMillis year month day hour minute second millisecond =
if minBound <= time && time <= maxBound then time
else error "createUnixDateTimeMillis: time not supported"
where mils = fromIntegral $ millisecond `mod` 1000
adds = fromIntegral $ millisecond `div` 1000
days = fromIntegral $ epochToDate year month day
secs = fromIntegral $ dateToTime hour minute second
base = days * 86400 + secs + adds
time = UnixDateTimeMillis base mils
-- | Create a Unix date and time with microsecond granularity.
--
-- > >>> createUnixDateTimeMicros 2013 11 03 23 00 13 573166
-- > 2013-11-03 23:00:13.573166
--
createUnixDateTimeMicros :: Year -> Month -> Day -> Hour -> Minute -> Second -> Micros -> UnixDateTimeMicros
createUnixDateTimeMicros year month day hour minute second microsecond =
if minBound <= time && time <= maxBound then time
else error "createUnixDateTimeMicros: time not supported"
where mics = fromIntegral $ microsecond `mod` 1000000
adds = fromIntegral $ microsecond `div` 1000000
days = fromIntegral $ epochToDate year month day
secs = fromIntegral $ dateToTime hour minute second
base = days * 86400 + secs + adds
time = UnixDateTimeMicros base mics
-- | Create a Unix date and time with nanosecond granularity.
--
-- > >>> createUnixDateTimeNanos 2013 11 03 23 01 43 946387023
-- > 2013-11-03 23:01:43.946387023
--
createUnixDateTimeNanos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Nanos -> UnixDateTimeNanos
createUnixDateTimeNanos year month day hour minute second nanosecond =
if minBound <= time && time <= maxBound then time
else error "createUnixDateTimeNanos: time not supported"
where nans = fromIntegral $ nanosecond `mod` 1000000000
adds = fromIntegral $ nanosecond `div` 1000000000
days = fromIntegral $ epochToDate year month day
secs = fromIntegral $ dateToTime hour minute second
base = days * 86400 + secs + adds
time = UnixDateTimeNanos base nans
-- | Create a Unix date and time with picosecond granularity.
--
-- > >>> createUnixDateTimePicos 2013 11 03 23 04 35 816235224967
-- > 2013-11-03 23:04:35.816235224967
--
createUnixDateTimePicos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Picos -> UnixDateTimePicos
createUnixDateTimePicos year month day hour minute second picosecond =
if minBound <= time && time <= maxBound then time
else error "createUnixDateTimePicos: time not supported"
where pics = fromIntegral $ picosecond `mod` 1000000000000
adds = fromIntegral $ picosecond `div` 1000000000000
days = fromIntegral $ epochToDate year month day
secs = fromIntegral $ dateToTime hour minute second
base = days * 86400 + secs + adds
time = UnixDateTimePicos base pics
-- | Decompose a Unix date into a human-readable format.
decompUnixDate :: UnixDate -> DateStruct
decompUnixDate date =
go 1970 $ fromIntegral date
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 = dayOfWeek date
leap = isLeapYear year
size = if leap then 366 else 365
(,) month mday = decompYearToDate days leap
-- | 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 (12, days - 334)
else if days >= 305
then (11, days - 304)
else (10, days - 273)
else if days >= 244
then (09, days - 243)
else if days >= 213
then (08, days - 212)
else (07, days - 181)
else if days >= 091
then if days >= 152
then (06, days - 151)
else if days >= 121
then (05, days - 120)
else (04, days - 090)
else if days >= 060
then (03, days - 059)
else if days >= 031
then (02, days - 030)
else (01, days + 001)
else if days >= 181
then if days >= 273
then if days >= 334
then (12, days - 333)
else if days >= 304
then (11, days - 303)
else (10, days - 272)
else if days >= 243
then (09, days - 242)
else if days >= 212
then (08, days - 211)
else (07, days - 180)
else if days >= 090
then if days >= 151
then (06, days - 150)
else if days >= 120
then (05, days - 119)
else (04, days - 089)
else if days >= 059
then (03, days - 058)
else if days >= 031
then (02, days - 030)
else (01, days + 001)
-- | Compute the day of the week from the given Unix date.
dayOfWeek :: UnixDate -> DayOfWeek
dayOfWeek date =
case date `mod` 7 of
0 -> Thursday
1 -> Friday
2 -> Saturday
3 -> Sunday
4 -> Monday
5 -> Tuesday
_ -> Wednesday
-- | Decompose a Unix date and time into a human-readable format.
decompUnixDateTime :: UnixDateTime -> DateTimeStruct
decompUnixDateTime time =
DateTimeStruct _d_year _d_mon _d_mday _d_wday hour min sec
where DateStruct{..} = decompUnixDate date
date = fromIntegral $ time `div` 86400
mod1 = fromIntegral $ time `mod` 86400
hour = fromIntegral $ mod1 `div` 03600
mod2 = mod1 `mod` 03600
min = mod2 `div` 00060
sec = fromIntegral $ mod2 `mod` 00060
-- | Decompose a Unix date and time with millisecond granularity into a human-readable format.
decompUnixDateTimeMillis :: UnixDateTimeMillis -> DateTimeStruct
decompUnixDateTimeMillis UnixDateTimeMillis{..} =
DateTimeStruct _d_year _d_mon _d_mday _d_wday hour min $ sec + frac
where DateStruct{..} = decompUnixDate date
date = fromIntegral $ time `div` 86400
mod1 = fromIntegral $ time `mod` 86400
hour = fromIntegral $ mod1 `div` 03600
mod2 = mod1 `mod` 03600
min = mod2 `div` 00060
sec = fromIntegral $ mod2 `mod` 00060
time = _uni_mil_base
frac = fromIntegral _uni_mil_mill / 1000
-- | Decompose a Unix date and time with microsecond granularity into a human-readable format.
decompUnixDateTimeMicros :: UnixDateTimeMicros -> DateTimeStruct
decompUnixDateTimeMicros UnixDateTimeMicros{..} =
DateTimeStruct _d_year _d_mon _d_mday _d_wday hour min $ sec + frac
where DateStruct{..} = decompUnixDate date
date = fromIntegral $ time `div` 86400
mod1 = fromIntegral $ time `mod` 86400
hour = fromIntegral $ mod1 `div` 03600
mod2 = mod1 `mod` 03600
min = mod2 `div` 00060
sec = fromIntegral $ mod2 `mod` 00060
time = _uni_mic_base
frac = fromIntegral _uni_mic_micr / 1000000
-- | Decompose a Unix date and time with nanosecond granularity into a human-readable format.
decompUnixDateTimeNanos :: UnixDateTimeNanos -> DateTimeStruct
decompUnixDateTimeNanos UnixDateTimeNanos{..} =
DateTimeStruct _d_year _d_mon _d_mday _d_wday hour min $ sec + frac
where DateStruct{..} = decompUnixDate date
date = fromIntegral $ base `div` 86400
mod1 = fromIntegral $ base `mod` 86400
hour = fromIntegral $ mod1 `div` 03600
mod2 = mod1 `mod` 03600
min = mod2 `div` 00060
sec = fromIntegral $ mod2 `mod` 00060
base = _uni_nan_base
frac = fromIntegral _uni_nan_nano / 1000000000
-- | Decompose a Unix date and time with picosecond granularity into a human-readable format.
decompUnixDateTimePicos :: UnixDateTimePicos -> DateTimeStruct
decompUnixDateTimePicos UnixDateTimePicos{..} =
DateTimeStruct _d_year _d_mon _d_mday _d_wday hour min $ sec + frac
where DateStruct{..} = decompUnixDate date
date = fromIntegral $ base `div` 86400
mod1 = fromIntegral $ base `mod` 86400
hour = fromIntegral $ mod1 `div` 03600
mod2 = mod1 `mod` 03600
min = mod2 `div` 00060
sec = fromIntegral $ mod2 `mod` 00060
base = _uni_pic_base
frac = fromIntegral _uni_pic_pico / 1000000000000
-- | 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 (TimeOfDay 0 0) $ \ ptr ->
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 (TimeOfDay 0 0) $ \ ptr ->
getTimeOfDay ptr nullPtr >>= getResult ptr
where getResult ptr 0 = peek ptr >>= \ TimeOfDay{..} ->
return $! UnixDateTimeMillis tod_base . fromIntegral $ tod_mic `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 (TimeOfDay 0 0) $ \ ptr ->
getTimeOfDay ptr nullPtr >>= getResult ptr
where getResult ptr 0 = peek ptr >>= \ TimeOfDay{..} ->
return $! UnixDateTimeMicros tod_base $ fromIntegral tod_mic
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 (TimeOfDay 0 0) $ \ ptr ->
getTimeOfDay ptr nullPtr >>= getResult ptr
where getResult ptr 0 = peek ptr >>= \ TimeOfDay{..} ->
return $! UnixDateTimeNanos tod_base $ fromIntegral tod_mic * 1000
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 (TimeOfDay 0 0) $ \ ptr ->
getTimeOfDay ptr nullPtr >>= getResult ptr
where getResult ptr 0 = peek ptr >>= \ TimeOfDay{..} ->
return $! UnixDateTimePicos tod_base $ fromIntegral tod_mic * 1000000
getResult _ _ = error "getCurrentUnixDateTimePicos: unknown"
-- | Show a Unix date as a string.
prettyUnixDate :: UnixDate -> String
prettyUnixDate date =
printf "%s, %s %s, %04d" wday mon mday _d_year
where DateStruct{..} = toDateStruct date
wday = show _d_wday
mon = prettyMonth _d_mon
mday = prettyDay _d_mday
-- | Show a Unix date and time as a string.
prettyUnixDateTime :: 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 = prettyMonth _dt_mon
mday = prettyDay _dt_mday
(hour, ampm) = prettyHour _dt_hour