summaryrefslogtreecommitdiff
path: root/TimeUtil.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-05-08 23:38:08 -0400
committerjoe <joe@jerkface.net>2014-05-08 23:38:08 -0400
commit9a9bd16f3a522a6a2a7d032aa0cee14843a09631 (patch)
tree0a7b324e6de9929ee4fd9668044e73dfc244c5cd /TimeUtil.hs
parent1ce9a4ca269305fe4b7c66094d0314b82f1eada3 (diff)
parentc86733030f59f55441659add0a0d2f510bf57e83 (diff)
Merge branch 'master' into cert-wip
Diffstat (limited to 'TimeUtil.hs')
-rw-r--r--TimeUtil.hs88
1 files changed, 88 insertions, 0 deletions
diff --git a/TimeUtil.hs b/TimeUtil.hs
new file mode 100644
index 0000000..a4391e9
--- /dev/null
+++ b/TimeUtil.hs
@@ -0,0 +1,88 @@
1{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE ViewPatterns #-}
3module TimeUtil
4 ( now
5 , IsTime(..)
6 , parseRFC2822
7 , printRFC2822
8 ) where
9
10import Data.Time.LocalTime
11import Data.Time.Format
12import Data.Time.Clock
13import Data.Time.Clock.POSIX
14import System.Locale
15import Data.String
16import Control.Applicative
17import Data.Maybe
18import Data.Char
19import qualified Data.ByteString.Char8 as S
20
21class IsTime a where
22 fromZonedTime :: ZonedTime -> a
23 toZonedTime :: a -> IO ZonedTime
24
25instance IsTime ZonedTime where
26 fromZonedTime x = x
27 toZonedTime x = return x
28
29instance IsTime UTCTime where
30 toZonedTime t = utcToLocalZonedTime t
31 fromZonedTime zt = zonedTimeToUTC zt
32
33instance IsTime Integer where
34 toZonedTime t = utcToLocalZonedTime utime
35 where
36 utime = posixSecondsToUTCTime (fromIntegral t)
37 fromZonedTime zt = round $ utcTimeToPOSIXSeconds utime
38 where
39 utime = zonedTimeToUTC zt
40
41printRFC2822 :: (IsString b, IsTime a) => a -> IO b
42printRFC2822 tm = do
43 zt@(ZonedTime lt z) <- toZonedTime tm
44 let rfc2822 = formatTime defaultTimeLocale "%a, %0e %b %Y %T" zt ++ printZone
45 timeZoneStr = timeZoneOffsetString z
46 printZone = " " ++ timeZoneStr ++ " (" ++ fromString (show z) ++ ")"
47 return $ fromString $ rfc2822
48
49parseRFC2822 :: IsTime b => S.ByteString -> Maybe b
50parseRFC2822 str =
51 case mapMaybe (\f->parseTime defaultTimeLocale f str') formatRFC2822 of
52 [] -> Nothing
53 (zt:_) -> Just $ fromZonedTime zt
54 where
55 str' = S.unpack stripped
56 stripped = strip $ str
57 strip bs = bs3
58 where
59 (_,bs0) = S.span isSpace bs
60 (bs1,_) = S.spanEnd isSpace bs0
61 (bs2,cp) = S.spanEnd (==')') bs1
62 bs3 = if S.null cp
63 then bs2
64 else let (op,_) = S.spanEnd (/='(') bs2
65 in fst $ S.spanEnd isSpace $ S.init op
66 formatRFC2822 = [ "%a, %e %b %Y %T GMT"
67 , "%a, %e %b %Y %T %z"
68 , "%e %b %Y %T GMT"
69 , "%e %b %Y %T %z"
70 , "%a, %e %b %Y %R GMT"
71 , "%a, %e %b %Y %R %z"
72 , "%e %b %Y %R GMT"
73 , "%e %b %Y %R %z"
74 ]
75
76now :: IO Integer
77now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime
78
79{-
80main = do
81 nowtime <- now
82 printRFC2822 nowtime >>= putStrLn
83 let test1 = "Thu, 08 May 2014 23:24:47 -0400"
84 test2 = " Thu, 08 May 2014 23:24:47 -0400 (EDT) "
85 putStrLn $ show (parseRFC2822 test1 :: Maybe Integer)
86 putStrLn $ show (parseRFC2822 test2 :: Maybe Integer)
87 return ()
88-}