diff --git a/src/Data/Time/Exts/Unix b/src/Data/Time/Exts/Unix deleted file mode 100644 --- a/src/Data/Time/Exts/Unix +++ /dev/null @@ -1,875 +0,0 @@ ---------------------------------------------------------------- --- 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 = (***) diff --git a/src/Data/Time/Exts/Unix.hs b/src/Data/Time/Exts/Unix.hs --- a/src/Data/Time/Exts/Unix.hs +++ b/src/Data/Time/Exts/Unix.hs @@ -797,7 +797,7 @@ instance Duration UnixDateTimePicos Nanos where duration old new = - if res < toInteger (maxBound::Int64) then Nanos $ fromInteger res + if res < toInteger (maxBound::Int64) then Nanos $ fromInteger res `div` 1000 else error "duration{UnixDateTimePicos,Nanos}: integer overflow" where res = fromPico new - fromPico old diff --git a/time-exts.cabal b/time-exts.cabal --- a/time-exts.cabal +++ b/time-exts.cabal @@ -1,5 +1,5 @@ Name: time-exts -Version: 1.1.1 +Version: 1.1.2 License: BSD3 License-File: LICENSE Copyright: Copyright (c) 2014, Enzo Haussecker. All rights reserved.