Monday Morning Haskell explores a variety of topics in the Haskell programming language, from the very basics to the best tools for use in a production environment. The author, James Bowen, is a software engineer in San Francisco.

Eff to the Rescue!

In the last couple weeks, we’ve seen quite a flurry of typeclasses. We used MonadDatabase and MonadCache to abstract the different effects within our API. This brought with it some benefits, but also some drawbacks. With these concepts abstracted, we could distill the API code into its simpler tasks. We didn't need to worry about connection configurations or lifting through different monads.

As we’ve seen though, there was a lot of boilerplate code involved. And there would be more if we wanted the freedom to have different parts of our app use different monad stacks. Free Monads are one solution to this problem. They allow you to compose your program so that the order in which you specify your effects does not matter. We’ll still have to write “interpretations” as we did before. But now they’ll be a lot more composable.

You can follow along the code for this by checking out the effects-3 branch on Github. Also, I do have to give a shoutout to Sandy Maguire for his talk on Eff and Free monads from BayHac. Most of what I know about free monads comes from that talk. You should also check out his blog as well.

Typeclass Boilerplate

Let’s review the main drawback of our type class approach. Recall our original definition of the AppMonad, and some of the instances we had to write for it:

newtype AppMonad a = AppMonad (ReaderT RedisInfo (SqlPersistT (LoggingT IO)) a)
  deriving (Functor, Applicative, Monad)

instance MonadDatabase AppMonad where
  fetchUserDB = liftSqlPersistT . fetchUserDB
  createUserDB = liftSqlPersistT . createUserDB
  deleteUserDB = liftSqlPersistT . deleteUserDB
  fetchArticleDB = liftSqlPersistT . fetchArticleDB
  createArticleDB = liftSqlPersistT . createArticleDB
  deleteArticleDB = liftSqlPersistT . deleteArticleDB
  fetchArticlesByAuthor = liftSqlPersistT . fetchArticlesByAuthor
  fetchRecentArticles = liftSqlPersistT fetchRecentArticles

liftSqlPersistT :: SqlPersistT (LoggingT IO) a -> AppMonad a
liftSqlPersistT action = AppMonad $ ReaderT (const action)

instance (MonadIO m, MonadLogger m) => MonadDatabase (SqlPersistT m) where
  ...

But suppose another part of our application wants to use a different monad stack. Perhaps it uses different configuration information and tracks different state. But it still needs to be able to connect to the database. As a result, we’ll need to write more instances. Each of these will need a new definition for all the different effect functions. Most all these will be repetitive and involve some combination of lifts. This isn’t great. Further, suppose we want arbitrary reordering of the monad stack. The number of instances you’ll have to write scales quadratically. Once you get to six or seven layers, this is a real pain.

Main Ideas of Eff

We can get much better composability by using free monads. I’m not going to get into the conceptual details of free monads. Instead I’ll show how to implement them using the Eff monad from the Freer Effects library. Let's first think back to how we define constraints on monads in our handler functions.

fetchUsersHandler :: (MonadDatabase m, MonadCache m) => Int64 -> m User

We take some generic monad, and constrain it to implement our type classes. With Eff, we’ll specify constraints in a different way. We have only one monad, the Eff monad. This monad is parameterized by a type-level list of other monads that it carries on its stack.

type JustIO a = Eff ‘[IO] a

type ReaderWithIO a = Eff ‘[Reader RedisInfo, IO] a

With this in mind, we can specify constraints on what monads are part of our stack using Member. Here’s how we’ll re-write the type signature from above:

fetchUsersHandler :: (Member Database r, Member Cache r) => Int64 -> Eff r User

We’ll specify exactly what Database and Cache are in the next section. But in essence, we’re stating that we have these two kinds of effects that live somewhere on our monad stack r. It doesn’t matter what order they’re in! This gives us a lot of flexibility. But before we see why, let’s examine how we actually write these effects.

Coding Up Effects

The first thing we’ll do is represent our effects as data types, rather than type classes. Starting with our database functionality, we’ll make a type Database a. This type will have one constructor for each function from our MonadDatabase typeclass. We’ll capitalize the names since they’re constructors instead of functions names. Then we’ll use GADT syntax, so that the result will be of type Database instead of a function in a particular monad. To start, here’s what our FetchUserDB constructor looks like:

