{-|
Module      : Z.IO.Time
Description : Fast time functions
Copyright   : (c) Dong Han, 2020
              (c) Kazu Yamamoto 2019
License     : BSD
Maintainer  : winterland1989@gmail.com
Stability   : experimental
Portability : non-portable

This module provides functions directly work on 'SystemTime' type, a compact time type from @time@ library.
For advanced time editing, use @time@ library.

-}
module Z.IO.Time
  ( -- * SystemTime
    SystemTime(..), getSystemTime'
    -- * Parsing
  , parseSystemTime, parseSystemTimeGMT
    -- * Formatting
  , formatSystemTime, formatSystemTimeGMT
    -- * Format
  , TimeFormat, simpleDateFormat, iso8061DateFormat, webDateFormat, mailDateFormat
  ) where

import Data.Time.Clock.System
import Data.Word
import Data.Int
import Foreign.C.Types
import Z.Foreign
import Z.Data.CBytes
import Z.IO.UV.FFI_Env
import Z.IO.Exception
import System.IO.Unsafe (unsafePerformIO)


-- | A alternative version of 'getSystemTime'' based on libuv's @uv_gettimeofday@, which also doesn't use pinned allocation.
getSystemTime' :: HasCallStack => IO SystemTime
getSystemTime' :: IO SystemTime
getSystemTime' = do
    (TimeVal64 Int64
s Int32
us) <- IO TimeVal64
HasCallStack => IO TimeVal64
getTimeOfDay
    SystemTime -> IO SystemTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Int64 -> Word32 -> SystemTime
MkSystemTime Int64
s (Int32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
us Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
1000))

-- | <https://man7.org/linux/man-pages/man3/strftime.3.html strftime> time format.
type TimeFormat = CBytes

-- | Simple format @2020-10-16 03:15:29@.
--
-- The value is \"%Y-%m-%d %H:%M:%S\".
-- This should be used with 'formatSystemTime' and 'parseSystemTime'.
simpleDateFormat :: TimeFormat
simpleDateFormat :: TimeFormat
simpleDateFormat = TimeFormat
"%Y-%m-%d %H:%M:%S"

-- | Simple format @2020-10-16T03:15:29@.
--
-- The value is \"%Y-%m-%dT%H:%M:%S%z\".
-- This should be used with 'formatSystemTime' and 'parseSystemTime'.
iso8061DateFormat :: TimeFormat
iso8061DateFormat :: TimeFormat
iso8061DateFormat = TimeFormat
"%Y-%m-%dT%H:%M:%S%z"

-- | Format for web (RFC 2616).
--
-- The value is \"%a, %d %b %Y %H:%M:%S GMT\".
-- This should be used with 'formatSystemTimeGMT' and 'parseSystemTimeGMT'.
webDateFormat :: TimeFormat
webDateFormat :: TimeFormat
webDateFormat = TimeFormat
"%a, %d %b %Y %H:%M:%S GMT"

-- | Format for e-mail (RFC 5322).
--
-- The value is \"%a, %d %b %Y %H:%M:%S %z\".
-- This should be used with 'formatSystemTime' and 'parseSystemTime'.
mailDateFormat :: TimeFormat
mailDateFormat :: TimeFormat
mailDateFormat = TimeFormat
"%a, %d %b %Y %H:%M:%S %z"

