module Freckle.App.Memcached
( Cachable(..)
, caching
, cachingAs
, cachingAsJSON
, module Freckle.App.Memcached.Client
, module Freckle.App.Memcached.CacheKey
, module Freckle.App.Memcached.CacheTTL
) where
import Freckle.App.Prelude
import Blammo.Logging
import Data.Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BSL
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Freckle.App.Memcached.CacheKey
import Freckle.App.Memcached.CacheTTL
import Freckle.App.Memcached.Client (HasMemcachedClient(..))
import qualified Freckle.App.Memcached.Client as Memcached
import UnliftIO.Exception (Exception(..), handleAny)
class Cachable a where
toCachable :: a -> ByteString
fromCachable :: ByteString -> Either String a
instance Cachable ByteString where
toCachable :: ByteString -> ByteString
toCachable = forall a. a -> a
id
fromCachable :: ByteString -> Either String ByteString
fromCachable = forall a b. b -> Either a b
Right
instance Cachable BSL.ByteString where
toCachable :: ByteString -> ByteString
toCachable = ByteString -> ByteString
BSL.toStrict
fromCachable :: ByteString -> Either String ByteString
fromCachable = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict
instance Cachable Text where
toCachable :: Text -> ByteString
toCachable = Text -> ByteString
encodeUtf8
fromCachable :: ByteString -> Either String Text
fromCachable = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode
data Cached a
= CacheFound a
| CacheNotFound
| CacheError Text
caching
:: ( MonadUnliftIO m
, MonadLogger m
, MonadReader env m
, HasMemcachedClient env
, Cachable a
)
=> CacheKey
-> CacheTTL
-> m a
-> m a
caching :: forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
HasMemcachedClient env, Cachable a) =>
CacheKey -> CacheTTL -> m a -> m a
caching = forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
HasMemcachedClient env) =>
(ByteString -> Either String a)
-> (a -> ByteString) -> CacheKey -> CacheTTL -> m a -> m a
cachingAs forall a. Cachable a => ByteString -> Either String a
fromCachable forall a. Cachable a => a -> ByteString
toCachable
cachingAs
:: (MonadUnliftIO m, MonadLogger m, MonadReader env m, HasMemcachedClient env)
=> (ByteString -> Either String a)
-> (a -> ByteString)
-> CacheKey
-> CacheTTL
-> m a
-> m a
cachingAs :: forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
HasMemcachedClient env) =>
(ByteString -> Either String a)
-> (a -> ByteString) -> CacheKey -> CacheTTL -> m a -> m a
cachingAs ByteString -> Either String a
from a -> ByteString
to CacheKey
key CacheTTL
ttl m a
f = do
Cached a
result <-
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Cached a
CacheNotFound (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Text -> Cached a
CacheError forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack) forall a. a -> Cached a
CacheFound forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String a
from))
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
a -> Text -> m a -> m a
handleCachingError forall a. Maybe a
Nothing Text
"getting"
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasMemcachedClient env) =>
CacheKey -> m (Maybe ByteString)
Memcached.get CacheKey
key
case Cached a
result of
CacheFound a
a -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
Cached a
CacheNotFound -> m a
store
CacheError Text
e -> do
forall (m :: * -> *). MonadLogger m => Text -> Text -> m ()
logCachingError Text
"deserializing" Text
e
m a
store
where
store :: m a
store = do
a
a <- m a
f
a
a forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
a -> Text -> m a -> m a
handleCachingError () Text
"setting" (forall (m :: * -> *) env.
(MonadIO m, MonadReader env m, HasMemcachedClient env) =>
CacheKey -> ByteString -> CacheTTL -> m ()
Memcached.set CacheKey
key (a -> ByteString
to a
a) CacheTTL
ttl)
cachingAsJSON
:: ( MonadUnliftIO m
, MonadLogger m
, MonadReader env m
, HasMemcachedClient env
, FromJSON a
, ToJSON a
)
=> CacheKey
-> CacheTTL
-> m a
-> m a
cachingAsJSON :: forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
HasMemcachedClient env, FromJSON a, ToJSON a) =>
CacheKey -> CacheTTL -> m a -> m a
cachingAsJSON = forall (m :: * -> *) env a.
(MonadUnliftIO m, MonadLogger m, MonadReader env m,
HasMemcachedClient env) =>
(ByteString -> Either String a)
-> (a -> ByteString) -> CacheKey -> CacheTTL -> m a -> m a
cachingAs forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict forall a. ToJSON a => a -> ByteString
encodeStrict
handleCachingError
:: (MonadUnliftIO m, MonadLogger m) => a -> Text -> m a -> m a
handleCachingError :: forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
a -> Text -> m a -> m a
handleCachingError a
value Text
action = forall (m :: * -> *) a.
MonadUnliftIO m =>
(SomeException -> m a) -> m a -> m a
handleAny forall a b. (a -> b) -> a -> b
$ \SomeException
ex -> do
forall (m :: * -> *). MonadLogger m => Text -> Text -> m ()
logCachingError Text
action forall a b. (a -> b) -> a -> b
$ String -> Text
pack forall a b. (a -> b) -> a -> b
$ forall e. Exception e => e -> String
displayException SomeException
ex
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
value
logCachingError :: MonadLogger m => Text -> Text -> m ()
logCachingError :: forall (m :: * -> *). MonadLogger m => Text -> Text -> m ()
logCachingError Text
action Text
message =
forall (m :: * -> *).
(HasCallStack, MonadLogger m) =>
Text -> Message -> m ()
logErrorNS Text
"caching"
forall a b. (a -> b) -> a -> b
$ Text
"Error "
forall a. Semigroup a => a -> a -> a
<> Text
action
Text -> [SeriesElem] -> Message
:# [Key
"action" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
action, Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
message]
encodeStrict :: ToJSON a => a -> ByteString
encodeStrict :: forall a. ToJSON a => a -> ByteString
encodeStrict = ByteString -> ByteString
BSL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encode