Permalink
Browse files

Faster, leaner implementation of putTime/getTime.

Benchmark on my computer (per call, includes runPut/runGet):

    old putTime: 5658 ns +/- 224ns
    new putTime:  821 ns +/-  24ns (7x faster)

    old getTime: 7228 ns +/- 126ns
    new getTime:   99 ns +/-   4ns (73x faster!!)

Besides, the old format used 25 raw bytes (33.3 bytes on the
base64 output), while the new one uses 8 bytes (10.6 bytes on the
base64 output).
  • Loading branch information...
1 parent 498d227 commit 065e33a3d13e4bfacd47d073f94206430d88f9ed @meteficha meteficha committed Sep 5, 2012
Showing with 20 additions and 7 deletions.
  1. +20 −7 yesod-core/Yesod/Internal/Session.hs
@@ -8,6 +8,7 @@ module Yesod.Internal.Session
import Yesod.Internal (Header(..))
import qualified Web.ClientSession as CS
+import Data.Int (Int64)
import Data.Serialize
import Data.Time
import Data.ByteString (ByteString)
@@ -64,14 +65,26 @@ instance Serialize SessionCookie where
c <- map (first pack) <$> get
return $ SessionCookie a b c
+
+----------------------------------------------------------------------
+
+
putTime :: Putter UTCTime
-putTime t@(UTCTime d _) = do
- put $ toModifiedJulianDay d
- let ndt = diffUTCTime t $ UTCTime d 0
- put $ toRational ndt
+putTime (UTCTime d t) =
+ let d' = fromInteger $ toModifiedJulianDay d
+ t' = fromIntegral $ fromEnum (t / diffTimeScale)
+ in put (d' * posixDayLength_int64 + min posixDayLength_int64 t')
getTime :: Get UTCTime
getTime = do
- d <- get
- ndt <- get
- return $ fromRational ndt `addUTCTime` UTCTime (ModifiedJulianDay d) 0
+ val <- get
+ let (d, t) = val `divMod` posixDayLength_int64
+ d' = ModifiedJulianDay $! fromIntegral d
+ t' = fromIntegral t
+ d' `seq` t' `seq` return (UTCTime d' t')
+
+posixDayLength_int64 :: Int64
+posixDayLength_int64 = 86400
+
+diffTimeScale :: DiffTime
+diffTimeScale = 1e12

0 comments on commit 065e33a

Please sign in to comment.