----------------------------------------------------------------
-- | Formatting 'SystemTime' to 'CBytes' in local time.
--
-- This is a wrapper for strftime_l(), 'systemNanoseconds' is ignored.
-- The result depends on the TZ environment variable.
--
formatSystemTime :: TimeFormat -> SystemTime -> IO CBytes
formatSystemTime :: TimeFormat -> SystemTime -> IO TimeFormat
formatSystemTime TimeFormat
fmt SystemTime
t = (BA# Word8 -> Int64 -> MBA# Word8 -> CInt -> IO CSize)
-> TimeFormat -> SystemTime -> IO TimeFormat
formatSystemTimeHelper BA# Word8 -> Int64 -> MBA# Word8 -> CInt -> IO CSize
c_format_unix_time TimeFormat
fmt SystemTime
t
{-# INLINE formatSystemTime #-}

-- | Formatting 'SystemTime' to 'CBytes' in GMT.
--
-- This is a wrapper for strftime_l(), 'systemNanoseconds' is ignored.
--
-- >>> formatSystemTimeGMT webDateFormat $ MkSystemTime 0 0
-- "Thu, 01 Jan 1970 00:00:00 GMT"
-- >>> let ut = MkSystemTime 100 200
-- >>> let str = formatSystemTimeGMT "%s" ut
-- >>> let ut' = parseSystemTimeGMT "%s" str
-- >>> ((==) `on` systemSeconds) ut ut'
-- True
-- >>> ((==) `on` systemNanoseconds) ut ut'
-- False
--
formatSystemTimeGMT :: TimeFormat -> SystemTime -> CBytes
formatSystemTimeGMT :: TimeFormat -> SystemTime -> TimeFormat
formatSystemTimeGMT TimeFormat
fmt SystemTime
t =
    IO TimeFormat -> TimeFormat
forall a. IO a -> a
unsafePerformIO (IO TimeFormat -> TimeFormat) -> IO TimeFormat -> TimeFormat
forall a b. (a -> b) -> a -> b
$ (BA# Word8 -> Int64 -> MBA# Word8 -> CInt -> IO CSize)
-> TimeFormat -> SystemTime -> IO TimeFormat
formatSystemTimeHelper BA# Word8 -> Int64 -> MBA# Word8 -> CInt -> IO CSize
c_format_unix_time_gmt TimeFormat
fmt SystemTime
t
{-# INLINE formatSystemTimeGMT #-}

----------------------------------------------------------------
-- | Parsing 'CBytes' to 'SystemTime' interpreting as localtime.
--
-- This is a wrapper for strptime_l().
-- Many implementations of strptime_l() do not support %Z and
-- some implementations of strptime_l() do not support %z, either.
-- 'systemNanoSeconds' is always set to 0.
--
-- The result depends on the TZ environment variable.
--
-- @
-- > setEnv "TZ" "Africa\/Algiers"
-- parseSystemTime simpleDateFormat "1970-01-01 00:00:00"
-- MkSystemTime {systemSeconds = 0, systemNanoseconds = 0}
-- > setEnv "TZ" "Asia\/Shanghai"
-- parseSystemTime simpleDateFormat "1970-01-01 00:00:00"
-- MkSystemTime {systemSeconds = -28800, systemNanoseconds = 0}
-- @
--
parseSystemTime :: TimeFormat -> CBytes -> IO SystemTime
parseSystemTime :: TimeFormat -> TimeFormat -> IO SystemTime
parseSystemTime TimeFormat
fmt TimeFormat
str =
    TimeFormat -> (BA# Word8 -> IO SystemTime) -> IO SystemTime
forall a. TimeFormat -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe TimeFormat
fmt ((BA# Word8 -> IO SystemTime) -> IO SystemTime)
-> (BA# Word8 -> IO SystemTime) -> IO SystemTime
forall a b. (a -> b) -> a -> b
$ \BA# Word8
cfmt ->
        TimeFormat -> (BA# Word8 -> IO SystemTime) -> IO SystemTime
forall a. TimeFormat -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe TimeFormat
str ((BA# Word8 -> IO SystemTime) -> IO SystemTime)
-> (BA# Word8 -> IO SystemTime) -> IO SystemTime
forall a b. (a -> b) -> a -> b
$ \BA# Word8
cstr -> do
            Int64
sec <- BA# Word8 -> BA# Word8 -> IO Int64
c_parse_unix_time BA# Word8
cfmt BA# Word8
cstr
            SystemTime -> IO SystemTime
forall (m :: * -> *) a. Monad m => a -> m a
return (SystemTime -> IO SystemTime) -> SystemTime -> IO SystemTime
forall a b. (a -> b) -> a -> b
$ Int64 -> Word32 -> SystemTime
MkSystemTime Int64
sec Word32
0

-- | Parsing 'CBytes' to 'SystemTime' interpreting as GMT.
-- This is a wrapper for strptime_l().
-- 'systemNanoSeconds' is always set to 0.
--
-- >>> parseSystemTimeGMT webDateFormat "Thu, 01 Jan 1970 00:00:00 GMT"
-- MkSystemTime {systemSeconds = 0, systemNanoseconds = 0}

parseSystemTimeGMT :: TimeFormat -> CBytes -> SystemTime
parseSystemTimeGMT :: TimeFormat -> TimeFormat -> SystemTime
parseSystemTimeGMT TimeFormat
fmt TimeFormat
str = IO SystemTime -> SystemTime
forall a. IO a -> a
unsafePerformIO (IO SystemTime -> SystemTime) -> IO SystemTime -> SystemTime
forall a b. (a -> b) -> a -> b
$
    TimeFormat -> (BA# Word8 -> IO SystemTime) -> IO SystemTime
forall a. TimeFormat -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe TimeFormat
fmt ((BA# Word8 -> IO SystemTime) -> IO SystemTime)
-> (BA# Word8 -> IO SystemTime) -> IO SystemTime
forall a b. (a -> b) -> a -> b
$ \BA# Word8
cfmt ->
        TimeFormat -> (BA# Word8 -> IO SystemTime) -> IO SystemTime
forall a. TimeFormat -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe TimeFormat
str ((BA# Word8 -> IO SystemTime) -> IO SystemTime)
-> (BA# Word8 -> IO SystemTime) -> IO SystemTime
forall a b. (a -> b) -> a -> b
$ \BA# Word8
cstr -> do
            Int64
sec <- BA# Word8 -> BA# Word8 -> IO Int64
c_parse_unix_time_gmt BA# Word8
cfmt BA# Word8
cstr
            SystemTime -> IO SystemTime
forall (m :: * -> *) a. Monad m => a -> m a
return (SystemTime -> IO SystemTime) -> SystemTime -> IO SystemTime
forall a b. (a -> b) -> a -> b
$ Int64 -> Word32 -> SystemTime
MkSystemTime Int64
sec Word32
0

--------------------------------------------------------------------------------

foreign import ccall unsafe "c_parse_unix_time"
        c_parse_unix_time :: BA# Word8 -> BA# Word8 -> IO Int64

foreign import ccall unsafe "c_parse_unix_time_gmt"
        c_parse_unix_time_gmt :: BA# Word8 -> BA# Word8 -> IO Int64

foreign import ccall unsafe "c_format_unix_time"
        c_format_unix_time :: BA# Word8 -> Int64 -> MBA# Word8 -> CInt -> IO CSize

foreign import ccall unsafe "c_format_unix_time_gmt"
        c_format_unix_time_gmt :: BA# Word8 -> Int64 -> MBA# Word8 -> CInt -> IO CSize

-- | Helper handling memory allocation for formatSystemTime and formatSystemTimeGMT.
formatSystemTimeHelper
    :: (BA# Word8 -> Int64 -> MBA# Word8 -> CInt -> IO CSize)
    -> TimeFormat
    -> SystemTime
    -> IO CBytes
formatSystemTimeHelper :: (BA# Word8 -> Int64 -> MBA# Word8 -> CInt -> IO CSize)
-> TimeFormat -> SystemTime -> IO TimeFormat
formatSystemTimeHelper BA# Word8 -> Int64 -> MBA# Word8 -> CInt -> IO CSize
formatFun TimeFormat
fmt SystemTime
t = Int -> IO TimeFormat
go Int
80
  where
    MkSystemTime Int64
sec Word32
_ = SystemTime
t
    go :: Int -> IO TimeFormat
go !Int
siz = do
        (TimeFormat
bs, CSize
r)<- Int -> (MBA# Word8 -> IO CSize) -> IO (TimeFormat, CSize)
forall a.
HasCallStack =>
Int -> (MBA# Word8 -> IO a) -> IO (TimeFormat, a)
allocCBytesUnsafe Int
siz ((MBA# Word8 -> IO CSize) -> IO (TimeFormat, CSize))
-> (MBA# Word8 -> IO CSize) -> IO (TimeFormat, CSize)
forall a b. (a -> b) -> a -> b
$ \ MBA# Word8
pbuf ->
            TimeFormat -> (BA# Word8 -> IO CSize) -> IO CSize
forall a. TimeFormat -> (BA# Word8 -> IO a) -> IO a
withCBytesUnsafe TimeFormat
fmt ((BA# Word8 -> IO CSize) -> IO CSize)
-> (BA# Word8 -> IO CSize) -> IO CSize
forall a b. (a -> b) -> a -> b
$ \ BA# Word8
pfmt ->
                BA# Word8 -> Int64 -> MBA# Word8 -> CInt -> IO CSize
formatFun BA# Word8
pfmt Int64
sec MBA# Word8
pbuf (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
siz)
        if CSize
r CSize -> CSize -> Bool
forall a. Ord a => a -> a -> Bool
<= CSize
0 then Int -> IO TimeFormat
go (Int
sizInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2) else TimeFormat -> IO TimeFormat
forall (m :: * -> *) a. Monad m => a -> m a
return TimeFormat
bs