    {-# 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 (..))

    -- $setup
    -- >>> import Data.Function (on)
    -- >>> :set -XOverloadedStrings

    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

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

    -- |
    -- Parsing 'ByteString' to 'UnixTime' 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.
    -- 'utMicroSeconds' is always set to 0.
    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
                sec <- CString -> CString -> IO CTime
    c_parse_unix_time CString
    cfmt CString
    cstr
                return $ UnixTime sec 0

    -- |
    -- Parsing 'ByteString' to 'UnixTime' interpreting as GMT.
    -- This is a wrapper for strptime_l().
    -- 'utMicroSeconds' is always set to 0.
    --
    -- >>> parseUnixTimeGMT webDateFormat "Thu, 01 Jan 1970 00:00:00 GMT"
    -- UnixTime {utSeconds = 0, utMicroSeconds = 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
                sec <- CString -> CString -> IO CTime
    c_parse_unix_time_gmt CString
    cfmt CString
    cstr
                return $ UnixTime sec 0

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

    -- |
    -- Formatting 'UnixTime' to 'ByteString' in local time.
    -- This is a wrapper for strftime_l().
    -- 'utMicroSeconds' is ignored.
    -- The result depends on the TZ environment variable.
    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 #-}

    -- |
    -- Formatting 'UnixTime' to 'ByteString' in GMT.
    -- This is a wrapper for strftime_l().
    -- 'utMicroSeconds' is ignored.
    --
    -- >>> formatUnixTimeGMT webDateFormat $ UnixTime 0 0
    -- "Thu, 01 Jan 1970 00:00:00 GMT"
    -- >>> let ut = UnixTime 100 200
    -- >>> let str = formatUnixTimeGMT "%s" ut
    -- >>> let ut' = parseUnixTimeGMT "%s" str
    -- >>> ((==) `on` utSeconds) ut ut'
    -- True
    -- >>> ((==) `on` utMicroSeconds) ut ut'
    -- False
    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 #-}

    -- |
    -- Helper handling memory allocation for formatUnixTime and 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
            ptr <- Int -> IO CString
    forall a. Int -> IO (Ptr a)
    mallocBytes Int
    siz
            len <- fromIntegral <$> formatFun cfmt sec ptr (fromIntegral siz)
            ptr' <- reallocBytes ptr (len + 1)
            unsafePackMallocCString ptr' -- FIXME: Use unsafePackMallocCStringLen from bytestring-0.10.2.0

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

    -- |
    -- Format for web (RFC 2616).
    -- The value is \"%a, %d %b %Y %H:%M:%S GMT\".
    -- This should be used with 'formatUnixTimeGMT' and 'parseUnixTimeGMT'.
    webDateFormat :: Format
    webDateFormat :: Format
    webDateFormat = Format
    "%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 'formatUnixTime' and 'parseUnixTime'.
    mailDateFormat :: Format
    mailDateFormat :: Format
    mailDateFormat = Format
    "%a, %d %b %Y %H:%M:%S %z"

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

    -- |
    -- From 'EpochTime' to 'UnixTime' setting 'utMicroSeconds' to 0.
    fromEpochTime :: EpochTime -> UnixTime
    fromEpochTime :: CTime -> UnixTime
    fromEpochTime CTime
    sec = CTime -> Int32 -> UnixTime
    UnixTime CTime
    sec Int32
    0

    -- |
    -- From 'UnixTime' to 'EpochTime' ignoring 'utMicroSeconds'.
    toEpochTime :: UnixTime -> EpochTime
    toEpochTime :: UnixTime -> CTime
    toEpochTime (UnixTime CTime
    sec Int32
    _) = CTime
    sec

    -- |
    -- From 'ClockTime' to 'UnixTime'.
    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

    -- |
    -- From 'UnixTime' to 'ClockTime'.
    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