module Freckle.App.Memcached.Client
( MemcachedClient
, newMemcachedClient
, withMemcachedClient
, memcachedClientDisabled
, HasMemcachedClient (..)
, get
, set
) where
import Freckle.App.Prelude
import Control.Lens (Lens', view, _1)
import qualified Database.Memcache.Client as Memcache
import Database.Memcache.Types (Value)
import Freckle.App.Memcached.CacheKey
import Freckle.App.Memcached.CacheTTL
import Freckle.App.Memcached.Servers
import UnliftIO.Exception (finally)
import Yesod.Core.Lens
import Yesod.Core.Types (HandlerData)
data MemcachedClient
= MemcachedClient Memcache.Client
| MemcachedClientDisabled
class HasMemcachedClient env where
memcachedClientL :: Lens' env MemcachedClient
instance HasMemcachedClient MemcachedClient where
memcachedClientL :: Lens' MemcachedClient MemcachedClient
memcachedClientL = forall a. a -> a
id
instance HasMemcachedClient site => HasMemcachedClient (HandlerData child site) where
memcachedClientL :: Lens' (HandlerData child site) MemcachedClient
memcachedClientL = forall child site.
Lens' (HandlerData child site) (RunHandlerEnv child site)
envL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall child site. Lens' (RunHandlerEnv child site) site
siteL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall env. HasMemcachedClient env => Lens' env MemcachedClient
memcachedClientL
newMemcachedClient :: MonadIO m => MemcachedServers -> m MemcachedClient
newMemcachedClient :: forall (m :: * -> *).
MonadIO m =>
MemcachedServers -> m MemcachedClient
newMemcachedClient MemcachedServers
servers = case MemcachedServers -> [ServerSpec]
toServerSpecs MemcachedServers
servers of
[] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure MemcachedClient
memcachedClientDisabled
[ServerSpec]
specs -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Client -> MemcachedClient
MemcachedClient forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ServerSpec] -> Options -> IO Client
Memcache.newClient [ServerSpec]
specs forall a. Default a => a
Memcache.def
withMemcachedClient
:: MonadUnliftIO m => MemcachedServers -> (MemcachedClient -> m a) -> m a
withMemcachedClient :: forall (m :: * -> *) a.
MonadUnliftIO m =>
MemcachedServers -> (MemcachedClient -> m a) -> m a
withMemcachedClient MemcachedServers
servers MemcachedClient -> m a
f = do
MemcachedClient
c <- forall (m :: * -> *).
MonadIO m =>
MemcachedServers -> m MemcachedClient
newMemcachedClient MemcachedServers
servers
MemcachedClient -> m a
f MemcachedClient
c forall (m :: * -> *) a b. MonadUnliftIO m => m a -> m b -> m a
`finally` forall (m :: * -> *). MonadIO m => MemcachedClient -> m ()
quitClient MemcachedClient
c
memcachedClientDisabled :: MemcachedClient
memcachedClientDisabled :: MemcachedClient
memcachedClientDisabled = MemcachedClient
MemcachedClientDisabled
get
:: (MonadIO m, MonadReader env m, HasMemcachedClient env)
=> CacheKey
-> m (Maybe Value)
get :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasMemcachedClient env) =>
CacheKey -> m (Maybe Value)
get CacheKey
k = forall env (m :: * -> *) a.
(MonadReader env m, HasMemcachedClient env) =>
(MemcachedClient -> m a) -> m a
with forall a b. (a -> b) -> a -> b
$ \case
MemcachedClient Client
mc -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall s t a b. Field1 s t a b => Lens s t a b
_1 forall (c :: * -> *) (d :: * -> *) a b.
(Functor c, Functor d) =>
(a -> b) -> c (d a) -> c (d b)
<$$> Client -> Value -> IO (Maybe (Value, Flags, Version))
Memcache.get Client
mc (CacheKey -> Value
fromCacheKey CacheKey
k)
MemcachedClient
MemcachedClientDisabled -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
set
:: (MonadIO m, MonadReader env m, HasMemcachedClient env)
=> CacheKey
-> Value
-> CacheTTL
-> m ()
set :: forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasMemcachedClient env) =>
CacheKey -> Value -> CacheTTL -> m ()
set CacheKey
k Value
v CacheTTL
expiration = forall env (m :: * -> *) a.
(MonadReader env m, HasMemcachedClient env) =>
(MemcachedClient -> m a) -> m a
with forall a b. (a -> b) -> a -> b
$ \case
MemcachedClient Client
mc ->
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
Client -> Value -> Value -> Flags -> Flags -> IO Version
Memcache.set Client
mc (CacheKey -> Value
fromCacheKey CacheKey
k) Value
v Flags
0 forall a b. (a -> b) -> a -> b
$
CacheTTL -> Flags
fromCacheTTL
CacheTTL
expiration
MemcachedClient
MemcachedClientDisabled -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
quitClient :: MonadIO m => MemcachedClient -> m ()
quitClient :: forall (m :: * -> *). MonadIO m => MemcachedClient -> m ()
quitClient = \case
MemcachedClient Client
mc -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Client -> IO ()
Memcache.quit Client
mc
MemcachedClient
MemcachedClientDisabled -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
with
:: (MonadReader env m, HasMemcachedClient env)
=> (MemcachedClient -> m a)
-> m a
with :: forall env (m :: * -> *) a.
(MonadReader env m, HasMemcachedClient env) =>
(MemcachedClient -> m a) -> m a
with MemcachedClient -> m a
f = do
MemcachedClient
c <- forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall env. HasMemcachedClient env => Lens' env MemcachedClient
memcachedClientL
MemcachedClient -> m a
f MemcachedClient
c