Implementing a high-order Cache effect - Polysemy

Welcome to the Functional Programming Zulip Chat Archive. You can join the chat here.

Alex Chapman

Hi Polysemisers, I'm trying to implement an effect that caches the results of data obtained using other effects. I have code that feels close, but I'm stuck:

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

import Data.Hashable (Hashable)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import Polysemy
import Polysemy.State
-- import Polysemy.AtomicState -- TODO: thread safety

data Cache k v m a where
    :: (k -> m v) -- ^ How to retrieve a value if it doesn't exist in the cache
    -> (v -> m v) -- ^ How to return a value if it does exist in the cache (useful to e.g. add logging, otherwise just use 'pure'
    -> k -- ^ The key to retrieve
    -> Cache k v m v -- ^ Returns the value

makeSem ''Cache

  :: forall k v r a
   . (Eq k, Hashable k)
  => Sem (Cache k v ': r) a -> Sem r a
runCacheAsHashMap = evalState (HM.empty @k @v) . reinterpretH
    CacheGet fetch returnFromCache k -> do
      cache <- get
      case HM.lookup k cache of
        Just v -> do
          returnFromCache' <- bindT returnFromCache -- f v -> Sem (Cache k v ': State (HashMap k v) ': r) (f v)
          pureT v >>= returnFromCache'
        Nothing -> do
          fetch' <- bindT fetch                     -- f k -> Sem (Cache k v ': State (HashMap k v) ': r) (f v)
          fv <- pureT k >>= fetch'
          let fcache = (\v' -> HM.insert k v' cache) <$> fv
          put' <- bindT put
          put' fcache
          pure fv

The error I'm getting is:

src/Cache.hs:61:25-27: error:
    • Ambiguous use of effect 'State'
      Possible fix:
        add (Member (State (HashMap k v)) r0) to the context of
          the type signature
      If you already have the constraint you want, instead
        add a type application to specify
          'HashMap k v' directly, or activate polysemy-plugin which
            can usually infer the type correctly.
    • In the first argument of ‘bindT’, namely ‘put’
      In a stmt of a 'do' block: put' <- bindT put
      In the expression:
        do fetch' <- bindT fetch
           fv <- pureT k >>= fetch'
           let fcache = (\ v' -> ...) <$> fv
           put' <- bindT put
61 |           put' <- bindT put
   |                         ^^^
Alex Chapman

Oh, and it's not as simple as the error suggests: I already have polysemy-plugin running, and if I add a type application so the line is put' <- bindT (put @(HashMap k v)) then I still get the same error.

Torsten Schmits

put isn't an m a in your effect, it's a Sem! you used get without bindT, same here.


I think Cache could be simplified a little bit: first, (k, k -> m v) can be turned into (k , m v) unless you want to modify k dynamically before feeding it into the action for retrieval.
Second, instead of carrying e.g. logging action around, you could possibly intercept the effect, thus getting rid of one more field?

In case we apply these changes, maybe something like this would work:

data Cache k v m a where
  Cache :: k -> m v -> Cache k v m v

  :: (Ord k, Member (State (M.Map k v)) r)
  => Sem (Cache k v : r) a -> Sem r a
runCache = interpretH \(Cache k mv) ->
  gets (M.!? k) >>= \case
    Just v  -> pureT v
    Nothing -> do
      fv <- join $ raise . runCache <$> runT mv
      (`inspect` fv) <$> getInspectorT >>=
        maybe (pure ()) (modify . M.insert k)
      pure fv
Alex Chapman

Thanks! I'll take a look tomorrow morning.

Alex Chapman

Thanks @TheMatten, starting with your code I got something working the way I wanted:

  :: (Eq k, Hashable k, Member (State (HashMap k v)) r)
  => Sem (Cache k v : r) a -> Sem r a
runCacheInHashMap = interpretH $ \(Cache k mv) ->
  gets (HM.lookup k) >>= \case
    Just v  -> pureT v
    Nothing -> do
      fv <- runT mv >>= raise . runCacheInHashMap
      (`inspect` fv) <$> getInspectorT >>=
        maybe (pure ()) (modify . HM.insert k)
      pure fv

  :: (Eq k, Hashable k)
  => Sem (Cache k v ': r) a -> Sem r a
runCacheAsHashMap = evalState HM.empty . runCacheInHashMap . raiseUnder

I have no idea how that recursive call to runCacheInHashMap works. All this Tactical stuff is mind bending. But it works!


That recursive call is really us saying "we want to run that effectful argument to Cache in same way as the computation we're in". Reason why polysemy doesn't do this for you is that you may want to run it in a different way.

Georgi Lyubenov // googleson78

Maybe this thing could be documented somewhere close to Tactics/Strategy "you may often have to recursively blabla..", I had the same question before and it was the same answer too.

Georgi Lyubenov // googleson78

(or I just missed it in the docs :thinking: )