Skip to content

Instantly share code, notes, and snippets.

@darcykimball
Last active September 4, 2019 00:51
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save darcykimball/74dd7973b2dbad22b7091135a3b9d472 to your computer and use it in GitHub Desktop.
Save darcykimball/74dd7973b2dbad22b7091135a3b9d472 to your computer and use it in GitHub Desktop.
{-# LANGUAGE DeriveFunctor #-}
module Scoped where
import Control.Monad
import Data.Foldable
import System.IO
withFiles :: [FilePath] -> ([Handle] -> IO a) -> IO a
withFiles [] f = f []
withFiles (path:paths) f =
-- Just for writing, for simplicity
withFile path WriteMode $ \handle ->
withFiles paths $ \handles ->
f (handle:handles)
-- For testing
writeFoos :: [Handle] -> IO ()
writeFoos = mapM_ (\h -> putStrLn "Writing foo..." >> hPutStrLn h "foo")
-- As folded
withFiles' :: [FilePath] -> ([Handle] -> IO a) -> IO a
withFiles' paths f = foldl' (flip combine) (\g -> g []) paths $ f
where
combine ::
FilePath ->
(([Handle] -> IO a) -> IO a) ->
(([Handle] -> IO a) -> IO a)
combine path withHandles =
\handlesCont -> withFile path WriteMode $
\handle -> withHandles (\handles -> handlesCont (handle:handles))
-- Even simpler, using continuation monad
newtype ContIO r a = ContIO { runContIO :: (a -> IO r) -> IO r }
deriving (Functor)
instance Applicative (ContIO r) where
pure a = ContIO ($ a)
(<*>) = ap
instance Monad (ContIO r) where
ContIO x >>= f = ContIO $ \c -> x (\a -> runContIO (f a) c)
withFiles'' :: [FilePath] -> ([Handle] -> IO a) -> IO a
withFiles'' paths f = runContIO (foldr combine (return []) paths) f
where
combine :: FilePath -> ContIO a [Handle] -> ContIO a [Handle]
-- Direct
{-
combine path cont = ContIO $ \cont' ->
withFile path WriteMode (\handle -> runContIO (fmap (handle:) cont) cont')
-}
-- Do-notation
combine path cont = do
handles <- cont
handle <- ContIO (withFile path WriteMode)
return (handle:handles)
-- There we go.
withFiles''' :: [FilePath] -> ([Handle] -> IO a) -> IO a
withFiles''' paths f =
(runContIO $ traverse (ContIO . flip withFile WriteMode) paths) f

Scoped Resource Functions

I'm pretty sure this is explained better elsewhere; please google around. Also sorry if this is hella pedantic.

Suppose you have some (abstract) type representing some resource that you want to use. A library exposing ways to aqcuire such resources might expose only a callback-based function to wrap usage of the resource to avoid leakage, like so:

-- ResourceID is something that names a resource. For example, it could be a
-- file descriptor, a socket, or a shared object. A Resource is the actual
-- handle with which we can use a resource.
withResource :: ResourceID -> (Resource -> IO a) -> IO a

-- Some function that uses an acquired resource
useResource :: ResourceID -> IO Int
useResource resID = withResource resID $ \resource -> do
  -- Imagine that askForInt is some operation defined on resources:
  -- askForInt :: Resource -> IO Int
  value <- askForInt resource
  value' <- askForInt resource
  return $ value + value'

In the above, the lambda passed to withResource forms a kind of scope over the resource's usage, and it can only be used indirectly through a Handle inside. In this way, withResource can localize usage, and also do things like making sure that resource acquisition is always paired with resource release.

This comes up often:

-- From System.IO
withFile :: FilePath -> IOMode -> (Handle -> IO r) -> IO r
-- or, more clearly,
withFile' :: (FilePath, IOMode) -> (Handle -> IO r) -> IO r
withFile' = uncurry withFile

-- From Foreign.C.String
withCString :: String -> (CString -> IO a) -> IO a

-- From Foreign.ForeignPtr
withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b

Hopefully the above examples seem very similar. (The fact that many of these kinds of functions have IO in their result types is because many practical resources need to be managed in IO, like files or memory buffers).

Composition

The question posed, then, is: given a hypothetical withResource function as described earlier, how can we use it with multiple resources at a time? The simplest example is forming nested scopes when using 2 resources:

processTwo :: ResourceID -> ResourceID -> IO Int
processTwo resID resID' =
  withResource resID $ \resource ->
    withResource resID' $ \resource' -> do
      value <- askForInt resource
      value' <- askForInt resource'
      return $ value + value'

The scope of the first resource extends over the 2nd usage in the argument to the 2nd call to withResource, but not vice versa, so the order goes like:

  • Acquire resource 1
  • Acquire resource 2
  • Use resources 1 and 2
  • Release resource 2
  • Release resource 1

...which is the familiar stack-based RAII-style behavior like in C++.

What if we have more than 2 resources? Worse, what if we have some number of resources known only at runtime? Like a list of them?

-- Like a list of them.
withResources :: [ResourceID] -> ([Resource] -> IO a) -> IO a
withResources []             f = f []
withResources (resID:resIDs) f =
  withResource resID $ \resource ->
    withResources resIDs $ \resources ->
      f (resource:resources)

The above just does recursively (on a list) what we did in the example with 2 resources: the resources are acquired in the order as they appear in the given list, the given callback is invoked, and the resources are released in reverse order.

@darcykimball
Copy link
Author

Er, so it appears what what we're doing here is something like taking:
a -> (b -> m r) -> m r
and turning it into
f a -> (f b -> m r) -> m r
which in this case looks more like taking:
a -> m b
and turning it into
f a -> m (f b),
given that we're transforming continuations?

Is there a general way to change Kleisli arrows in this way? It sorta looks like transformer lifting(???) but the result value is a monad in f b, not b, and m is not a transformer here; just something that composes with f.

While writing this I just realized that this is just traverse :: (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b). Might as well leave this here as a reminder of my stupidity.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment