-- | a module for caching a monadic action based on its return type
--
-- The cache is a HashMap where the key uses the TypeReP from Typeable.
-- The value stored is toDyn from Dynamic to support arbitrary value types in the same Map.
--
-- un-exported newtype wrappers should be used to maintain unique keys in the cache.
-- Note that a TypeRep is unique to a module in a package, so types from different modules will not conflict if they have the same name.
--
-- used in 'Yesod.Core.Handler.cached' and 'Yesod.Core.Handler.cachedBy'
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

-- | avoid performing the same action multiple times.
-- Values are stored by their TypeRep from Typeable.
-- Therefore, you should use un-exported newtype wrappers for each cache.
--
-- For example, yesod-auth uses an un-exported newtype, CachedMaybeAuth and exports functions that utilize it such as maybeAuth.
-- This means that another module can create its own newtype wrapper to cache the same type from a different action without any cache conflicts.
--
-- In Yesod, this is used for a request-local cache that is cleared at the end of every request.
-- See the original announcement: <http://www.yesodweb.com/blog/2013/03/yesod-1-2-cleaner-internals>
--
-- Since 1.4.0
cached :: (Monad m, Typeable a)
       => TypeMap
       -> m a                       -- ^ cache the result of this action
       -> m (Either (TypeMap, a) a) -- ^ Left is a cache miss, Right is a hit
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)

-- | Retrieves a value from the cache
--
-- @since 1.6.10
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"

-- | Sets a value in the cache
--
-- @since 1.6.10
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

-- | similar to 'cached'.
-- 'cached' can only cache a single value per type.
-- 'cachedBy' stores multiple values per type by indexing on a ByteString key
--
-- 'cached' is ideal to cache an action that has only one value of a type, such as the session's current user
-- 'cachedBy' is required if the action has parameters and can return multiple values per type.
-- You can turn those parameters into a ByteString cache key.
-- For example, caching a lookup of a Link by a token where multiple token lookups might be performed.
--
-- Since 1.4.0
cachedBy :: (Monad m, Typeable a)
         => KeyedTypeMap
         -> ByteString                     -- ^ a cache key
         -> m a                            -- ^ cache the result of this action
         -> m (Either (KeyedTypeMap, a) a) -- ^ Left is a cache miss, Right is a hit
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)

-- | Retrieves a value from the keyed cache
--
-- @since 1.6.10
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"

-- | Sets a value in the keyed cache
--
-- @since 1.6.10
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