1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
{-# 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 fmt str = unsafePerformIO $
useAsCString fmt $ \cfmt ->
useAsCString str $ \cstr -> do
sec <- c_parse_unix_time cfmt 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 fmt str = unsafePerformIO $
useAsCString fmt $ \cfmt ->
useAsCString str $ \cstr -> do
sec <- c_parse_unix_time_gmt cfmt 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 fmt t =
formatUnixTimeHelper c_format_unix_time fmt 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 fmt t =
unsafePerformIO $ formatUnixTimeHelper c_format_unix_time_gmt fmt t
{-# INLINE formatUnixTimeGMT #-}
-- |
-- Helper handling memory allocation for formatUnixTime and formatUnixTimeGMT.
formatUnixTimeHelper
:: (CString -> CTime -> CString -> CInt -> IO CSize)
-> Format
-> UnixTime
-> IO ByteString
formatUnixTimeHelper formatFun fmt (UnixTime sec _) =
useAsCString fmt $ \cfmt -> do
let siz = 80
ptr <- mallocBytes 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 = "%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 = "%a, %d %b %Y %H:%M:%S %z"
----------------------------------------------------------------
-- |
-- From 'EpochTime' to 'UnixTime' setting 'utMicroSeconds' to 0.
fromEpochTime :: EpochTime -> UnixTime
fromEpochTime sec = UnixTime sec 0
-- |
-- From 'UnixTime' to 'EpochTime' ignoring 'utMicroSeconds'.
toEpochTime :: UnixTime -> EpochTime
toEpochTime (UnixTime sec _) = sec
-- |
-- From 'ClockTime' to 'UnixTime'.
fromClockTime :: ClockTime -> UnixTime
fromClockTime (TOD sec psec) = UnixTime sec' usec'
where
sec' = fromIntegral sec
usec' = fromIntegral $ psec `div` 1000000
-- |
-- From 'UnixTime' to 'ClockTime'.
toClockTime :: UnixTime -> ClockTime
toClockTime (UnixTime sec usec) = TOD sec' psec'
where
sec' = truncate (toRational sec)
psec' = fromIntegral $ usec * 1000000
|
