time-exts-2.0.0: src/Data/Time/Exts/Unix.hs
---------------------------------------------------------------
-- 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(..)
, UnixTime(..)
, UnixTimeMillis(..)
, UnixTimeMicros(..)
, UnixTimeNanos(..)
, UnixTimePicos(..)
, UnixDateTime(..)
, UnixDateTimeMillis(..)
, UnixDateTimeMicros(..)
, UnixDateTimeNanos(..)
, UnixDateTimePicos(..)
-- ** Create Unix Timestamps
, createUnixDate
, createUnixTime
, createUnixTimeMillis
, createUnixTimeMicros
, createUnixTimeNanos
, createUnixTimePicos
, createUnixDateTime
, createUnixDateTimeMillis
, createUnixDateTimeMicros
, createUnixDateTimeNanos
, createUnixDateTimePicos
-- ** Get Current Unix Timestamps
, getCurrentUnixDate
, getCurrentUnixTime
, getCurrentUnixTimeMillis
, getCurrentUnixTimeMicros
, getCurrentUnixTimeNanos
, getCurrentUnixTimePicos
, getCurrentUnixDateTime
, getCurrentUnixDateTimeMillis
, getCurrentUnixDateTimeMicros
, getCurrentUnixDateTimeNanos
, getCurrentUnixDateTimePicos
-- ** Pretty Unix Timestamps
, prettyUnixDate
, prettyUnixTime
, prettyUnixDateTime
) where
import Control.Arrow ((***), first)
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON, ToJSON)
import Data.Convertible (Convertible(..), convert)
import Data.Int (Int16, Int32, Int64)
import Data.Label (get, mkLabels, modify)
import Data.Time.Exts.Base
import Data.Time.Exts.C
import Data.Typeable (Typeable)
import Foreign.C.Types (CLong(..))
import Foreign.Marshal.Utils (with)
import Foreign.Ptr (castPtr, nullPtr, plusPtr)
import Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import System.Random (Random(..))
import Text.Printf (printf)
-- | The Unix timestamp type class.
class Unix u where
-- | Get the base component of a Unix timestamp.
unixBase :: u -> Int64
-- | Get the normalized base component of a Unix timestamp.
unixNorm :: u -> Int64
-- | Days since Unix epoch.
newtype UnixDate = UnixDate {
_ud_day_base :: Int32
} deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable)
-- | Seconds since midnight (excluding leap seconds).
newtype UnixTime = UnixTime {
_ut_sec_base :: Int32
} deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable)
-- | Milliseconds since midnight (excluding leap seconds).
newtype UnixTimeMillis = UnixTimeMillis {
_ut_mil_base :: Int32
} deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable)
-- | Microseconds since midnight (excluding leap seconds).
newtype UnixTimeMicros = UnixTimeMicros {
_ut_mic_base :: Int64
} deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable)
-- | Nanoseconds since midnight (excluding leap seconds).
newtype UnixTimeNanos = UnixTimeNanos {
_ut_nan_base :: Int64
} deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable)
-- | Picoseconds since midnight (excluding leap seconds).
newtype UnixTimePicos = UnixTimePicos {
_ut_pic_base :: Int64
} deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable)
-- | Seconds since Unix epoch (excluding leap seconds).
newtype UnixDateTime = UnixDateTime {
_udt_sec_base :: Int64
} deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable)
-- | Milliseconds since Unix epoch (excluding leap seconds).
newtype UnixDateTimeMillis = UnixDateTimeMillis {
_udt_mil_base :: Int64
} deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable)
-- | Microseconds since Unix epoch (excluding leap seconds).
newtype UnixDateTimeMicros = UnixDateTimeMicros {
_udt_mic_base :: Int64
} deriving (Eq,FromJSON,Generic,NFData,Ord,Storable,ToJSON,Typeable)
-- | Nanoseconds since Unix epoch (excluding leap seconds).
data UnixDateTimeNanos = UnixDateTimeNanos {
_udt_nan_base :: {-# UNPACK #-} !Int64
, _udt_nan_nano :: {-# UNPACK #-} !Int16
} deriving (Eq,Generic,Ord,Typeable)
-- | Picoseconds since Unix epoch (excluding leap seconds).
data UnixDateTimePicos = UnixDateTimePicos {
_udt_pic_base :: {-# UNPACK #-} !Int64
, _udt_pic_pico :: {-# UNPACK #-} !Int32
} deriving (Eq,Generic,Ord,Typeable)
instance FromJSON UnixDateTimeNanos
instance FromJSON UnixDateTimePicos
instance NFData UnixDateTimeNanos
instance NFData UnixDateTimePicos
instance Storable UnixDateTimeNanos where
sizeOf _ = 10
alignment = sizeOf
peekElemOff ptr n = do
let off = 10 * n
base <- peek . plusPtr ptr $ off
nano <- peek . plusPtr ptr $ off + 8
return $! UnixDateTimeNanos base nano
pokeElemOff ptr n UnixDateTimeNanos{..} = do
let off = 10 * n
poke (plusPtr ptr $ off ) _udt_nan_base
poke (plusPtr ptr $ off + 8) _udt_nan_nano
instance Storable UnixDateTimePicos where
sizeOf _ = 12
alignment = sizeOf
peekElemOff ptr n = do
let off = 12 * n
base <- peek . plusPtr ptr $ off
pico <- peek . plusPtr ptr $ off + 8
return $! UnixDateTimePicos base pico
pokeElemOff ptr n UnixDateTimePicos{..} = do
let off = 12 * n
poke (plusPtr ptr $ off ) _udt_pic_base
poke (plusPtr ptr $ off + 8) _udt_pic_pico
instance ToJSON UnixDateTimeNanos
instance ToJSON UnixDateTimePicos
mkLabels [ ''DateTimeStruct
, ''UnixDate
, ''UnixTime
, ''UnixTimeMillis
, ''UnixTimeMicros
, ''UnixTimeNanos
, ''UnixTimePicos
, ''UnixDateTime
, ''UnixDateTimeMillis
, ''UnixDateTimeMicros
, ''UnixDateTimeNanos
, ''UnixDateTimePicos
]
instance Bounded UnixDate where
minBound = UnixDate 0
maxBound = UnixDate 2932896
instance Bounded UnixTime where
minBound = UnixTime 0
maxBound = UnixTime 86399
instance Bounded UnixTimeMillis where
minBound = UnixTimeMillis 0
maxBound = UnixTimeMillis 86399999
instance Bounded UnixTimeMicros where
minBound = UnixTimeMicros 0
maxBound = UnixTimeMicros 86399999999
instance Bounded UnixTimeNanos where
minBound = UnixTimeNanos 0
maxBound = UnixTimeNanos 86399999999999
instance Bounded UnixTimePicos where
minBound = UnixTimePicos 0
maxBound = UnixTimePicos 86399999999999999
instance Bounded UnixDateTime where
minBound = UnixDateTime 0
maxBound = UnixDateTime 253402300799
instance Bounded UnixDateTimeMillis where
minBound = UnixDateTimeMillis 0
maxBound = UnixDateTimeMillis 253402300799999
instance Bounded UnixDateTimeMicros where
minBound = UnixDateTimeMicros 0
maxBound = UnixDateTimeMicros 253402300799999999
instance Bounded UnixDateTimeNanos where
minBound = UnixDateTimeNanos 0 0
maxBound = UnixDateTimeNanos 253402300799999999 999
instance Bounded UnixDateTimePicos where
minBound = UnixDateTimePicos 0 0
maxBound = UnixDateTimePicos 253402300799999999 999999
instance Unix UnixDate where
unixBase = fromIntegral . get ud_day_base
unixNorm = unixBase
instance Unix UnixTime where
unixBase = fromIntegral . get ut_sec_base
unixNorm = unixBase
instance Unix UnixTimeMillis where
unixBase = fromIntegral . get ut_mil_base
unixNorm = flip div 1000 . unixBase
instance Unix UnixTimeMicros where
unixBase = get ut_mic_base
unixNorm = flip div 1000000 . unixBase
instance Unix UnixTimeNanos where
unixBase = get ut_nan_base
unixNorm = flip div 1000000000 . unixBase
instance Unix UnixTimePicos where
unixBase = get ut_pic_base
unixNorm = flip div 1000000000000 . unixBase
instance Unix UnixDateTime where
unixBase = get udt_sec_base
unixNorm = unixBase
instance Unix UnixDateTimeMillis where
unixBase = get udt_mil_base
unixNorm = flip div 1000 . unixBase
instance Unix UnixDateTimeMicros where
unixBase = get udt_mic_base
unixNorm = flip div 1000000 . unixBase
instance Unix UnixDateTimeNanos where
unixBase = get udt_nan_base
unixNorm = flip div 1000000 . unixBase
instance Unix UnixDateTimePicos where
unixBase = get udt_pic_base
unixNorm = flip div 1000000 . unixBase
instance DateTimeMath UnixDate Day where
date `plus` Day day =
check "plus{UnixDate,Day}" $
modify ud_day_base (+ day) date
instance DateTimeMath UnixTime Hour where
time `plus` Hour hour =
check "plus{UnixTime,Hour}" $
modify ut_sec_base (+ fromIntegral hour * 3600) time
instance DateTimeMath UnixTime Minute where
time `plus` Minute minute =
check "plus{UnixTime,Minute}" $
modify ut_sec_base (+ fromIntegral minute * 60) time
instance DateTimeMath UnixTime Second where
time `plus` Second second =
check "plus{UnixTime,Second}" $
modify ut_sec_base (+ fromIntegral second) time
instance DateTimeMath UnixTimeMillis Hour where
time `plus` Hour hour =
check "plus{UnixTimeMillis,Hour}" $
modify ut_mil_base (+ fromIntegral hour * 3600000) time
instance DateTimeMath UnixTimeMillis Minute where
time `plus` Minute minute =
check "plus{UnixTimeMillis,Minute}" $
modify ut_mil_base (+ fromIntegral minute * 60000) time
instance DateTimeMath UnixTimeMillis Second where
time `plus` Second second =
check "plus{UnixTimeMillis,Second}" $
modify ut_mil_base (+ fromIntegral second * 1000) time
instance DateTimeMath UnixTimeMillis Millis where
time `plus` Millis millis =
check "plus{UnixTimeMillis,Millis}" $
modify ut_mil_base (+ fromIntegral millis) time
instance DateTimeMath UnixTimeMicros Hour where
time `plus` Hour hour =
check "plus{UnixTimeMicros,Hour}" $
modify ut_mic_base (+ hour * 3600000000) time
instance DateTimeMath UnixTimeMicros Minute where
time `plus` Minute minute =
check "plus{UnixTimeMicros,Minute}" $
modify ut_mic_base (+ minute * 60000000) time
instance DateTimeMath UnixTimeMicros Second where
time `plus` Second second =
check "plus{UnixTimeMicros,Second}" $
modify ut_mic_base (+ second * 1000000) time
instance DateTimeMath UnixTimeMicros Millis where
time `plus` Millis millis =
check "plus{UnixTimeMicros,Millis}" $
modify ut_mic_base (+ millis * 1000) time
instance DateTimeMath UnixTimeMicros Micros where
time `plus` Micros micros =
check "plus{UnixTimeMicros,Micros}" $
modify ut_mic_base (+ micros) time
instance DateTimeMath UnixTimeNanos Hour where
time `plus` Hour hour =
check "plus{UnixTimeNanos,Hour}" $
modify ut_nan_base (+ hour * 3600000000000) time
instance DateTimeMath UnixTimeNanos Minute where
time `plus` Minute minute =
check "plus{UnixTimeNanos,Minute}" $
modify ut_nan_base (+ minute * 60000000000) time
instance DateTimeMath UnixTimeNanos Second where
time `plus` Second second =
check "plus{UnixTimeNanos,Second}" $
modify ut_nan_base (+ second * 1000000000) time
instance DateTimeMath UnixTimeNanos Millis where
time `plus` Millis millis =
check "plus{UnixTimeNanos,Millis}" $
modify ut_nan_base (+ millis * 1000000) time
instance DateTimeMath UnixTimeNanos Micros where
time `plus` Micros micros =
check "plus{UnixTimeNanos,Micros}" $
modify ut_nan_base (+ micros * 1000) time
instance DateTimeMath UnixTimeNanos Nanos where
time `plus` Nanos nanos =
check "plus{UnixTimeNanos,Nanos}" $
modify ut_nan_base (+ nanos) time
instance DateTimeMath UnixTimePicos Hour where
time `plus` Hour hour =
check "plus{UnixTimePicos,Hour}" $
modify ut_pic_base (+ hour * 3600000000000000) time
instance DateTimeMath UnixTimePicos Minute where
time `plus` Minute minute =
check "plus{UnixTimePicos,Minute}" $
modify ut_pic_base (+ minute * 60000000000000) time
instance DateTimeMath UnixTimePicos Second where
time `plus` Second second =
check "plus{UnixTimePicos,Second}" $
modify ut_pic_base (+ second * 1000000000000) time
instance DateTimeMath UnixTimePicos Millis where
time `plus` Millis millis =
check "plus{UnixTimePicos,Millis}" $
modify ut_pic_base (+ millis * 1000000000) time
instance DateTimeMath UnixTimePicos Micros where
time `plus` Micros micros =
check "plus{UnixTimePicos,Micros}" $
modify ut_pic_base (+ micros * 1000000) time
instance DateTimeMath UnixTimePicos Nanos where
time `plus` Nanos nanos =
check "plus{UnixTimePicos,Nanos}" $
modify ut_pic_base (+ nanos * 1000) time
instance DateTimeMath UnixTimePicos Picos where
time `plus` Picos picos =
check "plus{UnixTimePicos,Picos}" $
modify ut_pic_base (+ picos) time
instance DateTimeMath UnixDateTime Day where
time `plus` Day day =
check "plus{UnixDateTime,Day}" $
modify udt_sec_base (+ fromIntegral day * 86400) time
instance DateTimeMath UnixDateTime Hour where
time `plus` Hour hour =
check "plus{UnixDateTime,Hour}" $
modify udt_sec_base (+ hour * 3600) time
instance DateTimeMath UnixDateTime Minute where
time `plus` Minute minute =
check "plus{UnixDateTime,Minute}" $
modify udt_sec_base (+ minute * 60) time
instance DateTimeMath UnixDateTime Second where
time `plus` Second second =
check "plus{UnixDateTime,Second}" $
modify udt_sec_base (+ second) time
instance DateTimeMath UnixDateTimeMillis Day where
time `plus` Day day =
check "plus{UnixDateTimeMillis,Day}" $
modify udt_mil_base (+ fromIntegral day * 86400000) time
instance DateTimeMath UnixDateTimeMillis Hour where
time `plus` Hour hour =
check "plus{UnixDateTimeMillis,Hour}" $
modify udt_mil_base (+ hour * 3600000) time
instance DateTimeMath UnixDateTimeMillis Minute where
time `plus` Minute minute =
check "plus{UnixDateTimeMillis,Minute}" $
modify udt_mil_base (+ minute * 60000) time
instance DateTimeMath UnixDateTimeMillis Second where
time `plus` Second second =
check "plus{UnixDateTimeMillis,Second}" $
modify udt_mil_base (+ second * 1000) time
instance DateTimeMath UnixDateTimeMillis Millis where
time `plus` Millis millis =
check "plus{UnixDateTimeMillis,Millis}" $
modify udt_mil_base (+ millis) time
instance DateTimeMath UnixDateTimeMicros Day where
time `plus` Day day =
check "plus{UnixDateTimeMicros,Day}" $
modify udt_mic_base (+ fromIntegral day * 86400000000) time
instance DateTimeMath UnixDateTimeMicros Hour where
time `plus` Hour hour =
check "plus{UnixDateTimeMicros,Hour}" $
modify udt_mic_base (+ hour * 3600000000) time
instance DateTimeMath UnixDateTimeMicros Minute where
time `plus` Minute minute =
check "plus{UnixDateTimeMicros,Minute}" $
modify udt_mic_base (+ minute * 60000000) time
instance DateTimeMath UnixDateTimeMicros Second where
time `plus` Second second =
check "plus{UnixDateTimeMicros,Second}" $
modify udt_mic_base (+ second * 1000000) time
instance DateTimeMath UnixDateTimeMicros Millis where
time `plus` Millis millis =
check "plus{UnixDateTimeMicros,Millis}" $
modify udt_mic_base (+ millis * 1000) time
instance DateTimeMath UnixDateTimeMicros Micros where
time `plus` Micros micros =
check "plus{UnixDateTimeMicros,Micros}" $
modify udt_mic_base (+ micros) time
instance DateTimeMath UnixDateTimeNanos Day where
time `plus` Day day =
check "plus{UnixDateTimeNanos,Day}" $
modify udt_nan_base (+ fromIntegral day * 86400000000) time
instance DateTimeMath UnixDateTimeNanos Hour where
time `plus` Hour hour =
check "plus{UnixDateTimeNanos,Hour}" $
modify udt_nan_base (+ hour * 3600000000) time
instance DateTimeMath UnixDateTimeNanos Minute where
time `plus` Minute minute =
check "plus{UnixDateTimeNanos,Minute}" $
modify udt_nan_base (+ minute * 60000000) time
instance DateTimeMath UnixDateTimeNanos Second where
time `plus` Second second =
check "plus{UnixDateTimeNanos,Second}" $
modify udt_nan_base (+ second * 1000000) time
instance DateTimeMath UnixDateTimeNanos Millis where
time `plus` Millis millis =
check "plus{UnixDateTimeNanos,Millis}" $
modify udt_nan_base (+ millis * 1000) time
instance DateTimeMath UnixDateTimeNanos Micros where
time `plus` Micros micros =
check "plus{UnixDateTimeNanos,Micros}" $
modify udt_nan_base (+ micros) time
instance DateTimeMath UnixDateTimeNanos Nanos where
UnixDateTimeNanos{..} `plus` Nanos nanos =
check "plus{UnixDateTimeNanos,Nanos}" .
uncurry UnixDateTimeNanos .
((+ _udt_nan_base) *** fromIntegral) .
flip divMod 1000 $
fromIntegral _udt_nan_nano + nanos
instance DateTimeMath UnixDateTimePicos Day where
time `plus` Day day =
check "plus{UnixDateTimePicos,Day}" $
modify udt_pic_base (+ fromIntegral day * 86400000000) time
instance DateTimeMath UnixDateTimePicos Hour where
time `plus` Hour hour =
check "plus{UnixDateTimePicos,Hour}" $
modify udt_pic_base (+ hour * 3600000000) time
instance DateTimeMath UnixDateTimePicos Minute where
time `plus` Minute minute =
check "plus{UnixDateTimePicos,Minute}" $
modify udt_pic_base (+ minute * 60000000) time
instance DateTimeMath UnixDateTimePicos Second where
time `plus` Second second =
check "plus{UnixDateTimePicos,Second}" $
modify udt_pic_base (+ second * 1000000) time
instance DateTimeMath UnixDateTimePicos Millis where
time `plus` Millis millis =
check "plus{UnixDateTimePicos,Millis}" $
modify udt_pic_base (+ millis * 1000) time
instance DateTimeMath UnixDateTimePicos Micros where
time `plus` Micros micros =
check "plus{UnixDateTimePicos,Micros}" $
modify udt_pic_base (+ micros) time
instance DateTimeMath UnixDateTimePicos Nanos where
UnixDateTimePicos{..} `plus` Nanos nanos =
check "plus{UnixDateTimePicos,Nanos}" .
uncurry UnixDateTimePicos .
((+ _udt_pic_base) *** fromIntegral) .
flip divMod 1000000 $
fromIntegral _udt_pic_pico + nanos * 1000
instance DateTimeMath UnixDateTimePicos Picos where
UnixDateTimePicos{..} `plus` Picos picos =
check "plus{UnixDateTimePicos,Picos}" .
uncurry UnixDateTimePicos .
((+ _udt_pic_base) *** fromIntegral) .
flip divMod 1000000 $
fromIntegral _udt_pic_pico + picos
instance Enum UnixDate where
succ = flip plus $ Day 1
pred = flip plus . Day $ - 1
toEnum = check "toEnum{UnixDate}" . UnixDate . fromIntegral
fromEnum = fromIntegral . _ud_day_base
instance Enum UnixTime where
succ = flip plus $ Second 1
pred = flip plus . Second $ - 1
toEnum = check "toEnum{UnixTime}" . UnixTime . fromIntegral
fromEnum = fromIntegral . _ut_sec_base
instance Enum UnixTimeMillis where
succ = flip plus $ Millis 1
pred = flip plus . Millis $ - 1
toEnum = check "toEnum{UnixTimeMillis}" . UnixTimeMillis . fromIntegral
fromEnum = fromIntegral . _ut_mil_base
instance Enum UnixTimeMicros where
succ = flip plus $ Micros 1
pred = flip plus . Micros $ - 1
toEnum = check "toEnum{UnixTimeMicros}" . UnixTimeMicros . fromIntegral
fromEnum = fromIntegral . _ut_mic_base
instance Enum UnixTimeNanos where
succ = flip plus $ Nanos 1
pred = flip plus . Nanos $ - 1
toEnum = check "toEnum{UnixTimeNanos}" . UnixTimeNanos . fromIntegral
fromEnum = fromIntegral . _ut_nan_base
instance Enum UnixTimePicos where
succ = flip plus $ Picos 1
pred = flip plus . Picos $ - 1
toEnum = check "toEnum{UnixTimePicos}" . UnixTimePicos . fromIntegral
fromEnum = fromIntegral . _ut_pic_base
instance Enum UnixDateTime where
succ = flip plus $ Second 1
pred = flip plus . Second $ - 1
toEnum = check "toEnum{UnixDateTime}" . UnixDateTime . fromIntegral
fromEnum = fromIntegral . _udt_sec_base
instance Enum UnixDateTimeMillis where
succ = flip plus $ Millis 1
pred = flip plus . Millis $ - 1
toEnum = check "toEnum{UnixDateTimeMillis}" . UnixDateTimeMillis . fromIntegral
fromEnum = fromIntegral . _udt_mil_base
instance Enum UnixDateTimeMicros where
succ = flip plus $ Micros 1
pred = flip plus . Micros $ - 1
toEnum = check "toEnum{UnixDateTimeMicros}" . UnixDateTimeMicros . fromIntegral
fromEnum = fromIntegral . _udt_mic_base
-- | Create a Unix date.
--
-- > >>> createUnixDate 2013 November 3
-- > 2013-11-03
--
createUnixDate :: Year -> Month -> Day -> UnixDate
createUnixDate year month day =
check "createUnixDate" $ UnixDate base
where Day base = epochToDate year month day
-- | Create a Unix time.
--
-- > >>> createUnixTime 4 52 7
-- > 04:52:07
--
createUnixTime :: Hour -> Minute -> Second -> UnixTime
createUnixTime hour minute second =
check "createUnixTime" $ UnixTime base
where base = fromIntegral $ midnightToTime hour minute second
-- | Create a Unix time with millisecond granularity.
--
-- > >>> createUnixTimeMillis 15 22 47 2
-- > 15:22:47.002
--
createUnixTimeMillis :: Hour -> Minute -> Second -> Millis -> UnixTimeMillis
createUnixTimeMillis hour minute second (Millis millis) =
check "createUnixTimeMillis" $ UnixTimeMillis base
where Second seconds = midnightToTime hour minute second
base = fromIntegral seconds * 1000 + fromIntegral millis
-- | Create a Unix time with microsecond granularity.
--
-- > >>> createUnixTimeMicros 10 6 33 575630
-- > 10:06:33.575630
--
createUnixTimeMicros :: Hour -> Minute -> Second -> Micros -> UnixTimeMicros
createUnixTimeMicros hour minute second (Micros micros) =
check "createUnixTimeMicros" $ UnixTimeMicros base
where Second seconds = midnightToTime hour minute second
base = seconds * 1000000 + fromIntegral micros
-- | Create a Unix time with nanosecond granularity.
--
-- > >>> createUnixTimeNanos 23 19 54 465837593
-- > 23:19:54.465837593
--
createUnixTimeNanos :: Hour -> Minute -> Second -> Nanos -> UnixTimeNanos
createUnixTimeNanos hour minute second (Nanos nanos) =
check "createUnixTimeNanos" $ UnixTimeNanos base
where Second seconds = midnightToTime hour minute second
base = seconds * 1000000000 + fromIntegral nanos
-- | Create a Unix time with picosecond granularity.
--
-- > >>> createUnixTimePicos 17 25 36 759230473534
-- > 17:25:36.759230473534
--
createUnixTimePicos :: Hour -> Minute -> Second -> Picos -> UnixTimePicos
createUnixTimePicos hour minute second (Picos picos) =
check "createUnixTimePicos" $ UnixTimePicos base
where Second seconds = midnightToTime hour minute second
base = seconds * 1000000000000 + fromIntegral picos
-- | Create a Unix date and time.
--
-- > >>> createUnixDateTime 2012 April 27 7 37 30
-- > 2012-04-27 07:37:30
--
createUnixDateTime :: Year -> Month -> Day -> Hour -> Minute -> Second -> UnixDateTime
createUnixDateTime year month day hour minute second =
check "createUnixDateTime" $ UnixDateTime base
where Second base = epochToTime year month day hour minute second
-- | Create a Unix date and time with millisecond granularity.
--
-- > >>> createUnixDateTimeMillis 2014 February 2 8 52 37 983
-- > 2014-02-02 08:52:37.983
--
createUnixDateTimeMillis :: Year -> Month -> Day -> Hour -> Minute -> Second -> Millis -> UnixDateTimeMillis
createUnixDateTimeMillis year month day hour minute second (Millis millis) =
check "createUnixDateTimeMillis" $ UnixDateTimeMillis base
where Second seconds = epochToTime year month day hour minute second
base = seconds * 1000 + millis
-- | Create a Unix date and time with microsecond granularity.
--
-- > >>> createUnixDateTimeMicros 2011 January 22 17 34 13 138563
-- > 2011-01-22 17:34:13.138563
--
createUnixDateTimeMicros :: Year -> Month -> Day -> Hour -> Minute -> Second -> Micros -> UnixDateTimeMicros
createUnixDateTimeMicros year month day hour minute second (Micros micros) =
check "createUnixDateTimeMicros" $ UnixDateTimeMicros base
where Second seconds = epochToTime year month day hour minute second
base = seconds * 1000000 + micros
-- | Create a Unix date and time with nanosecond granularity.
--
-- > >>> createUnixDateTimeNanos 2012 June 28 1 30 35 688279651
-- > 2012-06-28 01:30:35.688279651
--
createUnixDateTimeNanos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Nanos -> UnixDateTimeNanos
createUnixDateTimeNanos year month day hour minute second (Nanos nanos) =
check "createUnixDateTimeNanos" $ UnixDateTimeNanos base nano
where (micros, nano) = fmap fromIntegral $ divMod nanos 1000
Second seconds = epochToTime year month day hour minute second
base = seconds * 1000000 + micros
-- | Create a Unix date and time with picosecond granularity.
--
-- > >>> createUnixDateTimePicos 2014 August 2 10 57 54 809479393286
-- > 2014-08-02 10:57:54.809479393286
--
createUnixDateTimePicos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Picos -> UnixDateTimePicos
createUnixDateTimePicos year month day hour minute second (Picos picos) =
check "createUnixDateTimePicos" $ UnixDateTimePicos base pico
where (micros, pico) = fmap fromIntegral $ divMod picos 1000000
Second seconds = epochToTime year month day hour minute second
base = seconds * 1000000 + micros
-- | Decompose the number of days since
-- January 1st into month and day components.
decompYearToDate :: Day -> Bool -> (Month, Day)
decompYearToDate days leap =
if leap
then if days >= 182
then if days >= 274
then if days >= 335
then (December, days - 334)
else if days >= 305
then (November, days - 304)
else (October , days - 273)
else if days >= 244
then (September, days - 243)
else if days >= 213
then (August, days - 212)
else (July , days - 181)
else if days >= 091
then if days >= 152
then (June, days - 151)
else if days >= 121
then (May , days - 120)
else (April, days - 090)
else if days >= 060
then (March, days - 059)
else if days >= 031
then (February, days - 030)
else (January , days + 001)
else if days >= 181
then if days >= 273
then if days >= 334
then (December, days - 333)
else if days >= 304
then (November, days - 303)
else (October , days - 272)
else if days >= 243
then (September, days - 242)
else if days >= 212
then (August, days - 211)
else (July , days - 180)
else if days >= 090
then if days >= 151
then (June, days - 150)
else if days >= 120
then (May , days - 119)
else (April, days - 089)
else if days >= 059
then (March, days - 058)
else if days >= 031
then (February, days - 030)
else (January , days + 001)
-- | Decompose a Unix date into a human-readable format.
decompUnixDate :: UnixDate -> DateStruct
decompUnixDate (UnixDate base) =
go 1970 $ Day base
where go :: Year -> Day -> DateStruct
go !year !days =
if days >= size
then go (year + 1) (days - size)
else DateStruct year month mday wday
where wday = toEnum $ (fromIntegral base + 4) `mod` 7
leap = isLeapYear year
size = if leap then 366 else 365
(month, mday) = decompYearToDate days leap
-- | Decompose a Unix time into a human-readable format.
decompUnixTime :: UnixTime -> TimeStruct
decompUnixTime (UnixTime base) =
TimeStruct hour mn sec
where (hour, mod1) = fromIntegral *** fromIntegral $ divMod base 3600
(mn , sec ) = fmap realToFrac $ divMod mod1 0060
-- | Decompose a Unix time with millisecond granularity into a human-readable format.
decompUnixTimeMillis :: UnixTimeMillis -> TimeStruct
decompUnixTimeMillis (UnixTimeMillis base) =
TimeStruct hour mn $ sec + mill / 1000
where (hour, mod1) = fromIntegral *** fromIntegral $ divMod base 3600000
(mn , mod2) = divMod mod1 0060000
(sec , mill) = realToFrac *** realToFrac $ divMod mod2 0001000
-- | Decompose a Unix time with microsecond granularity into a human-readable format.
decompUnixTimeMicros :: UnixTimeMicros -> TimeStruct
decompUnixTimeMicros (UnixTimeMicros base) =
TimeStruct hour mn $ sec + micr / 1000000
where (hour, mod1) = Hour *** Minute $ divMod base 3600000000
(mn , mod2) = divMod mod1 0060000000
(sec , micr) = realToFrac *** realToFrac $ divMod mod2 0001000000
-- | Decompose a Unix time with nanosecond granularity into a human-readable format.
decompUnixTimeNanos :: UnixTimeNanos -> TimeStruct
decompUnixTimeNanos (UnixTimeNanos base) =
TimeStruct hour mn $ sec + nano / 1000000000
where (hour, mod1) = Hour *** Minute $ divMod base 3600000000000
(mn , mod2) = divMod mod1 0060000000000
(sec , nano) = realToFrac *** realToFrac $ divMod mod2 0001000000000
-- | Decompose a Unix time with picosecond granularity into a human-readable format.
decompUnixTimePicos :: UnixTimePicos -> TimeStruct
decompUnixTimePicos (UnixTimePicos base) =
TimeStruct hour mn $ sec + pico / 1000000000000
where (hour, mod1) = Hour *** Minute $ divMod base 3600000000000000
(mn , mod2) = divMod mod1 0060000000000000
(sec , pico) = realToFrac *** realToFrac $ divMod mod2 0001000000000000
-- | Decompose a Unix date and time into a human-readable format.
decompUnixDateTime :: UnixDateTime -> DateTimeStruct
decompUnixDateTime (UnixDateTime base) =
DateTimeStruct _d_year _d_mon _d_mday _d_wday hour mn sec
where DateStruct{..} = decompUnixDate $ UnixDate date
(date, mod1) = fromIntegral *** Hour $ divMod base 86400
(hour, mod2) = fmap fromIntegral $ divMod mod1 03600
(mn , sec ) = fmap realToFrac $ divMod mod2 00060
-- | Decompose a Unix date and time with millisecond granularity into a human-readable format.
decompUnixDateTimeMillis :: UnixDateTimeMillis -> DateTimeStruct
decompUnixDateTimeMillis (UnixDateTimeMillis base) =
DateTimeStruct _d_year _d_mon _d_mday _d_wday hour mn $ sec + mill / 1000
where DateStruct{..} = decompUnixDate $ UnixDate date
(date, mod1) = fromIntegral *** Hour $ divMod base 86400000
(hour, mod2) = fmap fromIntegral $ divMod mod1 03600000
(mn , mod3) = divMod mod2 00060000
(sec , mill) = realToFrac *** realToFrac $ divMod mod3 00001000
-- | Decompose a Unix date and time with microsecond granularity into a human-readable format.
decompUnixDateTimeMicros :: UnixDateTimeMicros -> DateTimeStruct
decompUnixDateTimeMicros (UnixDateTimeMicros base) =
DateTimeStruct _d_year _d_mon _d_mday _d_wday hour mn $ sec + micr / 1000000
where DateStruct{..} = decompUnixDate $ UnixDate date
(date, mod1) = fromIntegral *** Hour $ divMod base 86400000000
(hour, mod2) = fmap fromIntegral $ divMod mod1 03600000000
(mn , mod3) = divMod mod2 00060000000
(sec , micr) = realToFrac *** realToFrac $ divMod mod3 00001000000
-- | Decompose a Unix date and time with nanosecond granularity into a human-readable format.
decompUnixDateTimeNanos :: UnixDateTimeNanos -> DateTimeStruct
decompUnixDateTimeNanos (UnixDateTimeNanos base nano) =
modify dt_sec (+ fromIntegral nano / 1000000000) . decompUnixDateTimeMicros $ UnixDateTimeMicros base
-- | Decompose a Unix date and time with picosecond granularity into a human-readable format.
decompUnixDateTimePicos :: UnixDateTimePicos -> DateTimeStruct
decompUnixDateTimePicos (UnixDateTimePicos base pico) =
modify dt_sec (+ fromIntegral pico / 1000000000000) . decompUnixDateTimeMicros $ UnixDateTimeMicros base
instance Convertible UnixDateTime UnixDate where
safeConvert = Right . UnixDate . fromIntegral . flip div 00000086400 . _udt_sec_base
instance Convertible UnixDateTime UnixTime where
safeConvert = Right . UnixTime . fromIntegral . flip mod 00000086400 . _udt_sec_base
instance Convertible UnixDateTimeMillis UnixDate where
safeConvert = Right . UnixDate . fromIntegral . flip div 00086400000 . _udt_mil_base
instance Convertible UnixDateTimeMillis UnixTime where
safeConvert = Right . UnixTime . fromIntegral . flip mod 00086400000 . _udt_mil_base
instance Convertible UnixDateTimeMicros UnixDate where
safeConvert = Right . UnixDate . fromIntegral . flip div 86400000000 . _udt_mic_base
instance Convertible UnixDateTimeMicros UnixTime where
safeConvert = Right . UnixTime . fromIntegral . flip mod 86400000000 . _udt_mic_base
instance Convertible UnixDateTimeNanos UnixDate where
safeConvert = Right . UnixDate . fromIntegral . flip div 86400000000 . _udt_nan_base
instance Convertible UnixDateTimeNanos UnixTime where
safeConvert = Right . UnixTime . fromIntegral . flip mod 86400000000 . _udt_nan_base
instance Convertible UnixDateTimePicos UnixDate where
safeConvert = Right . UnixDate . fromIntegral . flip div 86400000000 . _udt_pic_base
instance Convertible UnixDateTimePicos UnixTime where
safeConvert = Right . UnixTime . fromIntegral . flip mod 86400000000 . _udt_pic_base
instance Date UnixDate where
toDateStruct = decompUnixDate
fromDateStruct DateStruct{..} =
createUnixDate _d_year _d_mon _d_mday
instance Date UnixDateTime where
toDateStruct = decompUnixDate . convert
fromDateStruct DateStruct{..} =
createUnixDateTime _d_year _d_mon _d_mday 0 0 0
instance Date UnixDateTimeMillis where
toDateStruct = decompUnixDate . convert
fromDateStruct DateStruct{..} =
createUnixDateTimeMillis _d_year _d_mon _d_mday 0 0 0 0
instance Date UnixDateTimeMicros where
toDateStruct = decompUnixDate . convert
fromDateStruct DateStruct{..} =
createUnixDateTimeMicros _d_year _d_mon _d_mday 0 0 0 0
instance Date UnixDateTimeNanos where
toDateStruct = decompUnixDate . convert
fromDateStruct DateStruct{..} =
createUnixDateTimeNanos _d_year _d_mon _d_mday 0 0 0 0
instance Date UnixDateTimePicos where
toDateStruct = decompUnixDate . convert
fromDateStruct DateStruct{..} =
createUnixDateTimePicos _d_year _d_mon _d_mday 0 0 0 0
instance Time UnixTime where
toTimeStruct = decompUnixTime
fromTimeStruct TimeStruct{..} =
createUnixTime _t_hour _t_min sec
where sec = round _t_sec
instance Time UnixTimeMillis where
toTimeStruct = decompUnixTimeMillis
fromTimeStruct TimeStruct{..} =
createUnixTimeMillis _t_hour _t_min sec mil
where (sec, mil) = properFracMillis _t_sec
instance Time UnixTimeMicros where
toTimeStruct = decompUnixTimeMicros
fromTimeStruct TimeStruct{..} =
createUnixTimeMicros _t_hour _t_min sec mic
where (sec, mic) = properFracMicros _t_sec
instance Time UnixTimeNanos where
toTimeStruct = decompUnixTimeNanos
fromTimeStruct TimeStruct{..} =
createUnixTimeNanos _t_hour _t_min sec nan
where (sec, nan) = properFracNanos _t_sec
instance Time UnixTimePicos where
toTimeStruct = decompUnixTimePicos
fromTimeStruct TimeStruct{..} =
createUnixTimePicos _t_hour _t_min sec pic
where (sec, pic) = properFracPicos _t_sec
instance Time UnixDateTime where
toTimeStruct = decompUnixTime . convert
fromTimeStruct TimeStruct{..} =
createUnixDateTime 1970 January 1 _t_hour _t_min sec
where sec = round _t_sec
instance Time UnixDateTimeMillis where
toTimeStruct = decompUnixTime . convert
fromTimeStruct TimeStruct{..} =
createUnixDateTimeMillis 1970 January 1 _t_hour _t_min sec mil
where (sec, mil) = properFracMillis _t_sec
instance Time UnixDateTimeMicros where
toTimeStruct = decompUnixTime . convert
fromTimeStruct TimeStruct{..} =
createUnixDateTimeMicros 1970 January 1 _t_hour _t_min sec mic
where (sec, mic) = properFracMicros _t_sec
instance Time UnixDateTimeNanos where
toTimeStruct = decompUnixTime . convert
fromTimeStruct TimeStruct{..} =
createUnixDateTimeNanos 1970 January 1 _t_hour _t_min sec nan
where (sec, nan) = properFracNanos _t_sec
instance Time UnixDateTimePicos where
toTimeStruct = decompUnixTime . convert
fromTimeStruct TimeStruct{..} =
createUnixDateTimePicos 1970 January 1 _t_hour _t_min sec pic
where (sec, pic) = properFracPicos _t_sec
instance DateTime UnixDateTime where
toDateTimeStruct = decompUnixDateTime
fromDateTimeStruct DateTimeStruct{..} =
createUnixDateTime _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec
where sec = round _dt_sec :: Second
instance DateTime UnixDateTimeMillis where
toDateTimeStruct = decompUnixDateTimeMillis
fromDateTimeStruct DateTimeStruct{..} =
createUnixDateTimeMillis _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec mil
where (sec, mil) = properFracMillis _dt_sec
instance DateTime UnixDateTimeMicros where
toDateTimeStruct = decompUnixDateTimeMicros
fromDateTimeStruct DateTimeStruct{..} =
createUnixDateTimeMicros _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec mic
where (sec, mic) = properFracMicros _dt_sec
instance DateTime UnixDateTimeNanos where
toDateTimeStruct = decompUnixDateTimeNanos
fromDateTimeStruct DateTimeStruct{..} =
createUnixDateTimeNanos _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec nan
where (sec, nan) = properFracNanos _dt_sec
instance DateTime UnixDateTimePicos where
toDateTimeStruct = decompUnixDateTimePicos
fromDateTimeStruct DateTimeStruct{..} =
createUnixDateTimePicos _dt_year _dt_mon _dt_mday _dt_hour _dt_min sec pic
where (sec, pic) = properFracPicos _dt_sec
instance Show UnixDate where
show date = printf "%04d-%02d-%02d" _d_year mon _d_mday
where DateStruct{..} = toDateStruct date
mon = fromEnum _d_mon + 1
instance Show UnixTime where
show time = printf "%02d:%02d:%02d" _t_hour _t_min sec
where TimeStruct{..} = toTimeStruct time
sec = round _t_sec :: Second
instance Show UnixTimeMillis where
show time = printf "%02d:%02d:%02d.%03d" _t_hour _t_min sec mil
where TimeStruct{..} = toTimeStruct time
(sec, mil) = properFracMillis _t_sec
instance Show UnixTimeMicros where
show time = printf "%02d:%02d:%02d.%06d" _t_hour _t_min sec mic
where TimeStruct{..} = toTimeStruct time
(sec, mic) = properFracMicros _t_sec
instance Show UnixTimeNanos where
show time = printf "%02d:%02d:%02d.%09d" _t_hour _t_min sec nan
where TimeStruct{..} = toTimeStruct time
(sec, nan) = properFracNanos _t_sec
instance Show UnixTimePicos where
show time = printf "%02d:%02d:%02d.%012d" _t_hour _t_min sec pic
where TimeStruct{..} = toTimeStruct time
(sec, pic) = properFracPicos _t_sec
instance Show UnixDateTime where
show time = printf "%04d-%02d-%02d %02d:%02d:%02d" _dt_year mon _dt_mday _dt_hour _dt_min sec
where DateTimeStruct{..} = toDateTimeStruct time
mon = fromEnum _dt_mon + 1
sec = round _dt_sec :: Second
instance Show UnixDateTimeMillis where
show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%03d" _dt_year mon _dt_mday _dt_hour _dt_min sec mil
where DateTimeStruct{..} = toDateTimeStruct time
mon = fromEnum _dt_mon + 1
(sec, mil) = properFracMillis _dt_sec
instance Show UnixDateTimeMicros where
show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%06d" _dt_year mon _dt_mday _dt_hour _dt_min sec mic
where DateTimeStruct{..} = toDateTimeStruct time
mon = fromEnum _dt_mon + 1
(sec, mic) = properFracMicros _dt_sec
instance Show UnixDateTimeNanos where
show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%09d" _dt_year mon _dt_mday _dt_hour _dt_min sec nan
where DateTimeStruct{..} = toDateTimeStruct time
mon = fromEnum _dt_mon + 1
(sec, nan) = properFracNanos _dt_sec
instance Show UnixDateTimePicos where
show time = printf "%04d-%02d-%02d %02d:%02d:%02d.%012d" _dt_year mon _dt_mday _dt_hour _dt_min sec pic
where DateTimeStruct{..} = toDateTimeStruct time
mon = fromEnum _dt_mon + 1
(sec, pic) = properFracPicos _dt_sec
-- | Get the current Unix date from the system clock.
--
-- > >>> getCurrentUnixDate
-- > 2013-11-03
--
getCurrentUnixDate :: IO UnixDate
getCurrentUnixDate = getCurrentUnixDateTime >>= return . convert
-- | Get the current Unix time from the system clock.
--
-- > >>> getCurrentUnixTime
-- > 05:45:06
--
getCurrentUnixTime :: IO UnixTime
getCurrentUnixTime = getCurrentUnixDateTime >>= return . convert
-- | Get the current Unix time with millisecond granularity from the system clock.
--
-- > >>> getCurrentUnixTimeMillis
-- > 06:30:08.840
--
getCurrentUnixTimeMillis :: IO UnixTimeMillis
getCurrentUnixTimeMillis =
with (C'timeval 0 0) $ \ ptr ->
c'gettimeofday ptr nullPtr >>= getResult ptr
where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) ->
return $! UnixTimeMillis . fromIntegral $ (base `mod` 86400) * 1000 + micr `div` 1000
getResult _ _ = error "getCurrentUnixTimeMillis: unknown"
-- | Get the current Unix time with microsecond granularity from the system clock.
--
-- > >>> getCurrentUnixTimeMicros
-- > 06:40:39.102910
--
getCurrentUnixTimeMicros :: IO UnixTimeMicros
getCurrentUnixTimeMicros =
with (C'timeval 0 0) $ \ ptr ->
c'gettimeofday ptr nullPtr >>= getResult ptr
where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) ->
return $! UnixTimeMicros $ (base `mod` 86400) * 1000000 + micr
getResult _ _ = error "getCurrentUnixTimeMicros: unknown"
-- | Get the current Unix time with nanosecond granularity from the system clock.
--
-- > >>> getCurrentUnixTimeNanos
-- > 06:40:45.903610000
--
-- Note that this functions calls @gettimeofday@ behind the scenes. Therefore,
-- the resultant timestamp will have nanosecond granularity, but only microsecond
-- resolution.
getCurrentUnixTimeNanos :: IO UnixTimeNanos
getCurrentUnixTimeNanos =
with (C'timeval 0 0) $ \ ptr ->
c'gettimeofday ptr nullPtr >>= getResult ptr
where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) ->
return $! UnixTimeNanos $ (base `mod` 86400) * 1000000000 + micr * 1000
getResult _ _ = error "getCurrentUnixTimeNanos: unknown"
-- | Get the current Unix time with picosecond granularity from the system clock.
--
-- > >>> getCurrentUnixTimePicos
-- > 06:47:15.379247000000
--
-- Note that this functions calls @gettimeofday@ behind the scenes. Therefore,
-- the resultant timestamp will have picosecond granularity, but only microsecond
-- resolution.
getCurrentUnixTimePicos :: IO UnixTimePicos
getCurrentUnixTimePicos =
with (C'timeval 0 0) $ \ ptr ->
c'gettimeofday ptr nullPtr >>= getResult ptr
where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) ->
return $! UnixTimePicos $ (base `mod` 86400) * 1000000000000 + micr * 1000000
getResult _ _ = error "getCurrentUnixTimePicos: unknown"
-- | Get the current Unix date and time from the system clock.
--
-- > >>> getCurrentUnixDateTime
-- > 2013-11-03 23:09:38
--
getCurrentUnixDateTime :: IO UnixDateTime
getCurrentUnixDateTime =
with (C'timeval 0 0) $ \ ptr ->
c'gettimeofday ptr nullPtr >>= getResult ptr
where getResult ptr 0 = peek $ castPtr ptr
getResult _ _ = error "getCurrentUnixDateTime: unknown"
-- | Get the current Unix date and time with millisecond granularity from the system clock.
--
-- > >>> getCurrentUnixDateTimeMillis
-- > 2013-11-03 23:09:51.986
--
getCurrentUnixDateTimeMillis :: IO UnixDateTimeMillis
getCurrentUnixDateTimeMillis =
with (C'timeval 0 0) $ \ ptr ->
c'gettimeofday ptr nullPtr >>= getResult ptr
where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) ->
return $! UnixDateTimeMillis $ base * 1000 + micr `div` 1000
getResult _ _ = error "getCurrentUnixDateTimeMillis: unknown"
-- | Get the current Unix date and time with microsecond granularity from the system clock.
--
-- > >>> getCurrentUnixDateTimeMicros
-- > 2013-11-03 23:10:06.498559
--
getCurrentUnixDateTimeMicros :: IO UnixDateTimeMicros
getCurrentUnixDateTimeMicros =
with (C'timeval 0 0) $ \ ptr ->
c'gettimeofday ptr nullPtr >>= getResult ptr
where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) ->
return $! UnixDateTimeMicros $ base * 1000000 + micr
getResult _ _ = error "getCurrentUnixDateTimeMicros: unknown"
-- | Get the current Unix date and time with nanosecond granularity from the system clock.
--
-- > >>> getCurrentUnixDateTimeNanos
-- > 2013-11-03 23:10:23.697893000
--
-- Note that this functions calls @gettimeofday@ behind the scenes. Therefore, the
-- resultant timestamp will have nanosecond granularity, but only microsecond resolution.
getCurrentUnixDateTimeNanos :: IO UnixDateTimeNanos
getCurrentUnixDateTimeNanos =
with (C'timeval 0 0) $ \ ptr ->
c'gettimeofday ptr nullPtr >>= getResult ptr
where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) ->
return $! UnixDateTimeNanos (base * 1000000 + micr) 0
getResult _ _ = error "getCurrentUnixDateTimeNanos: unknown"
-- | Get the current Unix date and time with picosecond granularity from the system clock.
--
-- > >>> getCurrentUnixDateTimePicos
-- > 2013-11-03 23:10:44.633032000000
--
-- Note that this functions calls @gettimeofday@ behind the scenes. Therefore, the
-- resultant timestamp will have nanosecond granularity, but only microsecond resolution.
getCurrentUnixDateTimePicos :: IO UnixDateTimePicos
getCurrentUnixDateTimePicos =
with (C'timeval 0 0) $ \ ptr ->
c'gettimeofday ptr nullPtr >>= getResult ptr
where getResult ptr 0 = peek ptr >>= \ (C'timeval (CLong base) (CLong micr)) ->
return $! UnixDateTimePicos (base * 1000000 + micr) 0
getResult _ _ = error "getCurrentUnixDateTimePicos: unknown"
-- | Convert a Unix date and time with nanosecond granularity into an integer.
fromNanos :: UnixDateTimeNanos -> Integer
fromNanos (UnixDateTimeNanos base nano) = toInteger base * 0001000 + toInteger nano
-- | Convert a Unix date and time with picosecond granularity into an integer.
fromPicos :: UnixDateTimePicos -> Integer
fromPicos (UnixDateTimePicos base pico) = toInteger base * 1000000 + toInteger pico
-- | Convert an integer into a Unix date and time with nanosecond granularity.
toNanos :: Integer -> UnixDateTimeNanos
toNanos = uncurry UnixDateTimeNanos . (fromInteger *** fromInteger) . flip divMod 0001000
-- | Convert an integer into a Unix date and time with picosecond granularity.
toPicos :: Integer -> UnixDateTimePicos
toPicos = uncurry UnixDateTimePicos . (fromInteger *** fromInteger) . flip divMod 1000000
instance Duration UnixDate Day where
duration (UnixDate old) (UnixDate new) = Day (new - old)
instance Duration UnixTime Hour where
duration (UnixTime old) (UnixTime new) = fromIntegral (new - old) `div` 3600
instance Duration UnixTime Minute where
duration (UnixTime old) (UnixTime new) = fromIntegral (new - old) `div` 60
instance Duration UnixTime Second where
duration (UnixTime old) (UnixTime new) = fromIntegral (new - old)
instance Duration UnixTimeMillis Hour where
duration (UnixTimeMillis old) (UnixTimeMillis new) = fromIntegral (new - old) `div` 3600000
instance Duration UnixTimeMillis Minute where
duration (UnixTimeMillis old) (UnixTimeMillis new) = fromIntegral (new - old) `div` 60000
instance Duration UnixTimeMillis Second where
duration (UnixTimeMillis old) (UnixTimeMillis new) = fromIntegral (new - old) `div` 1000
instance Duration UnixTimeMillis Millis where
duration (UnixTimeMillis old) (UnixTimeMillis new) = fromIntegral (new - old)
instance Duration UnixTimeMicros Hour where
duration (UnixTimeMicros old) (UnixTimeMicros new) = Hour (new - old) `div` 3600000000
instance Duration UnixTimeMicros Minute where
duration (UnixTimeMicros old) (UnixTimeMicros new) = Minute (new - old) `div` 60000000
instance Duration UnixTimeMicros Second where
duration (UnixTimeMicros old) (UnixTimeMicros new) = Second (new - old) `div` 1000000
instance Duration UnixTimeMicros Millis where
duration (UnixTimeMicros old) (UnixTimeMicros new) = Millis (new - old) `div` 1000
instance Duration UnixTimeMicros Micros where
duration (UnixTimeMicros old) (UnixTimeMicros new) = Micros (new - old)
instance Duration UnixTimeNanos Hour where
duration (UnixTimeNanos old) (UnixTimeNanos new) = Hour (new - old) `div` 3600000000000
instance Duration UnixTimeNanos Minute where
duration (UnixTimeNanos old) (UnixTimeNanos new) = Minute (new - old) `div` 60000000000
instance Duration UnixTimeNanos Second where
duration (UnixTimeNanos old) (UnixTimeNanos new) = Second (new - old) `div` 1000000000
instance Duration UnixTimeNanos Millis where
duration (UnixTimeNanos old) (UnixTimeNanos new) = Millis (new - old) `div` 1000000
instance Duration UnixTimeNanos Micros where
duration (UnixTimeNanos old) (UnixTimeNanos new) = Micros (new - old) `div` 1000
instance Duration UnixTimeNanos Nanos where
duration (UnixTimeNanos old) (UnixTimeNanos new) = Nanos (new - old)
instance Duration UnixTimePicos Hour where
duration (UnixTimePicos old) (UnixTimePicos new) = Hour (new - old) `div` 3600000000000000
instance Duration UnixTimePicos Minute where
duration (UnixTimePicos old) (UnixTimePicos new) = Minute (new - old) `div` 60000000000000
instance Duration UnixTimePicos Second where
duration (UnixTimePicos old) (UnixTimePicos new) = Second (new - old) `div` 1000000000000
instance Duration UnixTimePicos Millis where
duration (UnixTimePicos old) (UnixTimePicos new) = Millis (new - old) `div` 1000000000
instance Duration UnixTimePicos Micros where
duration (UnixTimePicos old) (UnixTimePicos new) = Micros (new - old) `div` 1000000
instance Duration UnixTimePicos Nanos where
duration (UnixTimePicos old) (UnixTimePicos new) = Nanos (new - old) `div` 1000
instance Duration UnixTimePicos Picos where
duration (UnixTimePicos old) (UnixTimePicos new) = Picos (new - old)
instance Duration UnixDateTime Day where
duration (UnixDateTime old) (UnixDateTime new) = fromIntegral $ (new - old) `div` 86400
instance Duration UnixDateTime Hour where
duration (UnixDateTime old) (UnixDateTime new) = Hour (new - old) `div` 3600
instance Duration UnixDateTime Minute where
duration (UnixDateTime old) (UnixDateTime new) = Minute (new - old) `div` 60
instance Duration UnixDateTime Second where
duration (UnixDateTime old) (UnixDateTime new) = Second (new - old)
instance Duration UnixDateTimeMillis Day where
duration (UnixDateTimeMillis old) (UnixDateTimeMillis new) = fromIntegral $ (new - old) `div` 86400000
instance Duration UnixDateTimeMillis Hour where
duration (UnixDateTimeMillis old) (UnixDateTimeMillis new) = Hour (new - old) `div` 3600000
instance Duration UnixDateTimeMillis Minute where
duration (UnixDateTimeMillis old) (UnixDateTimeMillis new) = Minute (new - old) `div` 60000
instance Duration UnixDateTimeMillis Second where
duration (UnixDateTimeMillis old) (UnixDateTimeMillis new) = Second (new - old) `div` 1000
instance Duration UnixDateTimeMillis Millis where
duration (UnixDateTimeMillis old) (UnixDateTimeMillis new) = Millis (new - old)
instance Duration UnixDateTimeMicros Day where
duration (UnixDateTimeMicros old) (UnixDateTimeMicros new) = fromIntegral $ (new - old) `div` 86400000000
instance Duration UnixDateTimeMicros Hour where
duration (UnixDateTimeMicros old) (UnixDateTimeMicros new) = Hour (new - old) `div` 3600000000
instance Duration UnixDateTimeMicros Minute where
duration (UnixDateTimeMicros old) (UnixDateTimeMicros new) = Minute (new - old) `div` 60000000
instance Duration UnixDateTimeMicros Second where
duration (UnixDateTimeMicros old) (UnixDateTimeMicros new) = Second (new - old) `div` 1000000
instance Duration UnixDateTimeMicros Millis where
duration (UnixDateTimeMicros old) (UnixDateTimeMicros new) = Millis (new - old) `div` 1000
instance Duration UnixDateTimeMicros Micros where
duration (UnixDateTimeMicros old) (UnixDateTimeMicros new) = Micros (new - old)
instance Duration UnixDateTimeNanos Day where
duration (UnixDateTimeNanos old _) (UnixDateTimeNanos new _) = fromIntegral $ (new - old) `div` 86400000000
instance Duration UnixDateTimeNanos Hour where
duration (UnixDateTimeNanos old _) (UnixDateTimeNanos new _) = Hour (new - old) `div` 3600000000
instance Duration UnixDateTimeNanos Minute where
duration (UnixDateTimeNanos old _) (UnixDateTimeNanos new _) = Minute (new - old) `div` 60000000
instance Duration UnixDateTimeNanos Second where
duration (UnixDateTimeNanos old _) (UnixDateTimeNanos new _) = Second (new - old) `div` 1000000
instance Duration UnixDateTimeNanos Millis where
duration (UnixDateTimeNanos old _) (UnixDateTimeNanos new _) = Millis (new - old) `div` 1000
instance Duration UnixDateTimeNanos Micros where
duration (UnixDateTimeNanos old _) (UnixDateTimeNanos new _) = Micros (new - old)
instance Duration UnixDateTimeNanos Nanos where
duration old new =
if res < toInteger (maxBound::Int64) then fromInteger res
else error "duration{UnixDateTimeNanos,Nanos}: integer overflow"
where res = (fromNanos new - fromNanos old)
instance Duration UnixDateTimePicos Day where
duration (UnixDateTimePicos old _) (UnixDateTimePicos new _) = fromIntegral $ (new - old) `div` 86400000000
instance Duration UnixDateTimePicos Hour where
duration (UnixDateTimePicos old _) (UnixDateTimePicos new _) = Hour (new - old) `div` 3600000000
instance Duration UnixDateTimePicos Minute where
duration (UnixDateTimePicos old _) (UnixDateTimePicos new _) = Minute (new - old) `div` 60000000
instance Duration UnixDateTimePicos Second where
duration (UnixDateTimePicos old _) (UnixDateTimePicos new _) = Second (new - old) `div` 1000000
instance Duration UnixDateTimePicos Millis where
duration (UnixDateTimePicos old _) (UnixDateTimePicos new _) = Millis (new - old) `div` 1000
instance Duration UnixDateTimePicos Micros where
duration (UnixDateTimePicos old _) (UnixDateTimePicos new _) = Micros (new - old)
instance Duration UnixDateTimePicos Nanos where
duration old new =
if res < toInteger (maxBound::Int64) then fromInteger res
else error "duration{UnixDateTimePicos,Nanos}: integer overflow"
where res = (fromPicos new - fromPicos old) `div` 1000
instance Duration UnixDateTimePicos Picos where
duration old new =
if res < toInteger (maxBound::Int64) then fromInteger res
else error "duration{UnixDateTimePicos,Picos}: integer overflow"
where res = (fromPicos new - fromPicos old)
instance Random UnixDate where
random = first toEnum . randomR (0,2932896)
randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b)
instance Random UnixTime where
random = first toEnum . randomR (0,86399)
randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b)
instance Random UnixTimeMillis where
random = first toEnum . randomR (0,86399999)
randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b)
instance Random UnixTimeMicros where
random = first toEnum . randomR (0,86399999999)
randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b)
instance Random UnixTimeNanos where
random = first toEnum . randomR (0,86399999999999)
randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b)
instance Random UnixTimePicos where
random = first toEnum . randomR (0,86399999999999999)
randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b)
instance Random UnixDateTime where
random = first toEnum . randomR (0,253402300799)
randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b)
instance Random UnixDateTimeMillis where
random = first toEnum . randomR (0,253402300799999)
randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b)
instance Random UnixDateTimeMicros where
random = first toEnum . randomR (0,253402300799999999)
randomR (a,b) = first toEnum . randomR (fromEnum a, fromEnum b)
instance Random UnixDateTimeNanos where
random = first toNanos . randomR (0,253402300799999999999)
randomR (a,b) = first toNanos . randomR (fromNanos a, fromNanos b)
instance Random UnixDateTimePicos where
random = first toPicos . randomR (0,253402300799999999999999)
randomR (a,b) = first toPicos . randomR (fromPicos a, fromPicos b)
-- | Show a Unix date as a pretty string.
--
-- > >>> prettyUnixDate $ createUnixDate 2014 August 16
-- > "Saturday, August 16th, 2014"
--
prettyUnixDate :: (Unix d, Date d) => d -> String
prettyUnixDate date =
printf "%s, %s %s, %04d" wday mon mday _d_year
where DateStruct{..} = toDateStruct date
wday = show _d_wday
mon = show _d_mon
mday = show _d_mday ++ showSuffix _d_mday
-- | Show a Unix time as a pretty string.
--
-- > >>> getCurrentUnixTime >>= putStrLn . prettyUnixTime
-- > 9:12 AM
--
prettyUnixTime :: (Unix t, Time t) => t -> String
prettyUnixTime time =
printf "%d:%02d %s" hour _t_min ampm
where TimeStruct{..} = toTimeStruct time
ampm = showPeriod _t_hour
hour | _t_hour == 00 = 12
| _t_hour <= 12 = _t_hour
| otherwise = _t_hour - 12
-- | Show a Unix date and time as a pretty string.
--
-- > >>> getCurrentUnixDateTime >>= return . prettyUnixDateTime
-- > "6:44 AM, Tuesday, December 31st, 2013"
--
prettyUnixDateTime :: (Unix dt, DateTime dt) => dt -> String
prettyUnixDateTime time =
printf str hour _dt_min ampm wday mon mday _dt_year
where DateTimeStruct{..} = toDateTimeStruct time
str = "%d:%02d %s, %s, %s %s, %04d"
wday = show _dt_wday
mon = show _dt_mon
mday = show _dt_mday ++ showSuffix _dt_mday
ampm = showPeriod _dt_hour
hour | _dt_hour == 00 = 12
| _dt_hour <= 12 = _dt_hour
| otherwise = _dt_hour - 12
-- | Perform a bounds check on the given Unix timestamp.
check :: forall a . Bounded a => Ord a => Unix a => String -> a -> a
check f x =
if minBound <= x && x <= maxBound then x
else error $ f ++ ": base (" ++ base ++ ") out of bounds (" ++ bounds ++ ")"
where base = show (unixBase x)
bounds = show (unixBase (minBound::a)) ++ "," ++ show (unixBase (maxBound::a))