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