"moo-nad": A module signature for the "ReaderT-with-record-of-functions" pattern

I like to tinker with the “put a bunch of monadic functions in a ReaderT environment” style of structuring Haskell applications (previous experiment here).

If, while using this style, you want your program logic to be polymorphic over the concrete monad and the environment, usually you turn to a combination of MonadReader and HasX-style typeclasses.

I though it would be fun to abstract those things using a Backpack module signature instead. The result is this tiny library: moo-nad.

The original motivation lies in this Stack Overflow question. I asked how to write a variadic helper for simplifying the invocation of functions stored in a reader environment.

The response I was given worked fine for a concrete monad, but when I tried to generalize it to work polymorphically over all monads having a suitable instance, I wasn’t able to do it. The root of the problem is that GHC is never sure that the monadic action returned by the function is not the (->) monad, which creates a conflict :frowning: I guess I could make it work using OverlappingInstances, but I’m not a fan of the extension.

So I generalized the invocation helpers using the module signature instead. The result looks like this:

-- | 'M' is a 'Monad'. Which one? We don't know yet, because this program logic
-- lives in an indefinite library.
logic :: M ()
logic = do
    self logger 7 "this is a message"
    c <- call askCounter
    if c == 0 
        then call incCounter 1
        else pure ()

self is a helper for “bare” functions stored directly in the environment, while call is a helper for functions stored in a sub-record (some kind of reusable component) living in the environment.

The environment for this example would look like this:

data EnvIO = EnvIO {
        _logger :: Int -> String -> IO (),
        _counter :: Counter IO
    }
instance HasLogger D E where
    logger (EnvIO {_logger}) = _logger
-- Using the generic Has from the dep-t package
instance Has Counter D E where
    dep (EnvIO {_counter}) = _counter

class HasLogger d e | e -> d where
    logger :: e -> Int -> String -> d ()

-- some reusable counter component
data Counter d = Counter { 
        askCounter :: d Int,
        incCounter :: Int -> d ()
    }

In the end, this might not very practical compared to just using a concrete monad, or going with the MTL style, but it was fun to try.

4 Likes