Use cereal for 2x improvement in time and space for persistent.

Now the peak memory usage of the persistent test suite sits at
2 GiB (752 MB max residency).  It also uses a lot less CPU time.
This commit is contained in:
Felipe Lessa 2015-05-28 13:34:45 -03:00
parent 11197f6180
commit faae95312a
2 changed files with 15 additions and 15 deletions

View File

@ -20,6 +20,7 @@ library
, aeson
, base64-bytestring == 1.0.*
, bytestring
, cereal >= 0.4
, containers
, path-pieces
, persistent == 2.1.*
@ -52,7 +53,7 @@ test-suite tests
hs-source-dirs: tests
build-depends:
base, aeson, base64-bytestring, bytestring, containers,
base, aeson, base64-bytestring, bytestring, cereal, containers,
path-pieces, persistent, persistent-template, text, time,
transformers

View File

@ -8,19 +8,20 @@ module Web.ServerSession.Backend.Persistent.Internal.Types
, SessionMapJ(..)
) where
import Control.Arrow (first)
import Control.Monad ((>=>), mzero)
import Data.ByteString (ByteString)
import Data.Text (Text)
import Data.Typeable (Typeable)
import Database.Persist (PersistField(..))
import Database.Persist.Sql (PersistFieldSql(..))
import Database.Persist.Sql (PersistFieldSql(..), SqlType(..))
import Web.ServerSession.Core
import Web.ServerSession.Core.Internal (SessionId(..))
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Base64.URL as B64URL
import qualified Data.Map as M
import qualified Data.Serialize as S
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
@ -65,24 +66,22 @@ instance A.ToJSON ByteStringJ where
----------------------------------------------------------------------
-- | Newtype of a 'SessionMap' that serializes as a JSON on
-- the database. We use JSON because it's easy to inspect for a
-- human.
-- | Newtype of a 'SessionMap' that serializes using @cereal@ on
-- the database. We tried to use @aeson@ but @cereal@ is twice
-- faster and uses half the memory for this use case.
newtype SessionMapJ = M { unM :: SessionMap }
deriving (Eq, Ord, Show, Read, Typeable)
encodeT :: A.ToJSON a => a -> Text
encodeT = TE.decodeUtf8 . L.toStrict . A.encode
decodeT :: A.FromJSON a => Text -> Either Text a
decodeT = either (Left . T.pack) Right . A.eitherDecode . L.fromStrict . TE.encodeUtf8
instance PersistField SessionMapJ where
toPersistValue = toPersistValue . encodeT
fromPersistValue = fromPersistValue >=> decodeT
toPersistValue = toPersistValue . S.encode
fromPersistValue = fromPersistValue >=> (either (Left . T.pack) Right . S.decode)
instance PersistFieldSql SessionMapJ where
sqlType p = sqlType (fmap encodeT p)
sqlType _ = SqlBlob
instance S.Serialize SessionMapJ where
put = S.put . map (first TE.encodeUtf8) . M.toAscList . unM
get = M . M.fromAscList . map (first TE.decodeUtf8) <$> S.get
instance A.FromJSON SessionMapJ where
parseJSON = fmap fixup . A.parseJSON