fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix(memcached): using memcachedHere did not compile due to staging problems

Browse Source
This commit is contained in:
Steffen Jost 2024-10-08 10:08:04 +02:00
parent f642b9cccf
commit 4e171a7a1a
1 changed files with 10 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Handler/Utils/Memcached.hs
View File

@ -377,10 +377,17 @@ newtype MemcachedUnkeyedLoc a = MemcachedUnkeyedLoc { unMemcachedUnkeyedLoc :: a
instance NFData a => NFData (MemcachedUnkeyedLoc a) where
rnf MemcachedUnkeyedLoc{..} = rnf unMemcachedUnkeyedLoc
-- avoids staging restictions
withMemcachedUnkeyedLoc :: Functor f => (f (MemcachedUnkeyedLoc a) -> f (MemcachedUnkeyedLoc a)) -> (f a -> f a)
withMemcachedUnkeyedLoc act = fmap unMemcachedUnkeyedLoc . act . fmap MemcachedUnkeyedLoc
{-# INLINE withMemcachedUnkeyedLoc #-}
-- Evaluates to: $(memcachedHere) :: forall a m. ( MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m, Typeable a, Binary a)
-- => Maybe Expiry -> m a -> m a
memcachedHere :: Q Exp
memcachedHere = do
loc <- location
[e| \mExp -> fmap unMemcachedUnkeyedLoc . memcachedBy mExp loc . fmap MemcachedUnkeyedLoc |]
[e| \mExp -> withMemcachedUnkeyedLoc (memcachedBy mExp loc) |]
newtype MemcachedKeyedLoc a = MemcachedKeyedLoc { unMemcachedKeyedLoc :: a }
deriving newtype (Eq, Ord, Show, Binary)
@ -395,6 +402,8 @@ withMemcachedKeyedLoc' :: (Functor f, Functor f') => (f (MemcachedKeyedLoc a) ->
withMemcachedKeyedLoc' act = fmap (fmap unMemcachedKeyedLoc) . act . fmap MemcachedKeyedLoc
{-# INLINE withMemcachedKeyedLoc' #-}
-- Evaluates to: $(memcachedByHere) :: forall a m k. ( MonadHandler m, HandlerSite m ~ UniWorX, MonadThrow m, Typeable a, Binary a, Binary k)
-- => Maybe Expiry -> k -> m a -> m a
memcachedByHere :: Q Exp
memcachedByHere = do
loc <- location