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
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE CPP #-}
module TimeUtil
( now
, IsTime(..)
, fromTime
, toUTC
, parseRFC2822
, printRFC2822
, dateParser
) where
-- TODO: switch to hourglass package
import Data.Time.LocalTime
import Data.Time.Format
import Data.Time.Clock
import Data.Time.Clock.POSIX
#if !MIN_VERSION_time(1,5,0)
import System.Locale (defaultTimeLocale)
#endif
import Data.String
import Control.Applicative
import Data.Maybe
import Data.Char
import qualified Data.ByteString.Char8 as S
import qualified Data.ByteString.Lazy.Char8 as L
import Foreign.C.Types ( CTime(..) )
import Data.Word ( Word32 )
import ScanningParser
class IsTime a where
fromZonedTime :: ZonedTime -> a
toZonedTime :: a -> IO ZonedTime
instance IsTime ZonedTime where
fromZonedTime x = x
toZonedTime x = return x
instance IsTime UTCTime where
toZonedTime t = utcToLocalZonedTime t
fromZonedTime zt = zonedTimeToUTC zt
instance IsTime Integer where
toZonedTime t = utcToLocalZonedTime utime
where
utime = posixSecondsToUTCTime (fromIntegral t)
fromZonedTime zt = round $ utcTimeToPOSIXSeconds utime
where
utime = zonedTimeToUTC zt
printRFC2822 :: (IsString b, IsTime a) => a -> IO b
printRFC2822 tm = do
zt@(ZonedTime lt z) <- toZonedTime tm
let rfc2822 = formatTime defaultTimeLocale "%a, %0e %b %Y %T" zt ++ printZone
timeZoneStr = timeZoneOffsetString z
printZone = " " ++ timeZoneStr ++ " (" ++ fromString (show z) ++ ")"
return $ fromString $ rfc2822
parseRFC2822 :: IsTime b => S.ByteString -> Maybe b
parseRFC2822 str =
case mapMaybe (\f->parseTime defaultTimeLocale f str') formatRFC2822 of
[] -> Nothing
(zt:_) -> Just $ fromZonedTime zt
where
str' = S.unpack stripped
stripped = strip $ str
strip bs = bs3
where
(_,bs0) = S.span isSpace bs
(bs1,_) = S.spanEnd isSpace bs0
(bs2,cp) = S.spanEnd (==')') bs1
bs3 = if S.null cp
then bs2
else let (op,_) = S.spanEnd (/='(') bs2
in fst $ S.spanEnd isSpace $ S.init op
formatRFC2822 = [ "%a, %e %b %Y %T GMT"
, "%a, %e %b %Y %T %z"
, "%e %b %Y %T GMT"
, "%e %b %Y %T %z"
, "%a, %e %b %Y %R GMT"
, "%a, %e %b %Y %R %z"
, "%e %b %Y %R GMT"
, "%e %b %Y %R %z"
]
now :: IO Integer
now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime
dateParser :: ScanningParser L.ByteString UTCTime
dateParser = ScanningParser ffst pbdy
where
ffst bs = do
let (h,bs') = L.splitAt 6 bs
if h=="Date: "
then return $ parseRFC2822 $ foldr1 S.append $ L.toChunks bs'
else Nothing
pbdy date xs = (date,xs)
class IsUTC a where
fromUTC :: UTCTime -> a
toUTC :: a -> UTCTime
fromTime :: ( IsUTC a, IsUTC b ) => a -> b
fromTime = fromUTC . toUTC
instance IsUTC UTCTime where
fromUTC = id
toUTC = id
instance IsUTC CTime where
fromUTC utc = CTime (round $ utcTimeToPOSIXSeconds utc)
toUTC (CTime t) = posixSecondsToUTCTime (realToFrac t)
instance IsUTC Word32 where
fromUTC utc = round $ utcTimeToPOSIXSeconds utc
toUTC t = posixSecondsToUTCTime (realToFrac t)
{-
main = do
nowtime <- now
printRFC2822 nowtime >>= putStrLn
let test1 = "Thu, 08 May 2014 23:24:47 -0400"
test2 = " Thu, 08 May 2014 23:24:47 -0400 (EDT) "
putStrLn $ show (parseRFC2822 test1 :: Maybe Integer)
putStrLn $ show (parseRFC2822 test2 :: Maybe Integer)
return ()
-}
|
