Merge branch 'master' into cert-wip

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 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ViewPatterns #-}
+module TimeUtil
+    ( now
+    , IsTime(..)
+    , parseRFC2822
+    , printRFC2822
+    ) where
+
+import Data.Time.LocalTime
+import Data.Time.Format
+import Data.Time.Clock
+import Data.Time.Clock.POSIX
+import System.Locale
+import Data.String 
+import Control.Applicative
+import Data.Maybe
+import Data.Char
+import qualified Data.ByteString.Char8 as S
+
+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
+
+{-
+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 ()
+-}