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 cache :: TypeMap
cache action :: m a
action = case TypeMap -> Maybe a
forall a. Typeable a => TypeMap -> Maybe a
cacheGet TypeMap
cache of
Just val :: 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
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 cache :: 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 "Yesod.Handler.cached.fromJust: Argument to typeOf was evaluated"
cacheSet :: (Typeable a)
=> a
-> TypeMap
-> TypeMap
cacheSet :: a -> TypeMap -> TypeMap
cacheSet v :: a
v cache :: 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 cache :: KeyedTypeMap
cache k :: ByteString
k action :: m a
action = case ByteString -> KeyedTypeMap -> Maybe a
forall a. Typeable a => ByteString -> KeyedTypeMap -> Maybe a
cacheByGet ByteString
k KeyedTypeMap
cache of
Just val :: 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
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 key :: ByteString
key c :: 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 "Yesod.Handler.cached.fromJust: Argument to typeOf was evaluated"
cacheBySet :: Typeable a => ByteString -> a -> KeyedTypeMap -> KeyedTypeMap
cacheBySet :: ByteString -> a -> KeyedTypeMap -> KeyedTypeMap
cacheBySet key :: ByteString
key v :: a
v cache :: 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