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).
This commit is contained in:
Felipe Lessa 2012-09-05 00:41:54 -03:00
parent 498d22714b
commit 065e33a3d1

View File

@ -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