{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.UnixTime.Conv (
formatUnixTime,
formatUnixTimeGMT,
parseUnixTime,
parseUnixTimeGMT,
webDateFormat,
mailDateFormat,
fromEpochTime,
toEpochTime,
fromClockTime,
toClockTime,
) where
import Control.Applicative
import Data.ByteString.Char8
import Data.ByteString.Unsafe
import Data.UnixTime.Types
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Alloc
import System.IO.Unsafe (unsafePerformIO)
import System.Posix.Types (EpochTime)
import System.Time (ClockTime (..))
foreign import ccall unsafe "c_parse_unix_time"
c_parse_unix_time :: CString -> CString -> IO CTime
foreign import ccall unsafe "c_parse_unix_time_gmt"
c_parse_unix_time_gmt :: CString -> CString -> IO CTime
foreign import ccall unsafe "c_format_unix_time"
c_format_unix_time :: CString -> CTime -> CString -> CInt -> IO CSize
foreign import ccall unsafe "c_format_unix_time_gmt"
c_format_unix_time_gmt :: CString -> CTime -> CString -> CInt -> IO CSize
parseUnixTime :: Format -> ByteString -> UnixTime
parseUnixTime :: Format -> Format -> UnixTime
parseUnixTime Format
fmt Format
str = IO UnixTime -> UnixTime
forall a. IO a -> a
unsafePerformIO (IO UnixTime -> UnixTime) -> IO UnixTime -> UnixTime
forall a b. (a -> b) -> a -> b
$
Format -> (CString -> IO UnixTime) -> IO UnixTime
forall a. Format -> (CString -> IO a) -> IO a
useAsCString Format
fmt ((CString -> IO UnixTime) -> IO UnixTime)
-> (CString -> IO UnixTime) -> IO UnixTime
forall a b. (a -> b) -> a -> b
$ \CString
cfmt ->
Format -> (CString -> IO UnixTime) -> IO UnixTime
forall a. Format -> (CString -> IO a) -> IO a
useAsCString Format
str ((CString -> IO UnixTime) -> IO UnixTime)
-> (CString -> IO UnixTime) -> IO UnixTime
forall a b. (a -> b) -> a -> b
$ \CString
cstr -> do
CTime
sec <- CString -> CString -> IO CTime
c_parse_unix_time CString
cfmt CString
cstr
UnixTime -> IO UnixTime
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnixTime -> IO UnixTime) -> UnixTime -> IO UnixTime
forall a b. (a -> b) -> a -> b
$ CTime -> Int32 -> UnixTime
UnixTime CTime
sec Int32
0
parseUnixTimeGMT :: Format -> ByteString -> UnixTime
parseUnixTimeGMT :: Format -> Format -> UnixTime
parseUnixTimeGMT Format
fmt Format
str = IO UnixTime -> UnixTime
forall a. IO a -> a
unsafePerformIO (IO UnixTime -> UnixTime) -> IO UnixTime -> UnixTime
forall a b. (a -> b) -> a -> b
$
Format -> (CString -> IO UnixTime) -> IO UnixTime
forall a. Format -> (CString -> IO a) -> IO a
useAsCString Format
fmt ((CString -> IO UnixTime) -> IO UnixTime)
-> (CString -> IO UnixTime) -> IO UnixTime
forall a b. (a -> b) -> a -> b
$ \CString
cfmt ->
Format -> (CString -> IO UnixTime) -> IO UnixTime
forall a. Format -> (CString -> IO a) -> IO a
useAsCString Format
str ((CString -> IO UnixTime) -> IO UnixTime)
-> (CString -> IO UnixTime) -> IO UnixTime
forall a b. (a -> b) -> a -> b
$ \CString
cstr -> do
CTime
sec <- CString -> CString -> IO CTime
c_parse_unix_time_gmt CString
cfmt CString
cstr
UnixTime -> IO UnixTime
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (UnixTime -> IO UnixTime) -> UnixTime -> IO UnixTime
forall a b. (a -> b) -> a -> b
$ CTime -> Int32 -> UnixTime
UnixTime CTime
sec Int32
0
formatUnixTime :: Format -> UnixTime -> IO ByteString
formatUnixTime :: Format -> UnixTime -> IO Format
formatUnixTime Format
fmt UnixTime
t =
(CString -> CTime -> CString -> CInt -> IO CSize)
-> Format -> UnixTime -> IO Format
formatUnixTimeHelper CString -> CTime -> CString -> CInt -> IO CSize
c_format_unix_time Format
fmt UnixTime
t
{-# INLINE formatUnixTime #-}
formatUnixTimeGMT :: Format -> UnixTime -> ByteString
formatUnixTimeGMT :: Format -> UnixTime -> Format
formatUnixTimeGMT Format
fmt UnixTime
t =
IO Format -> Format
forall a. IO a -> a
unsafePerformIO (IO Format -> Format) -> IO Format -> Format
forall a b. (a -> b) -> a -> b
$ (CString -> CTime -> CString -> CInt -> IO CSize)
-> Format -> UnixTime -> IO Format
formatUnixTimeHelper CString -> CTime -> CString -> CInt -> IO CSize
c_format_unix_time_gmt Format
fmt UnixTime
t
{-# INLINE formatUnixTimeGMT #-}
formatUnixTimeHelper
:: (CString -> CTime -> CString -> CInt -> IO CSize)
-> Format
-> UnixTime
-> IO ByteString
formatUnixTimeHelper :: (CString -> CTime -> CString -> CInt -> IO CSize)
-> Format -> UnixTime -> IO Format
formatUnixTimeHelper CString -> CTime -> CString -> CInt -> IO CSize
formatFun Format
fmt (UnixTime CTime
sec Int32
_) =
Format -> (CString -> IO Format) -> IO Format
forall a. Format -> (CString -> IO a) -> IO a
useAsCString Format
fmt ((CString -> IO Format) -> IO Format)
-> (CString -> IO Format) -> IO Format
forall a b. (a -> b) -> a -> b
$ \CString
cfmt -> do
let siz :: Int
siz = Int
80
CString
ptr <- Int -> IO CString
forall a. Int -> IO (Ptr a)
mallocBytes Int
siz
Int
len <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CString -> CTime -> CString -> CInt -> IO CSize
formatFun CString
cfmt CTime
sec CString
ptr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
siz)
CString
ptr' <- CString -> Int -> IO CString
forall a. Ptr a -> Int -> IO (Ptr a)
reallocBytes CString
ptr (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
CString -> IO Format
unsafePackMallocCString CString
ptr'
webDateFormat :: Format
webDateFormat :: Format
webDateFormat = Format
"%a, %d %b %Y %H:%M:%S GMT"
mailDateFormat :: Format
mailDateFormat :: Format
mailDateFormat = Format
"%a, %d %b %Y %H:%M:%S %z"
fromEpochTime :: EpochTime -> UnixTime
fromEpochTime :: CTime -> UnixTime
fromEpochTime CTime
sec = CTime -> Int32 -> UnixTime
UnixTime CTime
sec Int32
0
toEpochTime :: UnixTime -> EpochTime
toEpochTime :: UnixTime -> CTime
toEpochTime (UnixTime CTime
sec Int32
_) = CTime
sec
fromClockTime :: ClockTime -> UnixTime
fromClockTime :: ClockTime -> UnixTime
fromClockTime (TOD Integer
sec Integer
psec) = CTime -> Int32 -> UnixTime
UnixTime CTime
sec' Int32
usec'
where
sec' :: CTime
sec' = Integer -> CTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
sec
usec' :: Int32
usec' = Integer -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int32) -> Integer -> Int32
forall a b. (a -> b) -> a -> b
$ Integer
psec Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
1000000
toClockTime :: UnixTime -> ClockTime
toClockTime :: UnixTime -> ClockTime
toClockTime (UnixTime CTime
sec Int32
usec) = Integer -> Integer -> ClockTime
TOD Integer
sec' Integer
psec'
where
sec' :: Integer
sec' = Rational -> Integer
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (CTime -> Rational
forall a. Real a => a -> Rational
toRational CTime
sec)
psec' :: Integer
psec' = Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> Integer) -> Int32 -> Integer
forall a b. (a -> b) -> a -> b
$ Int32
usec Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
1000000