diff options
Diffstat (limited to 'TimeUtil.hs')
-rw-r--r-- | TimeUtil.hs | 128 |
1 files changed, 0 insertions, 128 deletions
diff --git a/TimeUtil.hs b/TimeUtil.hs deleted file mode 100644 index 879bc32..0000000 --- a/TimeUtil.hs +++ /dev/null | |||
@@ -1,128 +0,0 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | {-# LANGUAGE ViewPatterns #-} | ||
3 | {-# LANGUAGE CPP #-} | ||
4 | module TimeUtil | ||
5 | ( now | ||
6 | , IsTime(..) | ||
7 | , fromTime | ||
8 | , toUTC | ||
9 | , parseRFC2822 | ||
10 | , printRFC2822 | ||
11 | , dateParser | ||
12 | ) where | ||
13 | |||
14 | import Data.Time.LocalTime | ||
15 | import Data.Time.Format | ||
16 | import Data.Time.Clock | ||
17 | import Data.Time.Clock.POSIX | ||
18 | #if !MIN_VERSION_time(1,5,0) | ||
19 | import System.Locale (defaultTimeLocale) | ||
20 | #endif | ||
21 | import Data.String | ||
22 | import Control.Applicative | ||
23 | import Data.Maybe | ||
24 | import Data.Char | ||
25 | import qualified Data.ByteString.Char8 as S | ||
26 | import qualified Data.ByteString.Lazy.Char8 as L | ||
27 | import Foreign.C.Types ( CTime(..) ) | ||
28 | import Data.Word ( Word32 ) | ||
29 | |||
30 | import ScanningParser | ||
31 | |||
32 | class IsTime a where | ||
33 | fromZonedTime :: ZonedTime -> a | ||
34 | toZonedTime :: a -> IO ZonedTime | ||
35 | |||
36 | instance IsTime ZonedTime where | ||
37 | fromZonedTime x = x | ||
38 | toZonedTime x = return x | ||
39 | |||
40 | instance IsTime UTCTime where | ||
41 | toZonedTime t = utcToLocalZonedTime t | ||
42 | fromZonedTime zt = zonedTimeToUTC zt | ||
43 | |||
44 | instance IsTime Integer where | ||
45 | toZonedTime t = utcToLocalZonedTime utime | ||
46 | where | ||
47 | utime = posixSecondsToUTCTime (fromIntegral t) | ||
48 | fromZonedTime zt = round $ utcTimeToPOSIXSeconds utime | ||
49 | where | ||
50 | utime = zonedTimeToUTC zt | ||
51 | |||
52 | printRFC2822 :: (IsString b, IsTime a) => a -> IO b | ||
53 | printRFC2822 tm = do | ||
54 | zt@(ZonedTime lt z) <- toZonedTime tm | ||
55 | let rfc2822 = formatTime defaultTimeLocale "%a, %0e %b %Y %T" zt ++ printZone | ||
56 | timeZoneStr = timeZoneOffsetString z | ||
57 | printZone = " " ++ timeZoneStr ++ " (" ++ fromString (show z) ++ ")" | ||
58 | return $ fromString $ rfc2822 | ||
59 | |||
60 | parseRFC2822 :: IsTime b => S.ByteString -> Maybe b | ||
61 | parseRFC2822 str = | ||
62 | case mapMaybe (\f->parseTime defaultTimeLocale f str') formatRFC2822 of | ||
63 | [] -> Nothing | ||
64 | (zt:_) -> Just $ fromZonedTime zt | ||
65 | where | ||
66 | str' = S.unpack stripped | ||
67 | stripped = strip $ str | ||
68 | strip bs = bs3 | ||
69 | where | ||
70 | (_,bs0) = S.span isSpace bs | ||
71 | (bs1,_) = S.spanEnd isSpace bs0 | ||
72 | (bs2,cp) = S.spanEnd (==')') bs1 | ||
73 | bs3 = if S.null cp | ||
74 | then bs2 | ||
75 | else let (op,_) = S.spanEnd (/='(') bs2 | ||
76 | in fst $ S.spanEnd isSpace $ S.init op | ||
77 | formatRFC2822 = [ "%a, %e %b %Y %T GMT" | ||
78 | , "%a, %e %b %Y %T %z" | ||
79 | , "%e %b %Y %T GMT" | ||
80 | , "%e %b %Y %T %z" | ||
81 | , "%a, %e %b %Y %R GMT" | ||
82 | , "%a, %e %b %Y %R %z" | ||
83 | , "%e %b %Y %R GMT" | ||
84 | , "%e %b %Y %R %z" | ||
85 | ] | ||
86 | |||
87 | now :: IO Integer | ||
88 | now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime | ||
89 | |||
90 | dateParser :: ScanningParser L.ByteString UTCTime | ||
91 | dateParser = ScanningParser ffst pbdy | ||
92 | where | ||
93 | ffst bs = do | ||
94 | let (h,bs') = L.splitAt 6 bs | ||
95 | if h=="Date: " | ||
96 | then return $ parseRFC2822 $ foldr1 S.append $ L.toChunks bs' | ||
97 | else Nothing | ||
98 | pbdy date xs = (date,xs) | ||
99 | |||
100 | class IsUTC a where | ||
101 | fromUTC :: UTCTime -> a | ||
102 | toUTC :: a -> UTCTime | ||
103 | |||
104 | fromTime :: ( IsUTC a, IsUTC b ) => a -> b | ||
105 | fromTime = fromUTC . toUTC | ||
106 | |||
107 | instance IsUTC UTCTime where | ||
108 | fromUTC = id | ||
109 | toUTC = id | ||
110 | |||
111 | instance IsUTC CTime where | ||
112 | fromUTC utc = CTime (round $ utcTimeToPOSIXSeconds utc) | ||
113 | toUTC (CTime t) = posixSecondsToUTCTime (realToFrac t) | ||
114 | |||
115 | instance IsUTC Word32 where | ||
116 | fromUTC utc = round $ utcTimeToPOSIXSeconds utc | ||
117 | toUTC t = posixSecondsToUTCTime (realToFrac t) | ||
118 | |||
119 | {- | ||
120 | main = do | ||
121 | nowtime <- now | ||
122 | printRFC2822 nowtime >>= putStrLn | ||
123 | let test1 = "Thu, 08 May 2014 23:24:47 -0400" | ||
124 | test2 = " Thu, 08 May 2014 23:24:47 -0400 (EDT) " | ||
125 | putStrLn $ show (parseRFC2822 test1 :: Maybe Integer) | ||
126 | putStrLn $ show (parseRFC2822 test2 :: Maybe Integer) | ||
127 | return () | ||
128 | -} | ||