Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Using pipes/proxies with concurrent MVars

Tags:

haskell

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.

like image 200
cdk Avatar asked Feb 17 '23 14:02

cdk


1 Answers

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)
like image 66
cdk Avatar answered Feb 20 '23 04:02

cdk