CODEWITHSUNDEEP
haskell
cdk
cdk

Reputation: 6778

Using pipes/proxies with concurrent MVars

In the Control.Proxy tutorial for the pipes-3.1.0 package, the author provides this function:

cache :: (Proxy p, Ord key) => key -> p key val key val IO r
cache = runIdentityK (loop M.empty) where
    loop _map key = case M.lookup key _map of
        Nothing -> do
            val  <- request key
            key2 <- respond val
            loop (M.insert key val _map) key2
        Just val -> do
            lift $ putStrLn "Used cache!"
            key2 <- respond val
            loop _map key2

Because I'd like to have a concurrent application caching requests, I have the following data type

newtype Cache k v = Cache (MVar (M.Map k v))

and now I want a new cache function with the signature 

cache :: (Proxy p, Ord k) => Cache k v -> k -> p k v k v IO r
cache (Cache c) k = readMVar c >>= \m -> runIdentityK $ loop m k
    where loop m key = case M.lookup key m of
            Nothing -> do
                val <- request key
                respond val >>= loop (M.insert key val m)
            Just val -> respond val >>= loop m

however, this fails to typecheck since readMVar is in the IO monad, and runIdentityK is in the Proxy p => p k v k v IO r monad. Surely I can lift readMVar into this proxy monad since it's a transformer over IO, but I cant find the right combinator.

Upvotes: 4

Views: 194

Answers (2)

Petr
Petr

Reputation: 63399

It's just as simple as adding lift. However, it seems that your implementation doesn't do what you intended. You read your MVar only once at the start and then never use it again, just pass the updated map around in the loop. If different threads should see changes through the MVar, you have to update it as well. A suggestion (compiles, but I haven't tested how it works):

cache :: (Proxy p, Ord k) => Cache k v -> k -> p k v k v IO r
cache (Cache c) k = runIdentityK loop k
    where 
      loop key = do
        m <- lift (readMVar c)
        case M.lookup key m of
            Nothing -> do
                val <- request key
                lift $ modifyMVar_ c (return . M.insert key val)
                respond val >>= loop
            Just val -> respond val >>= loop

Upvotes: 3

cdk
cdk

Reputation: 6778

The solution was a simple lift. I had thought to use it before but apparently hadn't tried hard enough. Here is a rough, type-checking version of my desired cache

cache = runIdentityK . loop
    where loop (Cache c) key = lift (takeMVar c) >>= \m -> case M.lookup key m of
            Nothing -> do
                val <- request key
                lift . putMVar c $ M.insert key val m
                respond val >>= loop (Cache c)
            Just val -> do
               lift $ putMVar c m 
               respond val >>= loop (Cache c)

Upvotes: 5

Related Questions