module Yesod.Core.TypeCache (cached, cacheGet, cacheSet, cachedBy, cacheByGet, cacheBySet, TypeMap, KeyedTypeMap) where
import Prelude hiding (lookup)
import Data.Typeable (Typeable, TypeRep, typeOf)
import Data.HashMap.Strict
import Data.ByteString (ByteString)
import Data.Dynamic (Dynamic, toDyn, fromDynamic)
type TypeMap = HashMap TypeRep Dynamic
type KeyedTypeMap = HashMap (TypeRep, ByteString) Dynamic
cached :: (Monad m, Typeable a)
=> TypeMap
-> m a
-> m (Either (TypeMap, a) a)
cached :: forall (m :: * -> *) a.
(Monad m, Typeable a) =>
TypeMap -> m a -> m (Either (TypeMap, a) a)
cached TypeMap
cache m a
action = case forall a. Typeable a => TypeMap -> Maybe a
cacheGet TypeMap
cache of
Just a
val -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right a
val
Maybe a
Nothing -> do
a
val <- m a
action
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a. Typeable a => a -> TypeMap -> TypeMap
cacheSet a
val TypeMap
cache, a
val)
cacheGet :: Typeable a => TypeMap -> Maybe a
cacheGet :: forall a. Typeable a => TypeMap -> Maybe a
cacheGet TypeMap
cache = Maybe a
res
where
res :: Maybe a
res = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup (forall a. Typeable a => a -> TypeRep
typeOf forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> a
fromJust Maybe a
res) TypeMap
cache forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Typeable a => Dynamic -> Maybe a
fromDynamic
fromJust :: Maybe a -> a
fromJust :: forall a. Maybe a -> a
fromJust = forall a. HasCallStack => [Char] -> a
error [Char]
"Yesod.Handler.cached.fromJust: Argument to typeOf was evaluated"
cacheSet :: (Typeable a)
=> a
-> TypeMap
-> TypeMap
cacheSet :: forall a. Typeable a => a -> TypeMap -> TypeMap
cacheSet a
v TypeMap
cache = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
insert (forall a. Typeable a => a -> TypeRep
typeOf a
v) (forall a. Typeable a => a -> Dynamic
toDyn a
v) TypeMap
cache
cachedBy :: (Monad m, Typeable a)
=> KeyedTypeMap
-> ByteString
-> m a
-> m (Either (KeyedTypeMap, a) a)
cachedBy :: forall (m :: * -> *) a.
(Monad m, Typeable a) =>
KeyedTypeMap -> ByteString -> m a -> m (Either (KeyedTypeMap, a) a)
cachedBy KeyedTypeMap
cache ByteString
k m a
action = case forall a. Typeable a => ByteString -> KeyedTypeMap -> Maybe a
cacheByGet ByteString
k KeyedTypeMap
cache of
Just a
val -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right a
val
Maybe a
Nothing -> do
a
val <- m a
action
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (forall a.
Typeable a =>
ByteString -> a -> KeyedTypeMap -> KeyedTypeMap
cacheBySet ByteString
k a
val KeyedTypeMap
cache, a
val)
cacheByGet :: Typeable a => ByteString -> KeyedTypeMap -> Maybe a
cacheByGet :: forall a. Typeable a => ByteString -> KeyedTypeMap -> Maybe a
cacheByGet ByteString
key KeyedTypeMap
c = Maybe a
res
where
res :: Maybe a
res = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
lookup (forall a. Typeable a => a -> TypeRep
typeOf forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> a
fromJust Maybe a
res, ByteString
key) KeyedTypeMap
c forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Typeable a => Dynamic -> Maybe a
fromDynamic
fromJust :: Maybe a -> a
fromJust :: forall a. Maybe a -> a
fromJust = forall a. HasCallStack => [Char] -> a
error [Char]
"Yesod.Handler.cached.fromJust: Argument to typeOf was evaluated"
cacheBySet :: Typeable a => ByteString -> a -> KeyedTypeMap -> KeyedTypeMap
cacheBySet :: forall a.
Typeable a =>
ByteString -> a -> KeyedTypeMap -> KeyedTypeMap
cacheBySet ByteString
key a
v KeyedTypeMap
cache = forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
insert (forall a. Typeable a => a -> TypeRep
typeOf a
v, ByteString
key) (forall a. Typeable a => a -> Dynamic
toDyn a
v) KeyedTypeMap
cache