http-date 0.0.4 → 0.0.11
raw patch · 8 files changed
Files
- Network/HTTP/Date.hs +2/−2
- Network/HTTP/Date/Converter.hs +43/−6
- Network/HTTP/Date/Formatter.hs +4/−4
- Network/HTTP/Date/Parser.hs +5/−3
- Network/HTTP/Date/Types.hs +1/−1
- http-date.cabal +9/−5
- test/DateSpec.hs +14/−2
- test/Model.hs +6/−1
Network/HTTP/Date.hs view
@@ -2,11 +2,11 @@ Fast parser and formatter for HTTP Date. -} module Network.HTTP.Date (- module Network.HTTP.Date.Types+ module Network.HTTP.Date.Converter+ , module Network.HTTP.Date.Types -- * Utility functions , parseHTTPDate , formatHTTPDate- , epochTimeToHTTPDate ) where import Network.HTTP.Date.Converter
Network/HTTP/Date/Converter.hs view
@@ -1,14 +1,17 @@ {-# LANGUAGE BangPatterns #-}-module Network.HTTP.Date.Converter (epochTimeToHTTPDate) where+module Network.HTTP.Date.Converter ( epochTimeToHTTPDate+ , httpDateToUTC+ , utcToHTTPDate+ ) where -import Control.Applicative-import Data.ByteString.Internal+import Data.Time+import Data.Time.Calendar.WeekDate import Data.Word import Foreign.Marshal.Array import Foreign.Ptr import Foreign.Storable import Network.HTTP.Date.Types-import System.IO.Unsafe (unsafePerformIO)+import System.IO.Unsafe (unsafeDupablePerformIO, unsafePerformIO) import System.Posix.Types {-|@@ -35,6 +38,40 @@ (y,m,d) = toYYMMDD days (h,n,s) = toHHMMSS secs +-- | Translating 'HTTPDate' to 'UTCTime'.+--+-- Since 0.0.7.+httpDateToUTC :: HTTPDate -> UTCTime+httpDateToUTC x = UTCTime (fromGregorian y m d) (secondsToDiffTime s)+ where+ y = fromIntegral $ hdYear x+ m = hdMonth x+ d = hdDay x+ s = fromIntegral $ (hdHour x `rem` 24) * 3600+ + (hdMinute x `rem` 60) * 60+ + (hdSecond x `rem` 60)++-- | Translating 'UTCTime' to 'HTTPDate'.+--+-- Since 0.0.7.+utcToHTTPDate :: UTCTime -> HTTPDate+utcToHTTPDate x = defaultHTTPDate {+ hdYear = fromIntegral y+ , hdMonth = m+ , hdDay = d+ , hdHour = h+ , hdMinute = n+ , hdSecond = truncate s+ , hdWkday = fromEnum (w :: Int)+ }+ where+ (y, m, d) = toGregorian day+ (h, n, s) = ((todHour tod), (todMin tod), (todSec tod))+ (_, _, w) = toWeekDate day+ day = localDay time+ tod = localTimeOfDay time+ time = utcToLocalTime utc x+ toYYMMDD :: Int -> (Int,Int,Int) toYYMMDD x = (yy, mm, dd) where@@ -55,10 +92,10 @@ isLeap year = year `rem` 4 == 0 && (year `rem` 400 == 0 || year `rem` 100 /= 0)- (months, daysArr) = if isLeap yy+ (mnths, daysArr) = if isLeap yy then (leapMonth, leapDayInMonth) else (normalMonth, normalDayInMonth)- findMonth n = inlinePerformIO $ (,) <$> (peekElemOff months n) <*> (peekElemOff daysArr n)+ findMonth n = unsafeDupablePerformIO $ (,) <$> (peekElemOff mnths n) <*> (peekElemOff daysArr n) ----------------------------------------------------------------
Network/HTTP/Date/Formatter.hs view
@@ -20,12 +20,12 @@ formatHTTPDate :: HTTPDate -> ByteString formatHTTPDate hd = unsafeCreate 29 $ \ptr -> do- cpy3 ptr weekDays (3 * (w - 1))+ cpy3 ptr weekDays (3 * w) poke (ptr `plusPtr` 3) comma poke (ptr `plusPtr` 4) spc int2 (ptr `plusPtr` 5) d poke (ptr `plusPtr` 7) spc- cpy3 (ptr `plusPtr` 8) months (3 * (m - 1))+ cpy3 (ptr `plusPtr` 8) months (3 * m) poke (ptr `plusPtr` 11) spc int4 (ptr `plusPtr` 12) y poke (ptr `plusPtr` 16) spc@@ -77,10 +77,10 @@ ---------------------------------------------------------------- months :: ForeignPtr Word8-months = let (PS p _ _) = "JanFebMarAprMayJunJulAugSepOctNovDec" in p+months = let (PS p _ _) = "___JanFebMarAprMayJunJulAugSepOctNovDec" in p weekDays :: ForeignPtr Word8-weekDays = let (PS p _ _) = "MonTueWedThuFriSatSun" in p+weekDays = let (PS p _ _) = "___MonTueWedThuFriSatSun" in p ----------------------------------------------------------------
Network/HTTP/Date/Parser.hs view
@@ -4,8 +4,8 @@ import Control.Applicative import Control.Monad-import Data.Attoparsec-import Data.Attoparsec.Char8+import Data.Attoparsec.ByteString+import Data.Attoparsec.ByteString.Char8 import Data.ByteString import Data.Char import Network.HTTP.Date.Types@@ -31,7 +31,9 @@ sp (h,n,s) <- time sp- void $ string "GMT"+ -- RFC 2616 defines GMT only but there are actually ill-formed ones such + -- as "+0000" and "UTC" in the wild.+ void $ string "GMT" <|> string "+0000" <|> string "UTC" return $ defaultHTTPDate { hdYear = y , hdMonth = m
Network/HTTP/Date/Types.hs view
@@ -22,7 +22,7 @@ , hdMinute :: !Int , hdSecond :: !Int , hdWkday :: !Int- } deriving (Eq,Show, Ord)+ } deriving (Eq, Show, Ord) {-| A default value for 'HTTPDate'.
http-date.cabal view
@@ -1,5 +1,5 @@ Name: http-date-Version: 0.0.4+Version: 0.0.11 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3@@ -7,28 +7,31 @@ Synopsis: HTTP Date parser/formatter Description: Fast parser and formatter for HTTP Date Category: Network, Web-Cabal-Version: >= 1.8+Cabal-Version: >= 1.10 Build-Type: Simple Library+ Default-Language: Haskell2010 GHC-Options: -Wall Exposed-Modules: Network.HTTP.Date Other-Modules: Network.HTTP.Date.Converter Network.HTTP.Date.Formatter Network.HTTP.Date.Types Network.HTTP.Date.Parser- Build-Depends: base >= 4 && < 5+ Build-Depends: base >= 4.9 && < 5 , array , attoparsec , bytestring+ , time Test-Suite spec+ Default-Language: Haskell2010 Type: exitcode-stdio-1.0 HS-Source-Dirs: test Main-Is: Spec.hs Other-Modules: DateSpec Model- Build-Depends: base >= 4 && < 5+ Build-Depends: base >= 4.9 && < 5 , bytestring , hspec , http-date@@ -36,11 +39,12 @@ , time Test-Suite doctests+ Default-Language: Haskell2010 Type: exitcode-stdio-1.0 HS-Source-Dirs: test Ghc-Options: -threaded Main-Is: doctests.hs- Build-Depends: base+ Build-Depends: base >= 4.9 , doctest >= 0.8 Source-Repository head
test/DateSpec.hs view
@@ -9,7 +9,7 @@ spec :: Spec spec = do- describe "formatHTTPDat" $ do+ describe "formatHTTPDate" $ do it "behaves like the model" $ forM_ [0,100000..10000000000] $ \epochtime -> do let m = model epochtime@@ -17,9 +17,21 @@ model = utcToDate . epochTimeToUtcTime ours = formatHTTPDate . epochTimeToHTTPDate o `shouldBe` m- describe "parseHTTPDate" $ do+ describe "httpDateToUTC" $ do it "behaves like the model" $ forM_ [0,100000..10000000000] $ \epochtime -> do+ let m = epochTimeToUtcTime epochtime+ o = httpDateToUTC $ epochTimeToHTTPDate epochtime+ o `shouldBe` m+ describe "parseHTTPDate" $ do+ it "behaves like the model" $+ forM_ [0,100000..10000000000] $ \epochtime -> do let m = epochTimeToHTTPDate epochtime Just o = parseHTTPDate $ formatHTTPDate m+ o `shouldBe` m+ describe "utcToHTTPDate" $ do+ it "behaves like the model" $+ forM_ [0,100000..10000000000] $ \epochtime -> do+ let m = epochTimeToHTTPDate epochtime+ o = utcToHTTPDate $ epochTimeToUtcTime epochtime o `shouldBe` m
test/Model.hs view
@@ -1,11 +1,16 @@+{-# LANGUAGE CPP #-}+ module Model where import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS8 import Data.Time import Data.Time.Clock.POSIX-import System.Locale import System.Posix.Types++#if !MIN_VERSION_time(1,5,0)+import System.Locale+#endif epochTimeToUtcTime :: EpochTime -> UTCTime epochTimeToUtcTime = posixSecondsToUTCTime . realToFrac