{-# LANGUAGE GADTs #-}

data Database a where
  FetchUserDB :: Int64 -> Database (Maybe User)
  ...

Our previous definition looked like Int64 -> m (Maybe User). But we’re now constructing a Database action. Here’s the rest of the definition:

data Database a where
  FetchUserDB :: Int64 -> Database (Maybe User)
  CreateUserDB :: User -> Database Int64
  DeleteUserDB :: Int64 -> Database ()
  FetchArticleDB :: Int64 -> Database (Maybe Article)
  CreateArticleDB :: Article -> Database Int64
  DeleteArticleDB :: Int64 -> Database ()
  FetchArticlesByAuthor :: Int64 -> Database [KeyVal Article]
  FetchRecentArticles :: Database [(KeyVal User, KeyVal Article)]

Now we can also do the same thing with a Cache type instead of our MonadCache class:

data Cache a where
  CacheUser :: Int64 -> User -> Cache ()
  FetchCachedUser :: Int64 -> Cache (Maybe User)
  DeleteCachedUser :: Int64 -> Cache ()

Now, unfortunately, we do need some boilerplate with Eff. For each of constructor we create, we’ll need a function to run that item within the Eff monad. For these, we’ll use the send function from the Eff library. Each function states that our effect type is a member of our monad set. Then it will otherwise match the type of that constructor, only within the Eff monad. Here are the three examples for our Cache type.

cacheUser :: (Member Cache r) => Int64 -> User -> Eff r ()
cacheUser uid user = send $ CacheUser uid user

fetchCachedUser :: (Member Cache r) => Int64 -> Eff r (Maybe User)
fetchCachedUser = send . FetchCachedUser

deleteCachedUser :: (Member Cache r) => Int64 -> Eff r ()
deleteCachedUser = send . DeleteCachedUser

But wait! You might be asking, aren’t we trying to avoid boilerplate? Well, it’s hard to avoid all boilerplate. But the real gain we’ll get is that our boilerplate will scale in a linear fashion. We only need this code once per effect type we create. Remember, the alternative is quadratic growth.

Interpreting our Effects

To write "interpretations" of our effects in the type class system, we wrote instances. Here, we can do it with functions that we'll prefix with run. These will assume we have an action where our effect is on "top" of the monad stack. The result will be a new action with that layer peeled off.

runDatabase :: Eff (Database ': r) a -> Eff r a
runDatabase = ...

Now, we have to consider, what would be necessary to run our database effects? For our production application, we need to know that SqlPersistT lives in the monad stack. So we’ll add (SqlPersistT (LoggingT IO)) as a constraint on the rest of the r for our monad.

runDatabase :: (Member (SqlPersistT (LoggingT IO)) r) => Eff (Database ': r) a -> Eff r a

So we are in effect constraining the ordering of our monad, but doing it in a logical way. It wouldn’t make sense for us to ever run our database effects without knowing about the database itself.

To write this function, we specify a transformation between this Member of the rest of our stack and our Database type. We can run this transformation with runNat:

runDatabase :: (Member (SqlPersistT (LoggingT IO)) r) => Eff (Database ': r) a -> Eff r a
runDatabase = runNat databaseToSql
  where
    databaseToSql :: Database a -> SqlPersistT (LoggingT IO) a
    ...

Now we need a conversion between a Database object and a SqlPersistT action. For this, we plug in all the different function definitions we’ve been using all along. For instance, here’s what our fetchUserDB and createDB definitions look like:

databaseToSql (FetchUserDB uid) = get (toSqlKey uid)
databaseToSql (CreateUserDB user) = fromSqlKey <$> insert user

Our other constructors will follow this pattern as well.

Now, we’ll also want a way to interpret SqlPersistT effects within Eff. We’ll depend on only having IO as a deeper member within the stack here, though we also need the PGInfo parameter. Then we use runNat and convert between our SqlPersistT action and a normal IO action. We’ve done this before with runPGAction:

runSqlPersist :: (Member IO r) => PGInfo -> Eff ((SqlPersistT (LoggingT IO)) ': r) a -> Eff r a
runSqlPersist pgInfo = runNat $ runPGAction pgInfo

We go through this same process with Redis and our cache. To run a Redis action from our monad stack, we have to take the RedisInfo as a parameter and then also have IO on our stack:

runRedisAction :: (Member IO r) => RedisInfo -> Eff (Redis ': r) a -> Eff r a
runRedisAction redisInfo = runNat redisToIO
  where
    redisToIO :: Redis a -> IO a
    redisToIO action = do
      connection <- connect redisInfo
      runRedis connection action

Once we have this transformation, we can use the dependency on Redis to run Cache actions.

runCache :: (Member Redis r) => Eff (Cache ': r) a -> Eff r a
runCache = runNat cacheToRedis
  where
    cacheToRedis :: Cache a -> Redis a
    cacheToRedis (CacheUser uid user) = void $ setex (pack . show $ uid) 3600 (pack . show $ user)
    cacheToRedis (FetchCachedUser uid) = do
      result <- get (pack . show $ uid)
      case result of
        Right (Just userString) -> return $ Just (read . unpack $ userString)
        _ -> return Nothing
    cacheToRedis (DeleteCachedUser uid) = void $ del [pack . show $ uid]

And now we're done with our interpretations!

A Final Natural Transformation

Since we’re using Servant, we’ll still have to pick a final ordering. We need a natural transformation from Eff to Handler. Thus we'll specify a specific order so we have a specific Eff. We’ll put our cache effects on the top of our stack, then database operations, and finally, plain old IO.

transformEffToHandler ::
  PGInfo ->
  RedisInfo ->
  (Eff '[Cache, Redis, Database, SqlPersistT (LoggingT IO), IO]) :~> Handler

So how do we define this transformation? As always, we’ll want to create an IO action that exposes an Either value so we can catch errors. First, we can use our different run functions to peel off all the layers on our stack until all we have is IO:

transformEffToHandler ::
  PGInfo ->
  RedisInfo ->
  (Eff '[Cache, Redis, Database, SqlPersistT (LoggingT IO), IO]) :~> Handler
transformEffToHandler pgInfo redisInfo = NT $ \action -> do
  -- ioAct :: Err ‘[IO] a
  let ioAct = (runSqlPersist pgInfo . runDatabase . runRedisAction redisInfo . runCache) action
  ...

When we only have a single monad on our stack, we can use runM to get an action in that monad. So we need to apply that to our action, handle errors, and return the result as a Handler!

transformEffToHandler ::
  PGInfo ->
  RedisInfo -> 
  (Eff '[Cache, Redis, Database, SqlPersistT (LoggingT IO), IO]) :~> Handler
transformEffToHandler pgInfo redisInfo = NT $ \action -> do
  let ioAct = (runSqlPersist pgInfo . runDatabase . runRedisAction redisInfo . runCache) action
  result <- liftIO (runWithServantHandler (runM ioAct))
  Handler $ either throwError return result

And with that we’re done! Here’s the big win with Eff. It’s quite easy for us to write a different transformation on a different ordering of the Stack. We just change the order in which we apply our run functions!

-- Put Database on top instead of Cache
transformEffToHandler :: 
  PGInfo -> 
  RedisInfo -> 
  (Eff '[Database, SqlPersistT (LoggingT IO), Cache, Redis, IO]) :~> Handler
transformEffToHandler pgInfo redisInfo = NT $ \action -> do
  let ioAct = (runRedisAction redisInfo . runCache . runSqlPersist pgInfo . runDatabase) action
  result <- liftIO (runWithServantHandler (runM ioAct))
  Handler $ either throwError return result

Can we avoid outside services with this approach? Sure! We can specify test interpretations of our effects that don’t use SqlPersistT or Redis. We’ll still have IO for reasons mentioned last week, but it’s still an easy change. We'll define separate runTestDatabase and runTestCache functions that use the same effects we saw last week. They’ll depend on using the State over our in-memory maps.

runTestDatabase :: 
  (Member (StateT (UserMap, ArticleMap, UserMap) IO) r) => 
  Eff (Database ': r) a -> 
  Eff r a
runTestDatabase = runNat databaseToState
  where
    databaseToState :: Database a -> StateT (UserMap, ArticleMap, UserMap) IO a
    …

runTestCache ::
  (Member (StateT (UserMap, ArticleMap, UserMap) IO) r) =>
  Eff (Cache ': r) a ->
  Eff r a
runTestCache = runNat cacheToState
  where
    cacheToState :: Cache a -> StateT (UserMap, ArticleMap, UserMap) IO a
    ...

Then we fill in the definitions with the same functions we used when writing our TestMonad. After that, we define another natural transformation, in the same pattern:

transformTestEffToHandler ::
  MVar (UserMap, ArticleMap, UserMap) ->
  Eff '[Cache, Database, StateT (UserMap, ArticleMap, UserMap) IO] :~> Handler
transformTestEffToHandler sharedMap = NT $ \action -> do
  let stateAct = (runTestDatabase . runTestCache) action
  result <- liftIO (runWithServantHandler (runEff stateAct))
  Handler $ either throwError return result
  where
    runEff :: Eff '[StateT (UserMap, ArticleMap, UserMap) IO] a -> IO a
    runEff action = do
      let stateAction = runM action
      runStateTWithPointer stateAction sharedMap

Incorporating our Interpretations

The final step we’ll take is to change a couple different type signatures within our API code. We’ll pass a new natural transformation to our Server function:

fullAPIServer :: 
  ((Eff '[Cache, Redis, Database, SqlPersistT (LoggingT IO), IO]) :~> Handler) ->
  Server FullAPI
fullAPIServer nt = ...

And then we’ll change all our handlers to use Eff with the proper members, instead of AppMonad:

fetchUsersHandler :: (Member Database r, Member Cache r) => Int64 -> Eff r User
createUserHandler :: (Member Database r) => User -> Eff r Int64
fetchArticleHandler :: (Member Database r) => Int64 -> Eff r Article
createArticleHandler :: (Member Database r) => Article -> Eff r Int64
fetchArticlesByAuthorHandler :: (Member Database r) => Int64 -> Eff r [KeyVal Article]
fetchRecentArticlesHandler :: (Member Database r) => Eff r [(KeyVal User, KeyVal Article)]

Conclusion

We’ve come a long way with our small application. It doesn’t do much. But it has served as a great launchpad for learning many interesting libraries and techniques. In particular, we’ve seen in these last few weeks how to organize effects within our application. With the Eff library, we can represent our effects with data types that we can re-order with ease.

If you’ve never tried Haskell before, give it a shot! Download our Getting Started Checklist and get going!

If you’ve done a little Haskell but aren’t set on your skills yet, maybe this article went over your head. That’s OK! You can work on your skills more with our Recursion Workbook!

The Right Types of Assumptions

A Different Point of View: Interpreting our Monads Without Outside Services