http-date 0.0.0 → 0.0.1
raw patch · 4 files changed
+64/−50 lines, 4 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- Network/HTTP/Date/Converter.hs +44/−19
- Network/HTTP/Date/Formatter.hs +15/−26
- Network/HTTP/Date/Parser.hs +4/−4
- http-date.cabal +1/−1
Network/HTTP/Date/Converter.hs view
@@ -1,7 +1,14 @@+{-# LANGUAGE BangPatterns #-} module Network.HTTP.Date.Converter (epochTimeToHTTPDate) where +import Control.Applicative+import Data.ByteString.Internal 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.Posix.Types {-|@@ -19,25 +26,25 @@ } where w64 :: Word64- w64 = truncate . toRational $ x- (days',secs') = w64 `divMod` 86400+ w64 = fromIntegral $ fromEnum x+ (days',secs') = w64 `quotRem` 86400 days = fromIntegral days' secs = fromIntegral secs' -- 1970/1/1 is Thu (4)- w = (days + 3) `mod` 7 + 1+ w = (days + 3) `rem` 7 + 1 (y,m,d) = toYYMMDD days (h,n,s) = toHHMMSS secs toYYMMDD :: Int -> (Int,Int,Int) toYYMMDD x = (yy, mm, dd) where- (y,d) = x `divMod` 365+ (y,d) = x `quotRem` 365 cy = 1970 + y cy' = cy - 1- leap = cy' `div` 4 - cy' `div` 100 + cy' `div` 400 - 477+ leap = cy' `quot` 4 - cy' `quot` 100 + cy' `quot` 400 - 477 (yy,days) = adjust cy d leap- (mm,dd) = findMonth 1 monthDays (days + 1)- adjust ty td aj+ (mm,dd) = findMonth days+ adjust !ty td aj | td >= aj = (ty, td - aj) | isLeap (ty - 1) = if td + 366 >= aj then (ty - 1, td + 366 - aj)@@ -45,17 +52,15 @@ | otherwise = if td + 365 >= aj then (ty - 1, td + 365 - aj) else adjust (ty - 1) (td + 365) aj- isLeap year = year `mod` 4 == 0- && (year `mod` 400 == 0 ||- year `mod` 100 /= 0)- monthDays- | isLeap yy = leapMonthDays- | otherwise = normalMonthDays- findMonth _ [] _ = error "findMonth"- findMonth m (n:ns) z- | z <= n = (m,z)- | otherwise = findMonth (m+1) ns (z-n)+ isLeap year = year `rem` 4 == 0+ && (year `rem` 400 == 0 ||+ year `rem` 100 /= 0)+ (months, daysArr) = if isLeap yy+ then (leapMonth, leapDayInMonth)+ else (normalMonth, normalDayInMonth)+ findMonth n = inlinePerformIO $ (,) <$> (peekElemOff months n) <*> (peekElemOff daysArr n) +---------------------------------------------------------------- normalMonthDays :: [Int] normalMonthDays = [31,28,31,30,31,30,31,31,30,31,30,31]@@ -63,8 +68,28 @@ leapMonthDays :: [Int] leapMonthDays = [31,29,31,30,31,30,31,31,30,31,30,31] +mkPtrInt :: [Int] -> Ptr Int+mkPtrInt = unsafePerformIO . newArray . concat . zipWith (flip replicate) [1..]++mkPtrInt2 :: [Int] -> Ptr Int+mkPtrInt2 = unsafePerformIO . newArray . concatMap (enumFromTo 1)++normalMonth :: Ptr Int+normalMonth = mkPtrInt normalMonthDays++normalDayInMonth :: Ptr Int+normalDayInMonth = mkPtrInt2 normalMonthDays++leapMonth :: Ptr Int+leapMonth = mkPtrInt leapMonthDays++leapDayInMonth :: Ptr Int+leapDayInMonth = mkPtrInt2 leapMonthDays++----------------------------------------------------------------+ toHHMMSS :: Int -> (Int,Int,Int) toHHMMSS x = (hh,mm,ss) where- (hhmm,ss) = x `divMod` 60- (hh,mm) = hhmm `divMod` 60+ (hhmm,ss) = x `quotRem` 60+ (hh,mm) = hhmm `quotRem` 60
Network/HTTP/Date/Formatter.hs view
@@ -2,9 +2,8 @@ module Network.HTTP.Date.Formatter (formatHTTPDate) where -import Data.Array-import Data.ByteString.Internal import Data.ByteString.Char8 ()+import Data.ByteString.Internal import Data.Word import Foreign.ForeignPtr import Foreign.Ptr@@ -19,12 +18,12 @@ formatHTTPDate :: HTTPDate -> ByteString formatHTTPDate hd = unsafeCreate 29 $ \ptr -> do- cpy3 ptr week+ cpy3 ptr weekDays (3 * (w - 1)) poke (ptr `plusPtr` 3) comma poke (ptr `plusPtr` 4) spc int2 (ptr `plusPtr` 5) d poke (ptr `plusPtr` 7) spc- cpy3 (ptr `plusPtr` 8) month+ cpy3 (ptr `plusPtr` 8) months (3 * (m - 1)) poke (ptr `plusPtr` 11) spc int4 (ptr `plusPtr` 12) y poke (ptr `plusPtr` 16) spc@@ -45,29 +44,26 @@ n = hdMinute hd s = hdSecond hd w = hdWkday hd- week = weekDays ! w- month = months ! m+ cpy3 :: Ptr Word8 -> ForeignPtr Word8 -> Int -> IO ()+ cpy3 ptr p o = withForeignPtr p $ \fp ->+ memcpy ptr (fp `plusPtr` o) 3 ---------------------------------------------------------------- -cpy3 :: Ptr Word8 -> ByteString -> IO ()-cpy3 ptr (PS p s l) = withForeignPtr p $ \fp ->- memcpy ptr (fp `plusPtr` s) (fromIntegral l)- int2 :: Ptr Word8 -> Int -> IO () int2 ptr n | n < 10 = do poke ptr zero poke (ptr `plusPtr` 1) (i2w8 n) | otherwise = do- poke ptr (i2w8 (n `div` 10))- poke (ptr `plusPtr` 1) (i2w8 (n `mod` 10))+ poke ptr (i2w8 (n `quot` 10))+ poke (ptr `plusPtr` 1) (i2w8 (n `rem` 10)) int4 :: Ptr Word8 -> Int -> IO () int4 ptr n0 = do- let (n1,x1) = n0 `divMod` 10- (n2,x2) = n1 `divMod` 10- (x4,x3) = n2 `divMod` 10+ let (n1,x1) = n0 `quotRem` 10+ (n2,x2) = n1 `quotRem` 10+ (x4,x3) = n2 `quotRem` 10 poke ptr (i2w8 x4) poke (ptr `plusPtr` 1) (i2w8 x3) poke (ptr `plusPtr` 2) (i2w8 x2)@@ -78,18 +74,11 @@ ---------------------------------------------------------------- -months :: Array Int ByteString-months = listArray (1,12) [- "Jan", "Feb", "Mar"- , "Apr", "May", "Jun"- , "Jul", "Aug", "Sep"- , "Oct", "Nov", "Dec"- ]+months :: ForeignPtr Word8+months = let (PS p _ _) = "JanFebMarAprMayJunJulAugSepOctNovDec" in p -weekDays :: Array Int ByteString-weekDays = listArray (1,7) [- "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"- ]+weekDays :: ForeignPtr Word8+weekDays = let (PS p _ _) = "MonTueWedThuFriSatSun" in p ----------------------------------------------------------------
Network/HTTP/Date/Parser.hs view
@@ -2,12 +2,12 @@ module Network.HTTP.Date.Parser (parseHTTPDate) where -import Data.ByteString-import Network.HTTP.Date.Types+import Control.Applicative import Data.Attoparsec import Data.Attoparsec.Char8-import Control.Applicative+import Data.ByteString import Data.Char+import Network.HTTP.Date.Types ---------------------------------------------------------------- @@ -55,7 +55,7 @@ sp y <- year return (y,m,d)- where + where day = digit2 year = digit4
http-date.cabal view
@@ -1,5 +1,5 @@ Name: http-date-Version: 0.0.0+Version: 0.0.1 Author: Kazu Yamamoto <kazu@iij.ad.jp> Maintainer: Kazu Yamamoto <kazu@iij.ad.jp> License: BSD3